sw/f4/FRTSRC/expdi.ra

   1         SECT    #EXPDI
   2 /       B**E
   3 /       WHERE E IS INTEGER
   4 /       AND B IS DOUBLE PRECISION
   5 /
   6 / VERSION 5A 4-26-77 MH
   7 /
   8         DPCHK
   9         BASE    0
  10 EXPDI,  JA      .
  11         FSTA    SIGN            /SAVE SIGN OF EXPONENT
  12         JGE     POSINT          /ITS POSITIVE
  13         FNEG
  14 POSINT, FSTA    EXP
  15         XTA     1               /SAVE XR 1
  16         FSTA    XR1
  17         LDX     -27,1           /BIT COUNT
  18         STARTE
  19         FLDA    ONE             /START WITH ONE
  20         FSTA    PROD
  21         STARTF
  22         FLDA    EXP
  23 LOOP,   JEQ     YES             /DONE IF ITS ZERO
  24         FDIV    TWO             /DIVIDE BY TWO
  25         ALN     0               /INTEGERIZE
  26         FNORM
  27         FSTA    TEMP            /SAVE AT
  28         FMUL    TWO             /IS EXPONENT ODD ?
  29         FSUB    EXP
  30         STARTE
  31         JLT     ODD             /YES, JUMP
  32         FLDA    0               /SQUARE BASE
  33 SQUARE, FMULM   0
  34         STARTF
  35         FLDA    TEMP            /EXPONENT OVER 2
  36         FSTA    EXP
  37         JXN     LOOP,1+         /LOOP IF MORE BITS
  38 YES,    FLDA    XR1             /DONE, RESTORE XR 1
  39         ATX     1
  40         FLDA    SIGN            /CHECK SIGN OF EXPONENT
  41         JLT     INVERT          /IT WS NEGATIVE, INVERT RESULT
  42         STARTE
  43         FLDA    PROD            /RETURN ANSWER
  44         JA      EXPDI
  45 INVERT, STARTE
  46         FLDA    ONE             /RETURN WITH 1/PROD
  47         FDIV    PROD
  48         JA      EXPDI
  49 ODD,    FLDA    0
  50         FMULM   PROD
  51         JA      SQUARE          /GO SQUARE THE BASE
  52 ONE,    F       1.0
  53         F 0.0
  54 TWO,    F       2.0
  55 PROD,   F       0.0
  56         F 0.0
  57 SIGN,   F       0.0
  58 TEMP,   F       0.0
  59 XR1,    F       0.0
  60 EXP,    F 0.0
  61         F 0.0
  62         END
  63 \f