X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Ff4%2FFRTSRC%2Fdexp.ra;fp=sw%2Ff4%2FFRTSRC%2Fdexp.ra;h=842162de13b1e78c3e76740f601b1c183260e2a7;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git diff --git a/sw/f4/FRTSRC/dexp.ra b/sw/f4/FRTSRC/dexp.ra new file mode 100644 index 0000000..842162d --- /dev/null +++ b/sw/f4/FRTSRC/dexp.ra @@ -0,0 +1,266 @@ +/ +/ +/ SUBROUTINE DEXP +/ +/ VERSION 5A 4-26-77 MH +/ +/E^X=2^(X*LOG2(E)) +/E^X=2^(M+F) +/M=INTEGER; F=FRACTION +/ +/2^(M+F)=2^(M+N+R) +/WHERE 0 +/ +/RESTRICTIONS: +/X=0 IMPLIES E^X=1 +/ +/X>88.028 IMPLIES E^X=3377/3377/3777/7777/777/7777 +/ +/X<-88.028 IMPLIES E^X=0 +/ +/ +/ + SECT DEXP + JA #DEXP + DPCHK + TEXT +DEXP + +/ +DEXPXR, SETX XRDEXP + SETB BPDEXP +/ +/BEGINNING OF BASE PAGE +/ +BPDEXP, F 0.0 +XRDEXP, F 0.0 +X, F 0.0 + F 0.0 +/ + ORG 10*3+BPDEXP + FNOP + JA DEXPXR + 0 +DEXRTN, JA . +/ +TOPLIM, 3377 + 3377 + 3777 + 7777 + 7777 + 7777 +M, F 0.0 + F 0.0 +N, F 0.0 + F 0.0 +R, F 0.0 + F 0.0 +LOG2E, 0001 /1.4426950408889634 + 2705 + 2435 + 4512 + 7013 + 7603 +DFP125, 7775 /.125 + 3777 + 7777 + 7777 + 7777 + 7776 +DEXFP1, F 1.0 + F 0.0 +/ +DFR1S8, 0001 /2^1/8 + 2134 + 5340 + 7437 + 2505 + 7302 +DFP2S8, 0001 /2^2/8 + 2301 + 5770 + 1214 + 3334 + 2524 +DFP3S8, 0001 /2^3/8 + 2457 + 7553 + 2515 + 4250 + 4720 +DFP4S8, 0001 /2^4/8 + 2650 + 1171 + 4637 + 6357 + 1425 +DFP5S8, 0001 /2^5/8 + 3053 + 1625 + 0212 + 5174 + 3070 +DFP6S8, 0001 /2^6/8 + 3272 + 1176 + 3126 + 5516 + 5532 +DFP7S8, 0001 /2^7/8 + 3526 + 0143 + 3476 + 7222 + 0722 +/ +/ +DEXA4, 0006 /60.593191717336463 + 3622 + 7666 + 6462 + 2157 + 5534 +DEXB4, 0007 /87.417497202235527 + 2566 + 5341 + 0613 + 6705 + 7214 +DEXC4, 0005 /30.296595858668232 + 3622 + 7666 + 6462 + 2157 + 5546 +DEXD4, 0001 /1.0500 + 2063 + 1463 + 1463 + 1463 + 1462 +DEXH4, 0010 /214.17286814547704 + 3261 + 3040 + 4261 + 5654 + 0240 +DTEMP1, F 0.0 + F 0.0 +DFP2, F 2.0 + F 0.0 +/ + BASE 0 +#DEXP, STARTD + FLDA 10*3 + FSTA DEXRTN + FLDA 0 + SETX XRDEXP + SETB BPDEXP + BASE BPDEXP + LDX 1,1 + LDX 73,2 /FOR ALIGNING + FSTA BPDEXP + FLDA% BPDEXP,1 /ADDRESS OF X + FSTA BPDEXP + STARTE + FLDA% BPDEXP /GET X + LDX 0,0 + JGT DEX1 /CHECK SIGN + FNEG + LDX -1,0 /SET FLAG +DEX1, JNE DEX2 /X=0 + FLDA DEXFP1 /E^0=1 + JA DEXRTN +DEX2, FSTA X + JA DEX4 +DEX3, FCLA + JA DEXRTN /RETURN 0 FOR TOO SMALL +/ +/SET UP M+N+R=X*LOG2(E) +DEX4, FLDA LOG2E + FMULM X + FLDA X + ALN 2 /FIX + FNORM /FLOAT + FSTA M /INTEGER PART + FLDA X + FSUB M + FSTA N /FRACTION + JNE DEX50 /0 IS SPECIAL CASE + FLDA DEXFP1 /1.0 + FSTA N /N + FSTA R /R + JA DEX20 /SKIP +/ +/CALCULATE N+R +DEX50, LDX 0,1 + FLDA N + FSTA R /IF < .125 ALREADY +DEX5, FSUB DFP125 /-.125 + JLT DEX6 /DONE IF .LT. + FSTA R /STORE REMAINDER + ADDX 1,1 /NEXT POWER OF 2 + JA DEX5 /AND AGAIN +/ +/GET N FROM TABLE +DEX6, FLDA DEXFP1,1 + FSTA N +/ +/NOW CALCULATE R + FLDA R /IF R=0 + JNE DEX7 + FLDA DEXFP1 /2^R=1 + FSTA R + JA DEX20 /NO CALCULATION +/ +/ +DEX7, FLDA DEXB4 + FDIV R /(B4/R) + FSTA X + FLDA DEXD4 /D4*R + FMUL R + FADD X /+(B4/R) + FSUB DEXC4 /-C4 + FSTA DTEMP1 + FLDA R + FADD X /R+(B4/R) + FSTA R + FLDA DEXH4 + FDIV R /H4/(R+B4/R) + FADD DTEMP1 + FSTA DTEMP1 + FLDA DEXA4 + FDIV DTEMP1 + FADD DEXFP1 + FSTA R +/ +/CALCULATE 2^M +/ +DEX20, FLDA M + JNE DEX21 + FLDA DEXFP1 + FSTA M + JA DEX30 +DEX21, FNEG + ATX 1 + FLDA DEXFP1 + FSTA M + FLDA DFP2 +DEX22, FMULM M /M*2 + JXN DEX22,1+ +/CALCULATE M*N*R +DEX30, FLDA M + FMUL N + FMUL R + FSTA X + JXN DEX31,0 /WAS X MINUS + JA DEXRTN +DEX31, FLDA DEXFP1 /.1/X IF -X + FDIV X + JA DEXRTN +