ASMB,R,L,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED "DEXP" DOUBLE PRECISION EXPONENTIAL (DLB) 
      NAM DEXP,6 24998-1X165 REV.2001 750701
      ENT DEXP
      EXT .ZRNT,SNGL,IFIX,DDINT 
      EXT .XADD,.XSUB,.XMPY,.XDIV 
      EXT .FLUN,.XPAK,.ENTP,.DFER 
      SPC 1 
* 
*     CALLING SEQUENCE: Y = EXP(X)
*     JSB DEXP
*     DEF *+3 
*     DEF Y         (RESULT)
*     DEF X         (ARGUMENT)
*     (ERROR RETURN)
*     (NORMAL RETURN) 
      SPC 2 
TDB   NOP 
      DEC 18
      NOP 
T     REP 3         TEMPORY STORAGE 
      NOP 
EXPON NOP           EXPONENT FOR REDUCED RANGE
P1    REP 3         STORAGE 
      NOP 
Q1    REP 3          FOR
      NOP 
P2    REP 3           EVALUATION. 
      NOP 
Y     NOP           ADDRESS OF Y
X     NOP           ADDRESS OF X
DEXP  NOP 
      JSB .ZRNT 
      DEF LIBX
      JSB .ENTP     TRANSFER PARAMETERS 
      DEF Y 
      STA TDB+2 
      JSB .XMPY      T = X * LOG2(E)
      DEF T 
      DEF X,I 
      DEF LOG2E 
      LDA T 
      SSA 
      JMP X.NEG 
      JSB .XADD      IF X > 0, P1 = T + .5
      DEF P1
      DEF T 
      DEF D.5 
      JMP INTGR 
X.NEG JSB .XSUB      IF X < 0, P1 = T - .5
      DEF P1
      DEF T 
      DEF D.5 
      NOP           GIVE THE INTERUPTS A CHANCE 
INTGR JSB DDINT     P1 = LARGEST INTEGER <= ABS(P1) 
      DEF *+3 
      DEF P1
      DEF P1
      NOP           GIVE THE INTERUPTS A CHANCE 
      JSB SNGL     CONVERT P1 TO INTEGER
      DEF *+2 
      DEF P1
      JSB IFIX
      STA EXPON      AND SAVE.
      JSB .XSUB      T = T - Y
      DEF T 
      DEF T 
      DEF P1
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      T = T * LN(2)
      DEF T 
      DEF T 
      DEF LN2 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      P1 = T * C3
      DEF P1
      DEF T 
      DEF C3
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      Q1 = T * T 
      DEF Q1
      DEF T 
      DEF T 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      Q1 = T * T + C4
      DEF Q1
      DEF Q1
      DEF C4
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY 
      DEF P2
      DEF Q1
      DEF C2
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      Q1 = Q1 * T
      DEF Q1
      DEF Q1
      DEF T 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      Q1 = Q1 * T + P1 
      DEF Q1
      DEF Q1
      DEF P1
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      P1 = Q1 * C1 
      DEF P1
      DEF Q1
      DEF C1
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      T = T + B1 
      DEF T 
      DEF T 
      DEF B1
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      T = (T + B1) * Q1
      DEF T 
      DEF T 
      DEF Q1
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      T = (T + B1) * Q1  + P2
      DEF T 
      DEF T 
      DEF P2
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XDIV      T = P1 / T 
      DEF T 
      DEF P1
      DEF T 
      JSB .XADD      T = C0 + P1 / T
      DEF T 
      DEF T 
      DEF C0
      LDB T+2 
      JSB .FLUN     UNPACK EXPONENT 
      STB T+2 
      ADA EXPON     ADD EXPONENT FROM RANGE REDUCTN 
      SOC           OVERFLOW ?
      JMP ERROR     YES. ERROR MESSAGE. 
      JSB .XPAK     PACK RESULT 
      DEF T 
      LDA T 
      SOC           OVERFLOW BIT SET ?
      SZA,RSS       YES. AND = 0 ?
      JMP OK        NO OVERFLOW, OR AN UNDERFLOW
ERROR LDA ERMSG     ERROR RETURN
      LDB ERMSG+1 
LIBX  JMP TDB+2,I   RETURN
      DEF TDB 
      DEC 0 
OK    JSB .DFER     ANSWER OKAY 
      DEF Y,I 
      DEF T 
      ISZ TDB+2 
      JMP LIBX      DONE
      SPC 1 
ERMSG ASC 2,10OF
D.5   OCT 040000,0,0               .5 
C0    OCT 040000,0,2               1. 
C1    OCT 050000,0,14              40.
C2    OCT 042400,0,20              138. 
C3    OCT 073515,164675,033412     29.82608695652 
C4    OCT 060544,026205,110410     12.17391304347 
B1    OCT 130000,0,12              -20. 
LN2   OCT 054271,005773,164400     LN(2)
LOG2E OCT 056125,016624,127002     LOG2(E)
      END 
* 
                      