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 ".DTOI" DOUBLE TO INTEGER POWER 
      NAM .DTOI,6 24998-1X048 REV.2001 750701 
      ENT .DTOI 
      EXT .ZRNT,.XMPY,.XDIV,.DFER 
      SPC 1 
* 
*     CALLING SEQUENCE: Y = D ** I
*     JSB .DTOI 
*     DEF Y 
*     DEF D 
*     DEF I 
*     (ERROR RETURN : D = 0 ; I < = 0)
*     (NORMAL RETURN) 
      SPC 2 
TDB   NOP 
      DEC 12
      NOP 
I     NOP           EXPONENT
D     REP 3         BASE
      NOP 
Y     NOP 
F     REP 3 
      NOP 
SIGN  NOP           =+1,-1 IF I > 0, < 0
.DTOI NOP 
      JSB .ZRNT 
      DEF LIBX
      LDA *-2 
      LDB *-4 
      SSA,RSS 
      STB TDB+2     CHECK IF RE-ENTERENT OR NOT 
      LDA TDB+2,I 
      STA Y         SAVE ADDRESS OF Y 
      ISZ TDB+2 
      LDA TDB+2,I 
      STA D         SAVE ADDRESS OF D 
      ISZ TDB+2 
      LDA TDB+2,I 
      LDA 0,I 
      STA I         STORE I 
      ISZ TDB+2     SET RETURN ADDRESS
      JSB .DFER     D=D 
      DEF D 
      DEF D,I 
      LDA D 
      LDB I 
      SZA           D = 0 ? 
      JMP NOT0      NO. 
      SSB,RSS       I < 0 
      SZB,RSS        OR I = 0 ? 
      JMP ERROR     YES ERROR 
      JMP ANS0      NO. ANSWER = 0. 
NOT0  SZB,RSS       I = 0 ? 
      JMP ANS1      YES. ANSWER = 1.
      JSB .DFER     SET F=1.0 
      DEF F 
      DEF ONE 
      CLB,INB       IF I > 0 , SIGN = +1
      LDA I 
      SSA 
      CCB           IF I < 0 , SIGN = -1
      STB SIGN
      SSB 
      CMA,INA       SET I = / I / 
      STA I 
LOOP  LDA I 
      SLA,RSS       LAST BIT OF I = 0 ? 
      JMP *+5       YES 
      JSB .XMPY      NO. F = F * D
ADF   DEF F 
      DEF F 
      DEF D 
      LDA I 
      ARS           DIVIDE I BY 2 
      SZA,RSS       I = 0 ? 
      JMP FINIS     YES.
      STA I         NO. SAVE I
      JSB .XMPY      D = D * D
      DEF D 
      DEF D 
      DEF D 
      JMP LOOP      DO IT AGAIN 
FINIS ISZ SIGN      I > 0 ? 
      JMP POS 
      JSB .XDIV      NO. F = 1 / F
      DEF F 
ADONE DEF ONE 
      DEF F 
POS   LDA ADF 
      RSS 
ANS0  LDA ADZRO     GET ADDRESS OF CEX 0.0
      RSS 
ANS1  LDA ADONE     GET ADDRESS OF DEX 1.0
      STA I         TEMP
      JSB .DFER     MOVE TO Y 
      DEF Y,I 
      DEF I,I 
      ISZ TDB+2     GOOD RETURN 
      JMP LIBX
ERROR LDA MSG 
      LDB MSG+1 
LIBX  JMP TDB+2,I   RETURN
ZERO  DEX 0.0 
ADZRO DEF ZERO
ONE   DEX 1.0 
MSG   ASC 2,12UN    ERROR MESSAGE 
      END 
* 
    