ASMB,L,R,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 "/EXTH" - COMMON CODE FOR .EXP AND .TANH . HYPERBOLIC TANGENT.
      NAM /EXTH,7 24998-1X175 REV.2001 790417 
* 
      ENT /EXTH 
      EXT .PWR2,.TADD,DPOLY 
* 
A     EQU 0 
B     EQU 1 
* 
*     /EXTH PERFORMS  X _ (2**N) * (2.**(X/2)) AS COMMON FUNCTION FOR 
*     .EXP & .TANH .  IF N=-32768 THE SPECIAL CASE X _ TANH(X) IS DONE. 
* 
*     CALLING SEQUENCE: 
* 
*                   LDA N         -32768 FOR TANH, N=0. 
*                   JSB /EXTH 
*                   DEF <RESULT>
*                   DEF <ARG> 
* 
*     METHOD:  THE FOLLOWING APPROXIMATIONS ARE USED: 
* 
*                 2**(Y-1)-0.5 = P(Y)/(Q(Y)-P(Y)) 
*                      TANH(Y) = P(Y)/Q(Y)
*                         P(Y) = Y*(P0+YSQ*(P1+YSQ*P2)) 
*                         Q(Y) = Q0+YSQ*(Q1+YSQ)
*     WHERE:
*                   P0 = 1513.86417304653562
*                   P1 = 20.2017000069531260
*                   P2 = .023094321272953857
*                   Q0 = 4368.08867006741699
*                   Q1 = 233.178232051431036
* 
      SPC 3 
*                   COPY ADDRESSES, CHECK IF SPECIAL. 
* 
/EXTH NOP 
      LDB /EXTH     COPY RESULT ADDR
      ISZ /EXTH 
      LDB B,I       REMOVE INDIRECTS. 
      RBL,CLE,SLB,ERB 
      JMP *-2 
      STB X 
      ADB =D3       ADDR LAST WD RESULT 
      STB XP3 
      LDB /EXTH,I   ADDR ARG
      ISZ /EXTH 
      STB ARG 
      CPA =D-32768  SPECIAL CASE ?
      JMP EXTH1     YES.
      STA N         NO, SAVE N
      SKP 
*                   COMPUTE 2**(Y-1) = 0.5+P/(Q-P)
* 
      JSB DPOLY     COMPUTE P/(Q-P) 
      OCT 140000
      DEF X,I 
ARG   DEF *-* 
      DEF P2
      DEF TWO 
      DEF TWO 
      JSB .TADD     0.5+P/(Q-P) 
X     DEF *-* 
      DEF HALF
      DEF X,I 
* 
*                   SCALE RESULT BY 2**N. 
* 
      LDA N         N 
      ARS           N/2 
      INA           N/2+1 = SCALE FACTOR
      STA N 
      LDB XP3,I     COMPUTE FINAL EXPONENT
      CCA           SET A NONZERO FOR .PWR2 
      JSB .PWR2     EXP(X)
      DEF N 
      STB XP3,I 
      JMP /EXTH,I   EXIT
* 
*                   SPECIAL CASE, RETURN P/Q .
* 
EXTH1 JSB DPOLY 
      OCT 100000
      DEF X,I 
      DEF ARG,I 
      DEF P2
      DEF TWO 
      DEF TWO 
      JMP /EXTH,I   EXIT
* 
*                   LOCALS & CONSTANTS. 
* 
N     BSS 1         N 
XP3   BSS 1         POINTER TO LAST WORD OF ARG/RESULT
TWO   DEC 2 
      SUP 
P2    OCT 057230,023251,071521,101365 
P1    OCT 050316,105162,052735,154414 
P0    OCT 057235,151647,016717,044034 
Q1    OCT 072226,150116,147777,063024 
Q0    OCT 042100,055314,051576,141442 
HALF  OCT 040000,0,0,0  4-WD 0.5
      UNS 
      END 
                                                                                                                                                                                                                                                              