File: DEXP.RA of Tape: Sources/Fortran/os8-f4-3
(Source file text) 
/D=DEXP(D) DOUBLE PREC. EXPONENTIAL
/
/
/ VERSION 40A 28-MAY-80 WVDM
/
/
/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
/
/
	SECT	DEXP
	JA	#DEXP
	DPCHK
	TEXT	+DEXP  +
DEXPXR,	SETX	XRDEXP
	SETB	BPDEXP
BPDEXP,	F 0.0
XRDEXP,	F 0.0
X,	F 0.0
	F 0.0
DTEMP1,	F 0.0
	F 0.0
DFP2,	F 2.0
	F 0.0
	ORG	10*3+BPDEXP
	FNOP
	JA	DEXPXR
	0
DEXRTN,	JA	.
/
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		/2^0/8
	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
/
	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
	FMUL	X
	FSTA	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
	JA	DEX23
DEX21,	FNEG
	ATX	1
	FLDA	DEXFP1
DEX22,	FMUL	DFP2
	JXN	DEX22,1+
DEX23,	FSTA	M		/M*2
/
/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