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 ".TANH" - TRIPLE PRECISION HYPERBOLIC TANGENT.
      NAM .TANH,7 24998-1X068 REV.2001 780424 
* 
      ENT .TANH 
      EXT .ENTR,.CFER,.TADD,.TDIV,/CMRT,/EXTH,.4ZRO 
* 
A     EQU 0 
B     EQU 1 
* 
*     .TANH TAKES THE TRIPLE-PRECISION HYPERBOLIC TANGENT 
*     OF A TRIPLE-PRECISION ARGUMENT. 
* 
*     CALLING SEQUENCE: 
* 
*                   JSB .TANH 
*                   DEF *+3 
*                   DEF <RESULT>
*                   DEF <ARG> 
* 
*     METHOD:  THE IDENTITIES:
* 
*                   TANH(X) = (EXP(2*X)-1) / (EXP(2*X)+1) 
*                   EXP(X)  = (2**N) * (2**(X/LN(2)-N)) 
* 
*     ARE USED TO REDUCE THE PROBLEM TO EVALUATION OF 2**(Y-1)
*     ON THE INTERVAL [-.5,+.5] .  THE ROUTINE "/CMRT" IS USED
*     FOR THE REDUCTION.  ON THIS INTERVAL, "/EXTH" IS USED 
*     TO COMPUTE "EXP" GIVEN N AND Y.  FOR THE SPECIAL CASE OF
*     N=0, "TANH" IS A BY-PRODUCT OF "/EXTH", AND IS COMPUTED 
*     DIRECTLY. 
      SPC 2 
*                   RANGE REDUCE. 
* 
RESLT DEF *-* 
ARG   DEF *-* 
.TANH NOP 
      JSB .ENTR     COPY ADDRESSES
      DEF RESLT 
      CCA           FLAG TO /CMRT 
      JSB /CMRT     REDUCE
      DEF EXP2X 
      DEF .4LN2 
      DEF ARG,I 
      JMP LARGE     IF WAY TOO BIG
      SZB,RSS 
      JMP SMALL     IF N=0
      STB TEMP      SEE IF N OUTSIDE [-128,128) 
      ASL 8 
      SOC 
      JMP LARGE     YES.
      SKP 
*                   USE /EXTH TO COMPUTE EXP(2*X) . 
*                   THEN DO (EXP-1)/(EXP+1) 
* 
      LDA TEMP
      JSB /EXTH 
      DEF EXP2X 
      DEF EXP2X     RESULT
      JSB .TADD     EXP(2*X)+1
      DEF TEMP
      DEF EXP2X 
PONE  DEF ONE 
      JSB .TADD     EXP(2*X)-1
      DEF EXP2X 
      DEF EXP2X 
PMONE DEF MONE
      JSB .TDIV     RESULT = (EXP(2*X)-1) / (EXP(2*X)+1)
      DEF RESLT,I 
      DEF EXP2X 
      DEF TEMP
      JMP .TANH,I 
* 
*                   SPECIAL CASES: N LARGE AND N=0. 
* 
LARGE LDA ARG,I     PICK +1 OR -1 
      LDB PONE      B = ADDR RESULT 
      SSA 
      LDB PMONE     MAKE IT -1
EXIT  STB SRC 
      JSB .CFER     COPY IT 
      DEF RESLT,I 
SRC   DEF *-* 
      JMP .TANH,I   EXIT. 
      SPC 1 
SMALL LDB ZEROP     IN CASE ZERO
      LDA ARG,I 
      SZA,RSS       ZERO ?
      JMP EXIT      YES, RESULT = 0.
      LDA MONE      SET A = -32768 FOR SPECIAL CALL 
      JSB /EXTH 
      DEF RESLT,I 
      DEF EXP2X 
      JMP .TANH,I 
      SPC 2 
*                   LOCALS & CONSTANTS. 
* 
EXP2X BSS 4         FOR EXP(2*X)
TEMP  BSS 4         TEMP FOR EXP(2*X)+1 
      SUP 
.4LN2 OCT 056125,016624,127013,174006 
ONE   DEY 1.0 
MONE  DEY -1.0
ZEROP DEF .4ZRO+0 
      UNS 
      END 
  