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-18035
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED ".CTOI" COMPLEX TO INTEGER POWER
      NAM .CTOI,7 24998-1X035 REV.2013 791022 
      ENT .CTOI 
      EXT .ZRNT,.ENTC,.CFER 
      EXT .CMPY,.CDIV 
      SPC 1 
* 
*     CALLING SEQUENCE
*     CY  =  CX**I
*       JSB .CTOI 
*       DEF CY
*       DEF CX
*       DEF I 
*       <ERROR RETURN>
*       <RETURN>
      SPC 2 
C     BSS 4         BASE
CY    NOP 
CX    NOP 
I     NOP 
.CTOI NOP 
      STA  SAVEA
      STB  SAVEB
      JSB ENTR1 
      STA CY        ADDRESS OF RESULT 
      JSB ENTR1 
      STA CX        ADDRESS OF BASE 
      JSB ENTR1 
      STA I         ADDRES OF POWER 
      LDA SAVEA 
      LDB SAVEB     POWER MIGHT BE IN A OR B
      LDA I,I 
      STA I 
      JSB .CFER     MOVE CX INTO TEMP C 
      DEF C 
      DEF CX,I
      LDA C+2 
      LDB C 
      SZA,RSS       C=0 ? 
      SZB 
      JMP NOTZO 
      LDA I         YES.
      SSA,RSS       I < 0 
      SZA,RSS        OR  I = 0 ?
      JMP ERROR     YES. ERROR CONDITION
      JSB .CFER     I > 0 , THEN Y = 0
      DEF CY,I
      DEF CZERO 
EXIT  ISZ .CTOI 
      JMP LIBX
ERROR LDA MSG 
      LDB MSG+1 
LIBX  JMP .CTOI,I 
* 
MSG   ASC 2,14UN
NOTZO JSB .CFER 
      DEF CY,I
      DEF CONE
      LDA I 
      SZA,RSS       I=0 ? 
      JMP EXIT      YES. ANSWER= 1 + 0I 
      STA CX        SAVE SIGN OF EXPONENT 
      SSA 
      CMA,INA       SET I = /I/ 
      STA I 
LOOP  LDA I 
      SLA,RSS       LAST BIT OF I = 0 ? 
      JMP *+5 
      JSB .CMPY     NO. Y = Y * C 
      DEF CY,I
      DEF CY,I
      DEF C 
      LDA I 
      ARS           DIVIDE I BY 2 
      SZA,RSS       I = 0 ? 
      JMP FINIS     YES.
      STA I         NO. SAVE I
      JSB .CMPY     C = C * C 
      DEF C 
      DEF C 
      DEF C 
      JMP LOOP      DO IT AGAIN 
FINIS LDA CX        I > 0 ? 
      SSA,RSS 
      JMP EXIT      YES. FINISHED 
      JSB .CDIV     NO. Y = 1 / Y 
      DEF CY,I
      DEF CONE
      DEF CY,I
      JMP EXIT      DONE
      SPC 1 
* 
ENTR1 NOP           ROUTINE TO GET NEXT ADDR IN PARAM LIST
      LDA .CTOI     ADDR ADDR PARAM 
      ISZ .CTOI 
      LDB SAVEB     RESTORE ORIGINAL B
ENTR2 STA T2        SAVE ADDR TO INDIRECT THRU
      LDA SAVEA     RESTORE ORIGINAL A
      LDA T2,I      DO THE INDIRECT 
      RAL,CLE,SLA,ERA 
      JMP ENTR2     INDIRECT BIT WAS SET, TRY AGAIN 
      JMP ENTR1,I   EXIT
SAVEA BSS 1 
SAVEB BSS 1 
T2    BSS 1 
CONE  DEC 1.0 
CZERO DEC 0.0,0.0 
      END 
* 
                                                                                                                                                                                                                                                        