+/
+/
+/ 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<R<1/8
+/AND M+N+R=M+F=X*LOG2(E)
+/
+/(2^M)*(2^N)*(2^R)=E^X
+/
+/2^M IS CALCULATED BY SUCCESSIVE MULTIPLIES
+/2^N IS CALCULATED BY LOOK UP
+/2^R=1+<A4/((B4/R)-C4+(D4*R)+(H4/(R+(B4/R))))>
+/
+/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
+\f\1e