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 "XPOLY" EXTENDED PRECISION POLYNOMIAL EVALUATOR 
      NAM XPOLY,6 24998-1X168 REV.2001 750801 
      ENT .XPLY,XPOLY 
      EXT .ZRNT,.ENTP 
      EXT .DFER,.XADD,.XMPY 
XADD  EQU .XADD 
XMPY  EQU .XMPY 
      SPC 1 
* 
*     THIS ROUTINE EVALUATES AN N-TH DEGREE POLYNOMIAL. 
*      Y = K1*X^(N-1)+K2*X^(N-2)+...+K(N-^)*X+KN
*     CALLING SEQUENCE: 
*     JSB .XPLY 
*         DEF *+5 
*         DEF Y     RESULT
*         DEF N     DEGREE OF POLYNOMIAL + 1
*         DEF X     ARGUMENT
*         DEF K1    FIRST ELEMENT OF COEFFICIENT ARRAY
      SPC 2 
TDB   NOP 
      DEC 10
      NOP 
Y1    NOP 
Y2    NOP 
Y3    NOP 
Y     NOP 
N     NOP 
X     NOP 
K     NOP 
      SPC 1 
.XPLY NOP 
XPOLY EQU .XPLY 
      JSB .ZRNT 
      DEF LIBX
      JSB .ENTP 
      DEF Y 
      STA TDB+2 
      CLA           INITIALIZE
      STA Y1         RESULT 
      STA Y2          TO
      STA Y3           ZERO 
      LDA N,I 
      CMA,INA 
      SSA,RSS       IF DEGREE < 0 THEN
      JMP EXIT       RESULT = 0 
      STA N 
      SPC 1 
*            * LOOP TO EVALUATE POLYNOMIAL *
      SPC 1 
LOOP  JSB XADD      Y = Y + K(I)
      DEF Y1
      DEF Y1
      DEF K,I 
      ISZ N         TEST FOR END OF LOOP
      RSS 
      JMP EXIT      DONE, EXIT
      JSB XMPY      Y = Y * X 
      DEF Y1
      DEF Y1
      DEF X,I 
      ISZ K         MOVE TO NEXT COEFFICIENT
      ISZ K 
      ISZ K 
      JMP LOOP
      SPC 1 
EXIT  JSB .DFER     Y=Y1
      DEF Y,I 
      DEF Y1
LIBX  JMP TDB+2,I 
      DEF TDB 
      DEC 0 
      SPC 1 
      END 
* 
                                                                                          