| 1 | / |
| 2 | / |
| 3 | / S Q R T |
| 4 | / - - - - |
| 5 | / |
| 6 | /SUBROUTINE SQRT(X) |
| 7 | / |
| 8 | / VERSION 5A 4-27-77 PT |
| 9 | / |
| 10 | SECT SQRT |
| 11 | JA #SQRT |
| 12 | 0 /THE MANTISSA ND EXPOENT DIDDLE AREAS. |
| 13 | 0 |
| 14 | SQRTEX, 0 |
| 15 | 0 |
| 16 | SQRT13, 0 |
| 17 | 0 |
| 18 | 13 /PHONEY EXPONENT PATCH. |
| 19 | / |
| 20 | EXTERN #ARGER |
| 21 | SQRTM1, TRAP4 #ARGER |
| 22 | TEXT +SQRT + |
| 23 | SQRTXR, SETX XRSQRT |
| 24 | SETB BPSQRT |
| 25 | BPSQRT, F 0.0 |
| 26 | XRSQRT, F 0.0 |
| 27 | SQRT1, F 0.0 |
| 28 | SQRT2, F 0.0 |
| 29 | SQRT3, F 0.0 |
| 30 | F1SQRT, F 1. |
| 31 | F2SQRT, F 2. |
| 32 | ORG 10*3+BPSQRT |
| 33 | FNOP |
| 34 | JA SQRTXR |
| 35 | 0 |
| 36 | SQTRTN, JA . |
| 37 | SQRTS1, 0 /IF BETWEEN 1/4 & 1/2 |
| 38 | 3200 |
| 39 | 0 |
| 40 | 0 /IF BETWEEN 1/2 & 1 |
| 41 | 2240 |
| 42 | 0 |
| 43 | / |
| 44 | SQRTS2, 7777 /IF BETWEEN 1/4 & 1/2 |
| 45 | 2327 |
| 46 | 7772 |
| 47 | 7777 /IF BETWEEN 1/2 & 1 |
| 48 | 3300 |
| 49 | 0 |
| 50 | BASE 0 |
| 51 | #SQRT, STARTD |
| 52 | FLDA 10*3 |
| 53 | FSTA SQTRTN |
| 54 | FLDA 0 |
| 55 | SETX XRSQRT |
| 56 | SETB BPSQRT |
| 57 | BASE BPSQRT |
| 58 | LDX 1,1 |
| 59 | FSTA BPSQRT |
| 60 | FLDA% BPSQRT,1 /ADDR OF X |
| 61 | FSTA BPSQRT |
| 62 | STARTF |
| 63 | FLDA% BPSQRT /GET X |
| 64 | JEQ SQTRTN /IF =0 JUST RTN |
| 65 | JLT SQRTM1 /IF <0 THEN ERROR |
| 66 | FSTA SQRTEX+1 /SAVE NUMBER AWAY FOR A SECOND. |
| 67 | FLDA SQRT13 /GET A RIGHT ADJUSTED 13 IN THE FAC. |
| 68 | FSTA SQRTEX-2 /STORE AWAY RIGHT AHEAD OF THE EXPONENT. |
| 69 | FLDA SQRTEX /NOW RETREIVE THE EXPONENT AS HIGH ORDER WORD. |
| 70 | ALN 0 /CHOP OFF CRAP. |
| 71 | JEQ SQRTSC /IS IT EXACTLY ZERO? IF SO, SPECIAL CASE. |
| 72 | FNORM /NORMALIZE IT. |
| 73 | FSUB F1SQRT /NOW SUBTRACT ONE FROM IT. |
| 74 | FDIV F2SQRT /CHOP IT IN HALF NOW. |
| 75 | FSTA SQRT1 /AND SAVE 1/2 EXP IN A TEMP. |
| 76 | ALN 0 /NOW FIX THE EXPONENT. |
| 77 | FNORM /AND NORMALIZE IT TO REMOVE UNDESIRABLE BITS. |
| 78 | FSUB SQRT1 /NOW SUBTRACT OFF EXTRANEOUS BITS. |
| 79 | FMUL F2SQRT /EXPAND IT AGAIN [FAC =0 OR -1], OR 0 TO +1 |
| 80 | JGE .+3 /MAKE SURE ITS POSITIVE. |
| 81 | FNEG /NOW MAKE IT 0 IF NO BIT OR +1 IF BIT |
| 82 | SQRTBK, ATX 1 /SAVE IN AN INDEX. |
| 83 | FSUB F1SQRT /SUBTRACT ONE TO MAKE IT -1 IF NO BIT OR 0 IF BIT. |
| 84 | ALN 0 /AND NOW SHIFT IT RIGHT. |
| 85 | FSTA SQRTEX-1 /AND SAVE IT OVER THE OLD EXPONENT. |
| 86 | FLDA SQRT1 /RECALL OLD PART |
| 87 | ALN 0 /FIX IT UP, NOW. |
| 88 | FSTA SQRT1 /AND STORE IT BACK FOR LATER USE |
| 89 | / |
| 90 | / SQRTEX IS NOW 1/4 <X< 1 |
| 91 | / |
| 92 | FLDA SQRTEX+1 /RECALL NUMBER. |
| 93 | FSTA SQRT2 /SAVE IN A TEMP. |
| 94 | / |
| 95 | FMUL SQRTS1,1 /MULTIPLY BY CORRECT CONSTANT. |
| 96 | FADD SQRTS2,1 /AND NOW ADD IN CORRECT CONSTANT. |
| 97 | / |
| 98 | / NOTE: INITIAL APPROXIMATION DEPENDS ON WHETHER X IS 1/4<X<1/2 OR |
| 99 | / 1/2<X<1 |
| 100 | / |
| 101 | FSTA SQRT3 /SAVE IN A SECOND TEMP. |
| 102 | FLDA SQRT2 /RECALL INITIAL. |
| 103 | FDIV SQRT3 /CALCULATE X(0)/X(1) |
| 104 | FADD SQRT3 /X(1)+X(0)/X(1) |
| 105 | FDIV F2SQRT /1/2(X(1)+X(0)/X(1)) |
| 106 | FSTA SQRT3 /SAVE AGAIN. NOW X(2) |
| 107 | FLDA SQRT2 /RECALL ORIGINAL. |
| 108 | FDIV SQRT3 /X(0)/X(2) |
| 109 | FADD SQRT3 /X(2)+X(0)/X(2) |
| 110 | FSTA SQRTEX+1 /NOW STORE AWAY FOR FINAL EXPONENT DIDDLING. |
| 111 | / |
| 112 | STARTD |
| 113 | / |
| 114 | FCLA /ZERO HIGH ORDER EXPONENT PART. |
| 115 | FSTA SQRTEX-1 |
| 116 | FLDA SQRT1 /RECALL MODIFIED EXPONENT. |
| 117 | FADDM SQRTEX /UPDATE FRACTIONAL EXPONENT. |
| 118 | / |
| 119 | STARTF /RETRUN TO FLOATING MODE. |
| 120 | / |
| 121 | FLDA SQRTEX+1 /PICK UP THE ANSWER. |
| 122 | JA SQTRTN /AND RTN |
| 123 | / |
| 124 | SQRTSC, FSUB F1SQRT /SPECIAL CASE FUDGE. |
| 125 | FSTA SQRT1 /SET EXPONENT ADD ON TO -1. |
| 126 | FNEG /AND SET ODD BIT ON. |
| 127 | JA SQRTBK /AND GO BACK UP. |
| 128 | \f |