X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fexpdi.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fexpdi.ra;h=fb3f8ffb539ad618ad90662102815c2e1d6c0ba4;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/expdi.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/expdi.ra
new file mode 100644
index 0000000..fb3f8ff
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/expdi.ra
@@ -0,0 +1,63 @@
+	SECT	#EXPDI
+/	B**E
+/	WHERE E IS INTEGER
+/	AND B IS DOUBLE PRECISION
+/
+/ VERSION 5A 4-26-77 MH
+/
+	DPCHK
+	BASE	0
+EXPDI,	JA	.
+	FSTA	SIGN		/SAVE SIGN OF EXPONENT
+	JGE	POSINT		/ITS POSITIVE
+	FNEG
+POSINT,	FSTA	EXP
+	XTA	1		/SAVE XR 1
+	FSTA	XR1
+	LDX	-27,1		/BIT COUNT
+	STARTE
+	FLDA	ONE		/START WITH ONE
+	FSTA	PROD
+	STARTF
+	FLDA	EXP
+LOOP,	JEQ	YES		/DONE IF ITS ZERO
+	FDIV	TWO		/DIVIDE BY TWO
+	ALN	0		/INTEGERIZE
+	FNORM
+	FSTA	TEMP		/SAVE AT
+	FMUL	TWO		/IS EXPONENT ODD ?
+	FSUB	EXP
+	STARTE
+	JLT	ODD		/YES, JUMP
+	FLDA	0		/SQUARE BASE
+SQUARE,	FMULM	0
+	STARTF
+	FLDA	TEMP		/EXPONENT OVER 2
+	FSTA	EXP
+	JXN	LOOP,1+		/LOOP IF MORE BITS
+YES,	FLDA	XR1		/DONE, RESTORE XR 1
+	ATX	1
+	FLDA	SIGN		/CHECK SIGN OF EXPONENT
+	JLT	INVERT		/IT WS NEGATIVE, INVERT RESULT
+	STARTE
+	FLDA	PROD		/RETURN ANSWER
+	JA	EXPDI
+INVERT,	STARTE
+	FLDA	ONE		/RETURN WITH 1/PROD
+	FDIV	PROD
+	JA	EXPDI
+ODD,	FLDA	0
+	FMULM	PROD
+	JA	SQUARE		/GO SQUARE THE BASE
+ONE,	F	1.0
+	F 0.0
+TWO,	F	2.0
+PROD,	F	0.0
+	F 0.0
+SIGN,	F	0.0
+TEMP,	F	0.0
+XR1,	F	0.0
+EXP,	F 0.0
+	F 0.0
+	END
+