sw/os8/v3d/sources/fortran/dectapes/dectape2/alog.ra

   1 /
   2 /
   3 /       A  L  O  G
   4 /       -  -  -  -
   5 /
   6 /SUBROUTINE     ALOG(X)
   7 /
   8 / VERSION 5A 4-26-77 (MH)
   9 /
  10         SECT    ALOG
  11         JA      #ALOG
  12         0                       /WORKING SPACE FOR EXPONENT DIDDLE.
  13         0
  14         0
  15 ALOGTM, 0
  16         0
  17         0
  18         0
  19 F2ALOG, F 2.
  20 FPI2,   1
  21         3110
  22         3755
  23 /
  24         EXTERN  #ARGER
  25 ALOG0,  TRAP4   #ARGER
  26         JA      ALGRTN          /RETURN NOW.
  27 /
  28         EXTERN  #ARGER
  29 ALOGM1, TRAP4   #ARGER
  30         JA      ALGRTN
  31         TEXT    +ALOG  +
  32 ALOGXR,
  33 BPALOG, F 0.0
  34 XRALOG, F 0.0
  35 ALOG1,  F 0.0
  36 ALOG2,  F 0.0
  37 F1ALOG, F 1.
  38 /
  39 ALOGMG, 0
  40         0
  41         13                      /CORRECT EXPONENT DIDDLER.
  42 /
  43 /
  44 /
  45 /
  46 ALOGL1, 0
  47         3777
  48         7742
  49 /
  50 ALOGE2, 0
  51         2613
  52         4414
  53 /
  54         ORG     10*3+BPALOG
  55         FNOP
  56         JA      ALOGXR
  57         0
  58 ALGRTN, JA      .
  59 ALOGL2, 7777
  60         4000
  61         4100
  62 /
  63 ALOGL3, 7777
  64         2517
  65         0310
  66 /
  67 ALOGL4, 7776
  68         4113
  69         7211
  70 /
  71 ALOGL5, 7776
  72         2535
  73         3301
  74 /
  75 ALOGL6, 7775
  76         4746
  77         0771
  78 /
  79 ALOGL7, 7774
  80         2236
  81         4304
  82 /
  83 ALOGL8, 7771
  84         4544
  85         1735
  86         BASE    0
  87 #ALOG,  STARTD
  88         FLDA    10*3
  89         FSTA    ALGRTN
  90         FLDA    0
  91         SETX    XRALOG
  92         SETB    BPALOG
  93         BASE    BPALOG
  94         LDX     1,1
  95         FSTA    BPALOG
  96         FLDA%   BPALOG,1  /ADDR OF X
  97         FSTA    BPALOG
  98         STARTF
  99         FLDA%   BPALOG  /GET X
 100         JEQ     ALOG0   /IF  =0 THEN ERROR
 101         JLT     ALOGM1  /IF<0 THEN ERROR
 102         LDX     -1,0    /IF >0 THEN START DOING
 103         FSTA    ALOG1           /SAVE IN A TEMP.
 104         FSUB    F1ALOG          /KNOCK OFF ONE.
 105         JEQ     ALGRTN          /IF ZERO EXIT. LOG(1)=0
 106         JGE     ALOGST          /IF POSITIVE LOG>0
 107         FLDA    F1ALOG          /NEGITE. INVERT IT.
 108         FDIV    ALOG1           /BY DIVIDING INTO ONE.
 109         FSTA    ALOG1
 110         LDX     0,0             /RESET SIGN TO NEGATIVE.
 111         JA      .+3             /AVOID USELESS LOAD INSTRUCTION.
 112 /
 113 ALOGST, FLDA    ALOG1           /RECALL NUMBER.
 114         FDIV    F2ALOG          /CUT IN HALF.
 115         FSTA    ALOGTM          /PREPARE FOR EXPONENT DIDDLE.
 116         FLDA    ALOGMG          /SET THE EXPONENT OF THE EXPONENT TO 13.
 117         FSTA    ALOGTM-3        /SO THAT NORMALIZE WILL DO JOB.
 118         FSTA    ALOGTM+1        /AND ALSO ZERO OUT LOW ORDER POART OF EX. MANT.
 119         FLDA    ALOGTM-1        /RECALL THE NUMBER
 120         FNORM                   /NORMALIZE IT.
 121         FMUL    ALOGE2          /NOW MULITPLY EXPONENT BY LOG E 2
 122         FSTA    ALOG2           /AND SAVE IT FOR A SECOND.
 123         FLDA    ALOG1           /RECALL THE NUMBER AGAIN.
 124         FSTA    ALOGTM          /STORE IN THE TEMPORARY WORKER.
 125         FLDA    FPI2-2          /RECALL WORD WITH LOW ORDER ONE.
 126         FSTA    ALOGTM-2        /STORE AWAY.
 127         FLDA    ALOGTM          /RECALL NUMBER WITH AN EXPONENT OF 1
 128         FSUB    F1ALOG          /SUBTRACT AWAY.
 129         FSTA    ALOG1           /AND STORE
 130         FMUL    ALOGL8          /MULTIPLY BY THE CONSTANT.
 131         FADD    ALOGL7          /ADD IN
 132         FMUL    ALOG1           /MULT.
 133         FADD    ALOGL6          /AND SO ON DOWN THE LINE.
 134         FMUL    ALOG1
 135         FADD    ALOGL5
 136         FMUL    ALOG1
 137         FADD    ALOGL4
 138         FMUL    ALOG1
 139         FADD    ALOGL3
 140         FMUL    ALOG1
 141         FADD    ALOGL2
 142         FMUL    ALOG1
 143         FADD    ALOGL1
 144         FMUL    ALOG1
 145         FADD    ALOG2           /CORRECT NOW.ADD IN EXPONENT.
 146         JXN     ALGRTN,0                /EXIT IF SIGN IS OK.
 147         FNEG                    /ELSE NEGATE IT.
 148         JA      ALGRTN
 149 \f