A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape2 / expdi.ra

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 (file)
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
+\f