File: SQRT.LS of Disk: V50/Source/Source-Listing-RALF-1
(Source file text)
RALF V50A 8-APR-92 PAGE 1
/
/ S Q R T
/ - - - -
/
/SUBROUTINE SQRT(X)
/
/ VERSION 5A 4-27-77 PT
/
SECT SQRT
00000 1030 JA #SQRT
00001 0074
00002 0000 0 /THE MANTISSA ND EXPOENT DIDDLE AREAS.
00003 0000 0
00004 0000 SQRTEX, 0
00005 0000 0
00006 0000 SQRT13, 0
00007 0000 0
00010 0013 13 /PHONEY EXPONENT PATCH.
/
EXTERN #ARGER
00011 4000 SQRTM1, TRAP4 #ARGER
00012 0000
00013 2321 TEXT +SQRT +
00014 2224
00015 4040
00016 1100 SQRTXR, SETX XRSQRT
00017 0025
00020 1110 SETB BPSQRT
00021 0022
00022 0000 BPSQRT, F 0.0
00023 0000
00024 0000
00025 0000 XRSQRT, F 0.0
00026 0000
00027 0000
00030 0000 SQRT1, F 0.0
00031 0000
00032 0000
00033 0000 SQRT2, F 0.0
00034 0000
00035 0000
00036 0000 SQRT3, F 0.0
00037 0000
00040 0000
00041 0001 F1SQRT, F 1.
00042 2000
00043 0000
00044 0002 F2SQRT, F 2.
00045 2000
00046 0000
ORG 10*3+BPSQRT
00052 0040 FNOP
00053 1030 JA SQRTXR
00054 0016
00055 0000 0
00056 1030 SQTRTN, JA .
RALF V50A 8-APR-92 PAGE 1-1
00057 0056
00060 0000 SQRTS1, 0 /IF BETWEEN 1/4 & 1/2
00061 3200 3200
00062 0000 0
00063 0000 0 /IF BETWEEN 1/2 & 1
00064 2240 2240
00065 0000 0
/
00066 7777 SQRTS2, 7777 /IF BETWEEN 1/4 & 1/2
00067 2327 2327
00070 7772 7772
00071 7777 7777 /IF BETWEEN 1/2 & 1
00072 3300 3300
00073 0000 0
BASE 0
00074 0006 #SQRT, STARTD
00075 0210 FLDA 10*3
00076 6400 FSTA SQTRTN
00077 0056
00100 0200 FLDA 0
00101 1100 SETX XRSQRT
00102 0025
00103 1110 SETB BPSQRT
00104 0022
BASE BPSQRT
00105 0101 LDX 1,1
00106 0001
00107 6200 FSTA BPSQRT
00110 0610 FLDA% BPSQRT,1 /ADDR OF X
00111 6200 FSTA BPSQRT
00112 0005 STARTF
00113 0600 FLDA% BPSQRT / GET X
00114 1000 JEQ SQTRTN /IF =0 JUST RTN
00115 0056
00116 1050 JLT SQRTM1 /IF <0 THEN ERROR
00117 0011
00120 6400 FSTA SQRTEX+1 /SAVE NUMBER AWAY FOR A SECOND.
00121 0005
00122 0400 FLDA SQRT13 /GET A RIGHT ADJUSTED 13 IN THE FAC.
00123 0006
00124 6400 FSTA SQRTEX-2 /STORE AWAY RIGHT AHEAD OF THE EXPONENT.
00125 0002
00126 0400 FLDA SQRTEX /NOW RETREIVE THE EXPONENT AS HIGH ORDER WORD.
00127 0004
00130 0010 ALN 0 /CHOP OFF CRAP.
00131 1000 JEQ SQRTSC /IS IT EXACTLY ZERO? IF SO, SPECIAL CASE.
00132 0214
00133 0004 FNORM /NORMALIZE IT.
00134 2205 FSUB F1SQRT /NOW SUBTRACT ONE FROM IT.
00135 3206 FDIV F2SQRT /CHOP IT IN HALF NOW.
00136 6202 FSTA SQRT1 /AND SAVE 1/2 EXP IN A TEMP.
00137 0010 ALN 0 /NOW FIX THE EXPONENT.
00140 0004 FNORM /AND NORMALIZE IT TO REMOVE UNDESIRABLE BITS.
00141 2202 FSUB SQRT1 /NOW SUBTRACT OFF EXTRANEOUS BITS.
00142 4206 FMUL F2SQRT /EXPAND IT AGAIN [FAC =0 OR -1], OR 0 TO +1
00143 1010 JGE .+3 /MAKE SURE ITS POSITIVE.
RALF V50A 8-APR-92 PAGE 1-2
00144 0146
00145 0003 FNEG /NOW MAKE IT 0 IF NO BIT OR +1 IF BIT
00146 0021 SQRTBK, ATX 1 /SAVE IN AN INDEX.
00147 2205 FSUB F1SQRT /SUBTRACT ONE TO MAKE IT -1 IF NO BIT OR 0 IF BIT.
00150 0010 ALN 0 /AND NOW SHIFT IT RIGHT.
00151 6400 FSTA SQRTEX-1 /AND SAVE IT OVER THE OLD EXPONENT.
00152 0003
00153 0202 FLDA SQRT1 /RECALL OLD PART
00154 0010 ALN 0 /FIX IT UP, NOW.
00155 6202 FSTA SQRT1 /AND STORE IT BACK FOR LATER USE
/
/ SQRTEX IS NOW 1/4 <X< 1
/
00156 0400 FLDA SQRTEX+1 /RECALL NUMBER.
00157 0005
00160 6203 FSTA SQRT2 /SAVE IN A TEMP.
/
00161 4410 FMUL SQRTS1,1 /MULTIPLY BY CORRECT CONSTANT.
00162 0060
00163 1410 FADD SQRTS2,1 /AND NOW ADD IN CORRECT CONSTANT.
00164 0066
/
/ NOTE: INITIAL APPROXIMATION DEPENDS ON WHETHER X IS 1/4<X<1/2 OR
/ 1/2<X<1
/
00165 6204 FSTA SQRT3 /SAVE IN A SECOND TEMP.
00166 0203 FLDA SQRT2 /RECALL INITIAL.
00167 3204 FDIV SQRT3 /CALCULATE X(0)/X(1)
00170 1204 FADD SQRT3 /X(1)+X(0)/X(1)
00171 3206 FDIV F2SQRT /1/2(X(1)+X(0)/X(1))
00172 6204 FSTA SQRT3 /SAVE AGAIN. NOW X(2)
00173 0203 FLDA SQRT2 /RECALL ORIGINAL.
00174 3204 FDIV SQRT3 /X(0)/X(2)
00175 1204 FADD SQRT3 /X(2)+X(0)/X(2)
00176 6400 FSTA SQRTEX+1 /NOW STORE AWAY FOR FINAL EXPONENT DIDDLING.
00177 0005
/
00200 0006 STARTD
/
00201 0002 FCLA /ZERO HIGH ORDER EXPONENT PART.
00202 6400 FSTA SQRTEX-1
00203 0003
00204 0202 FLDA SQRT1 /RECALL MODIFIED EXPONENT.
00205 5400 FADDM SQRTEX /UPDATE FRACTIONAL EXPONENT.
00206 0004
/
00207 0005 STARTF /RETRUN TO FLOATING MODE.
/
00210 0400 FLDA SQRTEX+1 /PICK UP THE ANSWER.
00211 0005
00212 1030 JA SQTRTN /AND RTN
00213 0056
/
00214 2205 SQRTSC, FSUB F1SQRT /SPECIAL CASE FUDGE.
00215 6202 FSTA SQRT1 /SET EXPONENT ADD ON TO -1.
00216 0003 FNEG /AND SET ODD BIT ON.
RALF V50A 8-APR-92 PAGE 1-3
00217 1030 JA SQRTBK /AND GO BACK UP.
00220 0146
RALF V50A 8-APR-92 PAGE 1-4
NO ERRORS
19 SYMBOLS, NO ABS REFS
# C 00000 #ARGER X 00000 #MAIN S 00000 #SQRT 00074
BPSQRT 00022 F1SQRT 00041 F2SQRT 00044 SQRT S 00221
SQRTBK 00146 SQRTEX 00004 SQRTM1 00011 SQRTSC 00214
SQRTS1 00060 SQRTS2 00066 SQRTXR 00016 SQRT1 00030
SQRT13 00006 SQRT2 00033 SQRT3 00036 SQTRTN 00056
XRSQRT 00025