A large commit.

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

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/alog.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/alog.ra
new file mode 100644 (file)
index 0000000..3c710f7
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/alog.ra
@@ -0,0 +1,149 @@
+/
+/
+/      A  L  O  G
+/      -  -  -  -
+/
+/SUBROUTINE    ALOG(X)
+/
+/ VERSION 5A 4-26-77 (MH)
+/
+       SECT    ALOG
+       JA      #ALOG
+       0                       /WORKING SPACE FOR EXPONENT DIDDLE.
+       0
+       0
+ALOGTM,        0
+       0
+       0
+       0
+F2ALOG,        F 2.
+FPI2,  1
+       3110
+       3755
+/
+       EXTERN  #ARGER
+ALOG0, TRAP4   #ARGER
+       JA      ALGRTN          /RETURN NOW.
+/
+       EXTERN  #ARGER
+ALOGM1,        TRAP4   #ARGER
+       JA      ALGRTN
+       TEXT    +ALOG  +
+ALOGXR,
+BPALOG,        F 0.0
+XRALOG,        F 0.0
+ALOG1, F 0.0
+ALOG2, F 0.0
+F1ALOG,        F 1.
+/
+ALOGMG,        0
+       0
+       13                      /CORRECT EXPONENT DIDDLER.
+/
+/
+/
+/
+ALOGL1,        0
+       3777
+       7742
+/
+ALOGE2,        0
+       2613
+       4414
+/
+       ORG     10*3+BPALOG
+       FNOP
+       JA      ALOGXR
+       0
+ALGRTN,        JA      .
+ALOGL2,        7777
+       4000
+       4100
+/
+ALOGL3,        7777
+       2517
+       0310
+/
+ALOGL4,        7776
+       4113
+       7211
+/
+ALOGL5,        7776
+       2535
+       3301
+/
+ALOGL6,        7775
+       4746
+       0771
+/
+ALOGL7,        7774
+       2236
+       4304
+/
+ALOGL8,        7771
+       4544
+       1735
+       BASE    0
+#ALOG, STARTD
+       FLDA    10*3
+       FSTA    ALGRTN
+       FLDA    0
+       SETX    XRALOG
+       SETB    BPALOG
+       BASE    BPALOG
+       LDX     1,1     
+       FSTA    BPALOG
+       FLDA%   BPALOG,1  /ADDR OF X
+       FSTA    BPALOG
+       STARTF
+       FLDA%   BPALOG  /GET X
+       JEQ     ALOG0   /IF  =0 THEN ERROR
+       JLT     ALOGM1  /IF<0 THEN ERROR
+       LDX     -1,0    /IF >0 THEN START DOING
+       FSTA    ALOG1           /SAVE IN A TEMP.
+       FSUB    F1ALOG          /KNOCK OFF ONE.
+       JEQ     ALGRTN          /IF ZERO EXIT. LOG(1)=0
+       JGE     ALOGST          /IF POSITIVE LOG>0
+       FLDA    F1ALOG          /NEGITE. INVERT IT.
+       FDIV    ALOG1           /BY DIVIDING INTO ONE.
+       FSTA    ALOG1
+       LDX     0,0             /RESET SIGN TO NEGATIVE.
+       JA      .+3             /AVOID USELESS LOAD INSTRUCTION.
+/
+ALOGST,        FLDA    ALOG1           /RECALL NUMBER.
+       FDIV    F2ALOG          /CUT IN HALF.
+       FSTA    ALOGTM          /PREPARE FOR EXPONENT DIDDLE.
+       FLDA    ALOGMG          /SET THE EXPONENT OF THE EXPONENT TO 13.
+       FSTA    ALOGTM-3        /SO THAT NORMALIZE WILL DO JOB.
+       FSTA    ALOGTM+1        /AND ALSO ZERO OUT LOW ORDER POART OF EX. MANT.
+       FLDA    ALOGTM-1        /RECALL THE NUMBER
+       FNORM                   /NORMALIZE IT.
+       FMUL    ALOGE2          /NOW MULITPLY EXPONENT BY LOG E 2
+       FSTA    ALOG2           /AND SAVE IT FOR A SECOND.
+       FLDA    ALOG1           /RECALL THE NUMBER AGAIN.
+       FSTA    ALOGTM          /STORE IN THE TEMPORARY WORKER.
+       FLDA    FPI2-2          /RECALL WORD WITH LOW ORDER ONE.
+       FSTA    ALOGTM-2        /STORE AWAY.
+       FLDA    ALOGTM          /RECALL NUMBER WITH AN EXPONENT OF 1
+       FSUB    F1ALOG          /SUBTRACT AWAY.
+       FSTA    ALOG1           /AND STORE
+       FMUL    ALOGL8          /MULTIPLY BY THE CONSTANT.
+       FADD    ALOGL7          /ADD IN
+       FMUL    ALOG1           /MULT.
+       FADD    ALOGL6          /AND SO ON DOWN THE LINE.
+       FMUL    ALOG1
+       FADD    ALOGL5
+       FMUL    ALOG1
+       FADD    ALOGL4
+       FMUL    ALOG1
+       FADD    ALOGL3
+       FMUL    ALOG1
+       FADD    ALOGL2
+       FMUL    ALOG1
+       FADD    ALOGL1
+       FMUL    ALOG1
+       FADD    ALOG2           /CORRECT NOW.ADD IN EXPONENT.
+       JXN     ALGRTN,0                /EXIT IF SIGN IS OK.
+       FNEG                    /ELSE NEGATE IT.
+       JA      ALGRTN
+\f