Commit | Line | Data |
---|---|---|
7af5ad59 PH |
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 |