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 "DPOLY" - 4-WORD RATIONAL FORM EVALUATOR. 
      NAM DPOLY,7 24998-1X188 REV.2001 790417 
* 
      ENT DPOLY,TRNL
      EXT .ENTR,.CFER,.TADD,.TSUB,.TMPY,.TDIV 
* 
A     EQU 0 
B     EQU 1 
* 
*     DPOLY EVALUATES A RATIONAL FORM GIVEN THE COEFFICIENTS AND THE
*     POINT AT WHICH TO EVALUATE.  THE COMPUTATION HAS THE FORM:
* 
*                             (P[0]+X*(P[1]+X*...(P[M-1]+X*P[M])))
*                   RESULT = -------------------------------------- 
*                             (Q[0]+X*[Q[1]+X*...(Q[N-1]+X))) 
* 
*     I.E., Q[N] IS ASSUMED TO BE 1.0 .  IF N=0, THE DIVIDE IS SKIPPED
*     AND DPOLY JUST DOES A POLYNOMIAL EVALUATION.
* 
*     CALLING SEQUENCE: 
* 
*                   JSB DPOLY 
*                   DEF *+6   OR OCT FLAGS+100000 
*                   DEF <RESULT>
*                   DEF <ARG> 
*                   DEF <CONSTANT LIST>  P[M]...P[0],Q[N-1]...Q[0]
*                   DEF <M> 
*                   DEF <N> 
* 
*     WHERE:  IF FLAG BIT 0 CLEAR:  DO P/(Q-P)   (IF N>0) 
*             IF FLAG BIT 14 SET:   MULTIPLY P BY X.
*             IF FLAG BIT 15 SET:   EVALUATE IN X**2 & ENABLE FLAGS.
      SPC 2 
*                   ENTRY POINT.  SET UP FLAGS. 
* 
DPOLY NOP 
TRNL  EQU DPOLY 
      LDA TRNL      COPY ENTRY PT.
      STA TRNLX 
      LDA A,I       COPY FLAG WORD. 
      STA FLGWD 
      CLB,INB       DEFAULT FLAGS.
      SSA,RSS       FLAGS PRESENT ? 
      JMP TRNL0     NO. 
      LDB A         YES, USE THEM.
      LDA TRNL      FAKE THE RETURN ADDR. 
      ADA =D6 
      STA TRNL,I
TRNL0 STB FLAGS     SAVE FLAGS. 
      JMP TRNLX+1   GO USE .ENTR TO GET PARAMS. 
      SKP 
*                   FAKE ENTRY PT. USE .ENTR TO COPY PARAM ADDR.
* 
RESLT DEF *-* 
ARG   DEF *-* 
CONST DEF *-* 
MPTR  DEF *-* 
NPTR  DEF *-* 
TRNLX NOP 
      JSB .ENTR     COPY ADDRESSES
      DEF RESLT 
      LDA FLGWD     RESTORE FLAG WORD.
      STA TRNL,I
      SSA           SQUARE ARG ?
      JMP TRNL1     YES.
      JSB .CFER     NO, COPY ARG
      DEF X 
      DEF ARG,I 
      JMP TRNL2 
TRNL1 JSB .TMPY     SQUARE ARG. 
      DEF X 
      DEF ARG,I 
      DEF ARG,I 
* 
*                   EVALUATE NUMERATOR
* 
TRNL2 LDA MPTR,I    M 
      CMA,INA       -M
      LDB CONST     B = CONSTANT POINTER THROUGHOUT.
      JSB .TMPY     X*P[M]
      DEF P 
      DEF X 
      DEF B,I 
      ADB =D4       ADDR P[M-1] 
      INA,SZA,RSS   I=0 ? 
      JMP TRNL4     YES, GO FINISH. 
TRNL3 JSB .TADD     P[I] + X * (...)
      DEF P 
      DEF B,I 
      DEF P 
      ADB =D4       ADDR P[I-1] 
      JSB .TMPY     X * ( P[I] + ...) 
      DEF P 
      DEF X 
      DEF P 
      INA,SZA       I_I-1.  I=0 ? 
      JMP TRNL3     NO, LOOP. 
TRNL4 JSB .TADD     P = P[0] + ...
      DEF P 
      DEF B,I 
      DEF P 
      SKP 
*                   CONDITINALLY MULTIPLY BY ARG. 
* 
      LDA FLAGS     CHECK FLAG
      SLA 
      JMP TRNL5     SET, NO MULTIPLY. 
      JSB .TMPY     CLEAR, MULTIPLY.
      DEF P 
      DEF ARG,I 
      DEF P 
TRNL5 LDA NPTR,I    N 
      CMA,INA,SZA,RSS -N.  N=0 ?
      JMP TRNL9     YES, DONE.
* 
*                   EVALUATE DENOMINATOR
* 
      ADB =D4       ADDR Q[N-1] 
      JSB .TADD     Q[N-1] + X
      DEF Q 
      DEF B,I 
      DEF X 
      INA,SZA,RSS   N=1 ? 
      JMP TRNL7     YES, DONE.
TRNL6 JSB .TMPY     X * (Q[J] + ...)
      DEF Q 
      DEF X 
      DEF Q 
      ADB =D4       ADDR Q[J-1] 
      JSB .TADD     Q[J-1] + X * (...)
      DEF Q 
      DEF B,I 
      DEF Q 
      INA,SZA       J_J-1.  J=0 ? 
      JMP TRNL6     NO, LOOP. 
TRNL7 LDA FLAGS     CONDITIONALLY SUBTRACT NUM FROM DENOM 
      RAL 
      SSA,RSS 
      JMP TRNL8     IF FLAG CLEAR.
      JSB .TSUB     ELSE DO IT
      DEF Q 
      DEF Q 
      DEF P 
* 
*                   RETURN QUOTIENT.
* 
TRNL8 JSB .TDIV     P/Q 
      DEF RESLT,I 
      DEF P 
      DEF Q 
      JMP TRNLX,I   EXIT. 
      SKP 
*                   M>0, N=0.  RESULT = NUMERATOR.
* 
TRNL9 JSB .CFER     COPY IT.
      DEF RESLT,I 
      DEF P 
      JMP TRNLX,I   EXIT
* 
*                   LOCALS. 
* 
FLAGS BSS 1         FLAGS FOR *X AND Q-P
P     BSS 4         NUMERATOR 
Q     BSS 4         DENOMINATOR 
X     BSS 4         VALUE USED IN EVALUATION
FLGWD EQU P         TEMP FOR ENTRY CODE.
      END 
                                                                                                      