File: SQRTMS.LS of Disk: V50/Source/Source-Listing-RALF-1
(Source file text)
RALF V50A 8-APR-92 PAGE 1
/R=SQRT(R) SINGLE PREC. SQUARE ROOT
/
/
/ VERSION 50A 20-MAY-80 WVDM GOOD FOR M&S FPP
/
/
SECT SQRT
00000 1030 JA #SQRT
00001 0074
00002 0000 0 /THE MANTISSA AND EXPONENT 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 .
00057 0056
00060 0000 SQRTS1, 0 /IF BETWEEN 1/4 & 1/2
RALF V50A 8-APR-92 PAGE 1-1
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 2205 FSUB F1SQRT /.LT. 1 ?
00123 1010 JGE SQPOSR
00124 0134
00125 0101 LDX 0,1 /REMEMBER LT 1
00126 0000
00127 0205 FLDA F1SQRT /INVERT
00130 3400 FDIV SQRTEX+1
00131 0005
00132 6400 FSTA SQRTEX+1
00133 0005
00134 0400 SQPOSR, FLDA SQRT13 /GET A RIGHT ADJUSTED 13 IN THE FAC.
00135 0006
00136 6400 FSTA SQRTEX-2 /STORE AWAY RIGHT AHEAD OF THE EXPONENT.
00137 0002
00140 0400 FLDA SQRTEX /NOW RETREIVE THE EXPONENT AS HIGH ORDER WORD.
00141 0004
00142 0010 ALN 0 /CHOP OFF CRAP.
00143 0004 FNORM /NORMALIZE IT.
00144 2205 FSUB F1SQRT /NOW SUBTRACT ONE FROM IT.
00145 3206 FDIV F2SQRT /CHOP IT IN HALF NOW.
RALF V50A 8-APR-92 PAGE 1-2
00146 6203 FSTA SQRT2 /AND SAVE 1/2 EXP IN A TEMP.
00147 0010 ALN 0 /NOW FIX THE EXPONENT.
00150 6202 FSTA SQRT1 /SAVE FIXED-UP EXP FOR LATER
00151 0004 FNORM /AND NORMALIZE IT TO REMOVE UNDESIRABLE BITS.
00152 2203 FSUB SQRT2 /NOW SUBTRACT OFF EXTRANEOUS BITS.
00153 4206 FMUL F2SQRT /EXPAND IT AGAIN [FAC =0 OR -1]
00154 0003 FNEG /NOW MAKE IT 0 IF NO BIT OR +1 IF BIT
00155 0022 SQRTBK, ATX 2 /SAVE IN AN INDEX.
00156 2205 FSUB F1SQRT /SUBTRACT 1 FOR -1 IF NO BIT OR 0 IF BIT.
00157 0010 ALN 0 /AND NOW SHIFT IT RIGHT.
00160 6400 FSTA SQRTEX-1 /AND SAVE IT OVER THE OLD EXPONENT.
00161 0003
/
/ SQRTEX IS NOW 1/4 <X< 1
/
00162 0400 FLDA SQRTEX+1 /RECALL NUMBER.
00163 0005
00164 6203 FSTA SQRT2 /SAVE IN A TEMP.
/
00165 4420 FMUL SQRTS1,2 /MULTIPLY BY CORRECT CONSTANT.
00166 0060
00167 1420 FADD SQRTS2,2 /AND NOW ADD IN CORRECT CONSTANT.
00170 0066
/
/ NOTE: INITIAL APPROXIMATION DEPENDS ON WHETHER X IS 1/4<X<1/2 OR
/ 1/2<X<1
/
00171 6204 FSTA SQRT3 /SAVE IN A SECOND TEMP.
00172 0203 FLDA SQRT2 /RECALL INITIAL.
00173 3204 FDIV SQRT3 /CALCULATE X(0)/X(1)
00174 1204 FADD SQRT3 /X(1)+X(0)/X(1)
00175 3206 FDIV F2SQRT /1/2(X(1)+X(0)/X(1))
00176 6204 FSTA SQRT3 /SAVE AGAIN. NOW X(2)
00177 0203 FLDA SQRT2 /RECALL ORIGINAL.
00200 3204 FDIV SQRT3 /X(0)/X(2)
00201 1204 FADD SQRT3 /X(2)+X(0)/X(2)
00202 6400 FSTA SQRTEX+1 /NOW STORE AWAY FOR FINAL EXPONENT DIDDLING.
00203 0005
/
00204 0006 STARTD
00205 0002 FCLA /ZERO HIGH ORDER EXPONENT PART.
00206 6400 FSTA SQRTEX-1
00207 0003
00210 0202 FLDA SQRT1 /RECALL MODIFIED EXPONENT.
00211 1400 FADD SQRTEX /UPDATE FRACTIONAL EXPONENT.
00212 0004
00213 6400 FSTA SQRTEX
00214 0004
/
00215 0005 STARTF /RETURN TO FLOATING MODE.
00216 2010 JXN SQEXPO,1 /WAS IT .GE. 1 ?
00217 0225
00220 0205 FLDA F1SQRT /NO, INVERT
00221 3400 FDIV SQRTEX+1 /SQRT(1/X)=1/SQRT(X)
00222 0005
00223 1030 JA SQTRTN /AND RTN
RALF V50A 8-APR-92 PAGE 1-3
00224 0056
/
00225 0400 SQEXPO, FLDA SQRTEX+1 /PICK UP THE ANSWER DIRECTLY
00226 0005
00227 1030 JA SQTRTN /AND RTN
00230 0056
RALF V50A 8-APR-92 PAGE 2
RALF V50A 8-APR-92 PAGE 2-1
NO ERRORS
20 SYMBOLS, NO ABS REFS
# C 00000 #ARGER X 00000 #MAIN S 00000 #SQRT 00074
BPSQRT 00022 F1SQRT 00041 F2SQRT 00044 SQEXPO 00225
SQPOSR 00134 SQRT S 00231 SQRTBK 00155 SQRTEX 00004
SQRTM1 00011 SQRTS1 00060 SQRTS2 00066 SQRTXR 00016
SQRT1 00030 SQRT13 00006 SQRT2 00033 SQRT3 00036
SQTRTN 00056 XRSQRT 00025