sw/f4/FRTSRC/dexp.ra

   1 /
   2 /
   3 /    SUBROUTINE DEXP
   4 /
   5 / VERSION 5A 4-26-77 MH
   6 /
   7 /E^X=2^(X*LOG2(E))
   8 /E^X=2^(M+F)
   9 /M=INTEGER; F=FRACTION
  10 /
  11 /2^(M+F)=2^(M+N+R)
  12 /WHERE 0<R<1/8
  13 /AND M+N+R=M+F=X*LOG2(E)
  14 /
  15 /(2^M)*(2^N)*(2^R)=E^X
  16 /
  17 /2^M IS CALCULATED BY SUCCESSIVE MULTIPLIES
  18 /2^N IS CALCULATED BY LOOK UP
  19 /2^R=1+<A4/((B4/R)-C4+(D4*R)+(H4/(R+(B4/R))))>
  20 /
  21 /RESTRICTIONS:
  22 /X=0 IMPLIES E^X=1
  23 /
  24 /X>88.028 IMPLIES E^X=3377/3377/3777/7777/777/7777
  25 /
  26 /X<-88.028 IMPLIES E^X=0
  27 /
  28 /
  29 /
  30         SECT    DEXP
  31         JA      #DEXP
  32         DPCHK
  33         TEXT    +DEXP  +
  34 /
  35 DEXPXR, SETX    XRDEXP
  36         SETB    BPDEXP
  37 /
  38 /BEGINNING OF BASE PAGE
  39 /
  40 BPDEXP, F 0.0
  41 XRDEXP, F 0.0
  42 X,      F 0.0
  43         F 0.0
  44 /
  45         ORG     10*3+BPDEXP
  46         FNOP
  47         JA      DEXPXR
  48         0
  49 DEXRTN, JA      .
  50 /
  51 TOPLIM, 3377
  52         3377
  53         3777
  54         7777
  55         7777
  56         7777
  57 M,      F 0.0
  58         F 0.0
  59 N,      F 0.0
  60         F 0.0
  61 R,      F 0.0
  62         F 0.0
  63 LOG2E,  0001            /1.4426950408889634
  64         2705
  65         2435
  66         4512
  67         7013
  68         7603
  69 DFP125, 7775            /.125
  70         3777
  71         7777
  72         7777
  73         7777
  74         7776
  75 DEXFP1, F 1.0
  76         F 0.0
  77 /
  78 DFR1S8, 0001            /2^1/8
  79         2134
  80         5340
  81         7437
  82         2505
  83         7302
  84 DFP2S8, 0001            /2^2/8
  85         2301
  86         5770
  87         1214
  88         3334
  89         2524
  90 DFP3S8, 0001            /2^3/8
  91         2457
  92         7553
  93         2515
  94         4250
  95         4720
  96 DFP4S8, 0001            /2^4/8
  97         2650
  98         1171
  99         4637
 100         6357
 101         1425
 102 DFP5S8, 0001            /2^5/8
 103         3053
 104         1625
 105         0212
 106         5174
 107         3070
 108 DFP6S8, 0001            /2^6/8
 109         3272
 110         1176
 111         3126
 112         5516
 113         5532
 114 DFP7S8, 0001            /2^7/8
 115         3526
 116         0143
 117         3476
 118         7222
 119         0722
 120 /
 121 /
 122 DEXA4,  0006            /60.593191717336463
 123         3622
 124         7666
 125         6462
 126         2157
 127         5534
 128 DEXB4,  0007            /87.417497202235527
 129         2566
 130         5341
 131         0613
 132         6705
 133         7214
 134 DEXC4,  0005            /30.296595858668232
 135         3622
 136         7666
 137         6462
 138         2157
 139         5546
 140 DEXD4,  0001            /1.0500
 141         2063
 142         1463
 143         1463
 144         1463
 145         1462
 146 DEXH4,  0010            /214.17286814547704
 147         3261
 148         3040
 149         4261
 150         5654
 151         0240
 152 DTEMP1, F 0.0
 153         F 0.0
 154 DFP2,   F 2.0
 155         F 0.0
 156 /
 157         BASE    0
 158 #DEXP,  STARTD
 159         FLDA    10*3
 160         FSTA    DEXRTN
 161         FLDA    0
 162         SETX    XRDEXP
 163         SETB    BPDEXP
 164         BASE    BPDEXP
 165         LDX     1,1
 166         LDX     73,2            /FOR ALIGNING
 167         FSTA    BPDEXP
 168         FLDA%   BPDEXP,1        /ADDRESS OF X
 169         FSTA    BPDEXP
 170         STARTE
 171         FLDA%   BPDEXP  /GET X
 172         LDX     0,0
 173         JGT     DEX1    /CHECK SIGN
 174         FNEG
 175         LDX     -1,0    /SET FLAG
 176 DEX1,   JNE     DEX2    /X=0
 177         FLDA    DEXFP1          /E^0=1
 178         JA      DEXRTN
 179 DEX2,   FSTA    X
 180         JA      DEX4
 181 DEX3,   FCLA
 182         JA      DEXRTN          /RETURN 0 FOR TOO SMALL
 183 /
 184 /SET UP M+N+R=X*LOG2(E)
 185 DEX4,   FLDA    LOG2E
 186         FMULM   X
 187         FLDA    X
 188         ALN     2       /FIX
 189         FNORM           /FLOAT
 190         FSTA    M       /INTEGER PART
 191         FLDA    X
 192         FSUB    M
 193         FSTA    N       /FRACTION
 194         JNE     DEX50   /0 IS SPECIAL CASE
 195         FLDA    DEXFP1  /1.0
 196         FSTA    N       /N
 197         FSTA    R       /R
 198         JA      DEX20   /SKIP
 199 /
 200 /CALCULATE N+R
 201 DEX50,  LDX     0,1
 202         FLDA    N
 203         FSTA    R       /IF < .125 ALREADY
 204 DEX5,   FSUB    DFP125  /-.125
 205         JLT     DEX6    /DONE IF .LT.
 206         FSTA    R       /STORE REMAINDER
 207         ADDX    1,1     /NEXT POWER OF 2
 208         JA      DEX5    /AND AGAIN
 209 /
 210 /GET N FROM TABLE
 211 DEX6,   FLDA    DEXFP1,1
 212         FSTA    N
 213 /
 214 /NOW CALCULATE R
 215         FLDA    R       /IF R=0
 216         JNE     DEX7
 217         FLDA    DEXFP1  /2^R=1
 218         FSTA    R
 219         JA      DEX20   /NO CALCULATION
 220 /
 221 /
 222 DEX7,   FLDA    DEXB4
 223         FDIV    R       /(B4/R)
 224         FSTA    X
 225         FLDA    DEXD4   /D4*R
 226         FMUL    R
 227         FADD    X       /+(B4/R)
 228         FSUB    DEXC4   /-C4
 229         FSTA    DTEMP1
 230         FLDA    R
 231         FADD    X       /R+(B4/R)
 232         FSTA    R
 233         FLDA    DEXH4
 234         FDIV    R       /H4/(R+B4/R)
 235         FADD    DTEMP1
 236         FSTA    DTEMP1
 237         FLDA    DEXA4
 238         FDIV    DTEMP1
 239         FADD    DEXFP1
 240         FSTA    R
 241 /
 242 /CALCULATE 2^M
 243 /
 244 DEX20,  FLDA    M
 245         JNE     DEX21
 246         FLDA    DEXFP1
 247         FSTA    M
 248         JA      DEX30
 249 DEX21,  FNEG
 250         ATX     1
 251         FLDA    DEXFP1
 252         FSTA    M
 253         FLDA    DFP2
 254 DEX22,  FMULM   M       /M*2
 255         JXN     DEX22,1+
 256 /CALCULATE M*N*R
 257 DEX30,  FLDA    M
 258         FMUL    N
 259         FMUL    R
 260         FSTA    X
 261         JXN     DEX31,0 /WAS X MINUS
 262         JA      DEXRTN
 263 DEX31,  FLDA    DEXFP1  /.1/X IF -X
 264         FDIV    X
 265         JA      DEXRTN
 266 \f\1e