sw/os8/v3d/sources/fortran/all/expid2.ra

   1 /
   2 /
   3 /
   4 /       E  X  P  I  D  2
   5 /       -  -  -  -  -  -
   6 /
   7 /SUBROUTINE     EXPID2(B,E)
   8 /WHERE B IS INTEGER AND E IS DOUBLE
   9 /
  10 / VERSION 5A 4-26-77 MH
  11 /
  12         SECT    EXPID2
  13         JA      #EXID2
  14         EXTERN  #ARGER
  15 EXP3ER, TRAP4   #ARGER
  16         TEXT    +EXPID2+
  17 EXP3XR, SETX    XREXP3
  18         SETB    BPEXP3
  19 BPEXP3, FNOP
  20         0
  21         0
  22 XREXP3, F 0.0
  23 EXP31,  F 0.0
  24         F 0.0
  25 EXP32,  F 0.0
  26 FP1XP3, F 1.
  27         F 0.0
  28         ORG     10*3+BPEXP3
  29         FNOP
  30         JA      EXP3XR
  31         0
  32 XP3RTN, JA      .
  33         BASE            0
  34 #EXID2, STARTD
  35         FLDA    10*3
  36         FSTA    XP3RTN
  37         FLDA    0
  38         SETX    XREXP3
  39         SETB    BPEXP3
  40         BASE    BPEXP3
  41         LDX     1,1
  42         FSTA    BPEXP3
  43         FLDA%   BPEXP3,1        /ADDR OF B
  44         FSTA    EXP31
  45         FLDA%   BPEXP3,1+       /ADDR OF E
  46         FSTA    EXP32
  47         STARTF
  48         FLDA%   EXP31   /GET B
  49         JEQ     XP3RTN  /0 ^ X = 0
  50         JLT     EXP3ER
  51         FSTA    EXP31   /SAVE BASE
  52         FCLA
  53         FSTA    EXP31+3
  54         STARTE
  55         LDX     73,1
  56         EXTERN  DLOG
  57         JSR     DLOG    /CALL LOG
  58         JA      .+4     /TAKE LOG (B)
  59         JA      EXP31
  60         FSTA    EXP31
  61         FLDA%   EXP32           /GET EXPONENT
  62         JEQ     EXP3ON          /X^0=1
  63         FMULM   EXP31
  64         EXTERN  DEXP
  65         JSR     DEXP    /CALL EXP.
  66         JA      XP3RTN
  67         JA      EXP31
  68 EXP3ON, STARTE
  69         FLDA    FP1XP3
  70         JA      XP3RTN
  71 \f