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 * DEF * * 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