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 "DLOG" DOUBLE PRECISION NATURAL LOGARITHM 
      NAM DLOG,6 24998-1X166 REV.2001 750701
      ENT DLOG
      EXT .ZRNT,.ENTP 
      EXT .XADD,.XSUB,.XMPY,.XDIV 
      EXT .DFER,.FLUN,FLOAT,DBLE
      SPC 2 
* 
*     CALLING SEQUENCE : Y = LN(X)
*     JSB DLOG
*     DEF *+3 
*     DEF Y    (RESULT) 
*     DEF X    (ARGUMENT) 
*     (ERROR RETURN)
*     (NORMAL RETURN) 
      SPC 2 
TDB   NOP 
      DEC 23
      NOP 
T     REP 3         TEMPORARY STORAGE 
      NOP 
U     REP 3        (EXPON - 1/2) * LN(2)
      NOP 
V     REP 3 
      NOP 
Z     REP 3 
      NOP 
P1    REP 3 
      NOP 
Q1    REP 3 
      NOP 
Y     NOP           ADDRESS OF Y
X     NOP           ADDRESS OF X
DLOG  NOP 
      JSB .ZRNT 
      DEF LIBX
      JSB .ENTP 
      DEF Y 
      STA TDB+2 
      JSB .DFER     MOVE X INTO T 
      DEF T 
      DEF X,I 
      LDA T 
      SSA,RSS       IF X < 0
      SZA,RSS         OR X = 0
      JMP ERROR         GO TO ERROR EXIT. 
      LDB T+2 
      JSB .FLUN     UNPACK THE EXPONENT 
      STB T+2 
      JSB FLOAT      AND
      FSB F.5       U = EXPON -.5 
      STA U 
      STB U+1 
      JSB DBLE        CONVERT TO DOUBLE PRECISION 
      DEF *+3 
      DEF U 
      DEF U 
      JSB .XMPY      U = (EXPON - .5) * LN(2) 
      DEF U 
      DEF U 
      DEF LN2 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XSUB      V = T - SQRT(2)/2
      DEF V 
      DEF T 
      DEF HSQT2 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD 
      DEF T         T = T + SQRT(2)/2 
      DEF T 
      DEF HSQT2 
      JSB .XDIV      Z = (T - SQRT(2)/2) /
      DEF Z             (T + SQRT(2)/2) 
      DEF V 
      DEF T 
      JSB .XMPY      T = Z * Z
      DEF T 
      DEF Z 
      DEF Z 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      V = T + B3 
      DEF V 
      DEF T 
      DEF B3
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      P1 = C2 * (T + B3) 
      DEF P1
      DEF C2
      DEF V 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      Q1 = T + B2
      DEF Q1
      DEF T 
      DEF B2
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      Q1 = (T + B2) * (T + B3) 
      DEF Q1
      DEF Q1
      DEF V 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      Q1 = (T + B2) * (T + B3) + C3
      DEF Q1
      DEF Q1
      DEF C3
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XMPY      V = C1 * Q1
      DEF V 
      DEF C1
      DEF Q1
      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 + P1 
      DEF T 
      DEF T 
      DEF P1
      JSB .XDIV      T = V / T
      DEF T 
      DEF V 
      DEF T 
      JSB .XMPY      T = Z * (V / T)
      DEF T 
      DEF T 
      DEF Z 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD      Y = T + U
      DEF Y,I 
      DEF T 
      DEF U 
      ISZ TDB+2 
      JMP LIBX
ERROR LDA ERMSG     ERROR EXIT
      LDB ERMSG+1 
LIBX  JMP TDB+2,I 
      DEF TDB 
      DEC 0 
      SPC 2 
ERMSG ASC 2,11UN
F.5   DEC 0.5 
LN2   OCT 054271,005773,164400     LN(2)
HSQT2 OCT 055202,074631,176400     SQRT(2)/2
C1    OCT 133024,075341,044012     -18.48 
C2    OCT 120554,153524,156412     -23.6437098255 
C3    OCT 100750,162307,156775     -.246270037272 
B1    OCT 100466,046623,062410     -15.8484848485 
B2    OCT 103737,034700,147004     -3.75400078147 
B3    OCT 123217,017743,036402     -1.39751437005 
      END 
* 
                                                                                                                                    