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 "/CMRT" - COMMON REDUCTION FOR .SIN, .COS, .TAN . 
      NAM /CMRT,7 24998-1X174 REV.2001 781109 
* 
      ENT /CMRT 
      EXT .CFER,.TADD,.TSUB,.TMPY,.PWR2,.YINT,.FLUN,IFIX,FLOAT
* 
A     EQU 0 
B     EQU 1 
* 
*     /CMRT MULTIPLES A 4-WORD NUMBER BY A CONSTANT 
*     (2/LN(2) OR 4/PI) AND SUBTRACTS THE NEAREST EVEN INTEGER FROM THE 
*     RESULT.  IF CANCELLATION OCCURS WHICH WOULD AFFECT THE CALLER'S 
*     RESULT, ADDITIONAL PRECISION IS USED. 
* 
*     CALLING SEQUENCE: 
* 
*                   <A = FLAGS> 
*                   JSB /CMRT 
*                   DEF <RESULT>     (CANNOT BE SAME AS ARG)
*                   DEF <CONST>      (DIRECT) 
*                   DEF <ARG> 
*                   <ERROR RETURN>   (IF OUTSIDE [-2**23,+2**23) )
*                   <NORMAL RETURN>  B=N LOWER. 
* 
*     THE CONSTANTS ARE THE 4-WORD VERSION AND THE
*     THE 4-WORD VALUE WHICH IS THE CONSTANT MINUS
*     THE FIRST 28 BITS OF THE CONSTANT.
* 
*     THE FLAGS ARE:     EXP: -2       TANH: -1       TAN: 0
*                        SIN: 4 OR 8   COS: 2 OR 6
* 
*     THE ERROR RETURN IS TAKEN IF N DOES NOT FIT IN TWO WORDS. 
*     (ONE WORD FOR TANH.)
* 
*     METHOD:  TWO METHODS ARE USED, DEPENDING ON THE AMOUNT OF 
*     CANCELLATION.  IF THE ARGUMENT IS IN THE RANGE [-8,8) OR
*     TANH IS INDICATED, IT IS MULTIPLIED BY C AND THE NEAREST EVEN 
*     INTEGER (N) IS FOUND AND SUBTRACTED.  IF THE CANCELLATION 
*     DOES NOT EXCEED ABOUT 3 BITS OR THE RESULT WILL BE FOR COS, 
*     TANH OR EXP, THIS RESULT IS RETURNED. 
*     IF TOO MUCH CANCELLATION OCCURS OR THE ARGUMENT IS OUTSIDE
*     [-8,8), THE ARGUMENT AND THE CONSTANT ARE BROKEN INTO TWO 
*     PARTS AND THE PARTIAL PRODUCTS ARE TAKEN.  SINCE THE FIRST
*     PARTIAL PRODUCT IS EXACT, N MAY BE SUBTRACTED SAFELY AND THE
*     SIGNIFICANT BITS IN THE OTHER PRODUCTS ARE NOT LOST IN THE SUM. 
      SKP 
*                   COPY ADDRESSES, ARG.  SEE IF EASY OR HARD.
* 
/CMRT NOP 
      STA FLAG      SAVE FLAG 
      LDB /CMRT,I   COPY RESULT ADDR
      ISZ /CMRT 
      STB RESLT 
      LDB /CMRT,I   COPY ADDR CONST 
      ISZ /CMRT 
      STB C 
      LDB /CMRT,I   COPY ARG
      ISZ /CMRT 
      STB SRC 
      JSB .CFER 
      DEF X 
SRC   DEF *-* 
      LDA FLAG
      INA,SZA,RSS   IF TANH, EASY.
      JMP CMRT1 
      LDB X+3       GET EXPONENT
      JSB .FLUN 
      STA EXP       REMEMBER FOR COMPUTING CANCELLATION 
      ADA =D-4      EXP >= 4 ?
      SSA,RSS 
      JMP CMRT4     YES, MUST USE HARD WAY. 
* 
*                   TRY EASY WAY. 
* 
CMRT1 JSB .TMPY     MULTIPLY BY C 
      DEF PROD
      DEF X 
C     DEF *-* 
      LDA PROD      FIX 
      LDB PROD+3
      JSB IFIX
      SOC           TANH MAY OFL
      JMP /CMRT,I   YES.
      SSA,RSS       FORM NEAREST EVEN INTEGER 
      INA 
      RAR,CLE,ELA 
      STA N 
      JSB FLOAT     FLOAT TO 4-WORD 
      STA FN
      CLA 
      STA FN+1
      STA FN+2
      STB FN+3
      JSB .TSUB     X*(4/PI) - N
RESLT DEF *-* 
      DEF PROD
      DEF FN
      SKP 
*                   IF EXP, TANH OR COS, IGNORE CANCELLATION. 
* 
      LDA FLAG
      SSA 
      JMP CMRT3     EXP OR TANH, NO.
      SZA,RSS 
      JMP CMRT2     TAN, YES. 
      ADA N         SIN OR COS, SEE WHICH.
      RAR,SLA 
      JMP CMRT3     COS, NO.   (SIN, YES.)
* 
*                   SEE IF EXCESSIVE CANCELLATION.
* 
CMRT2 LDB RESLT     SEE HOW MANY BITS LOST
      JMP *+2       REMOVE INDIRECTS
      LDB B,I 
      RBL,CLE,SLB,ERB 
      JMP *-2 
      ADB =D3 
      LDB B,I 
      JSB .FLUN 
      CMA,INA       -EXPONENT(RESULT) 
      ADA EXP       EXP(X) - EXP(RESULT) = #BITS LOST 
      ADA =D-4      LOST 4 OR MORE ?
      SSA,RSS 
      JMP CMRT5     YES, HARD WAY.
* 
*                   SET B=N LOWER, A=FIRST WD X, EXIT.
* 
CMRT3 LDB N         EXIT WITH B=N LOWER 
      ISZ /CMRT     SKIP ERROR RETURN.
      JMP /CMRT,I 
* 
*                   LARGE ARGUMENT OR TOO MUCH CANCELLATION: HARD WAY.
*                   CHECK RANGE AND FORM X UPPER. 
* 
CMRT4 CCA           FLAG N NOT VALID. 
CMRT5 STA NVALD     SAVE N VALID FLAG 
      LDA FLAG      DO RANGE CHECKS FOR EXP, SIN/COS/TAN
      LDB EXP 
      RAL           A<0 IF EXP
      ADB =D-8      EXP(ARG)-8 FOR EXP
      SSA,RSS 
      ADB =D-16     EXP(ARG)-24 FOR SIN/COS/TAN 
      SSB,RSS       TOO BIG ? 
      JMP /CMRT,I   YES.
      LDA X         XU = FIRST PART (FIRST 28 BITS) 
      STA XU
      LDA X+1 
      AND =B177770
      STA XU+1
      LDA X+3       (3RD WD = 0)
      AND =B377 
      STA XU+3
      SKP 
*                   FORM C UPPER AND TAKE PRODUCT XU*CU.
* 
      LDB C         FORM CU = FIRST 28 BITS OF C
      LDA B,I 
      STA PROD
      INB 
      LDA B,I 
      AND =B177770
      STA PROD+1
      CLA 
      STA PROD+2
      ADB =D2 
      LDA B,I 
      AND =B7       TO MATCH MICROCODE. 
      STA PROD+3
      JSB .TMPY     XU*CU 
      DEF PROD
      DEF XU
      DEF PROD
* 
*                   COMPUTE N & FLOAT(N). 
* 
      ISZ NVALD     HAS N ALREADY BEEN COMPUTED ? 
      JMP CMRT6     YES, USE IT.
      JSB .YINT     NO.  TRUNCATE XU*CU.
      DEF *+3 
      DEF FN
      DEF PROD
      LDA FN        MUST FIT EASILY IN 23 BITS. 
      LDB FN+3      SO THIS IS ALL OF IT. 
      STB FN+1      (NEED IT TOGETHER LATER)
      JSB .PWR2     DIVIDE BY 4096
      DEF KM12
      JSB IFIX      TRUNCATE. 
      JSB FLOAT 
      JSB .PWR2     & MULTIPLY BY 4096: VOILA, THE UPPER BITS.
      DEF K12 
      STA FN+2      SAVE THEM.
      STB FN+3
      FSB FN        (UPPER) - (ALL) = -(LOWER)
      JSB IFIX      LEAST BITS OF -N. 
      CMA,SSA,INA,RSS  FORM N... MAKE IT NEAREST EVEN.
      INA           (THIS CAN'T OVERFLOW) 
      RAR,CLE,ELA 
      STA N         SAVE LEAST BITS OF N. 
      JSB FLOAT     PUT IT ALL BACK TOGETHER. 
      FAD FN+2
      STA FN        NOW EXPAND BACK TO 4-WORD FORM
      STB FN+3      & WE'RE DONE. 
      CLA 
      STA FN+1
      STA FN+2
      SKP 
*                   DO THE CRUCIAL SUBTRACT, THEN ADD PARTIAL PRODUCTS. 
* 
CMRT6 JSB .TSUB     XU*CU-N 
      DEF PROD
      DEF PROD
      DEF FN
      JSB .TSUB     XL = X-XU 
      DEF X 
      DEF X 
      DEF XU
      JSB .TMPY     (X-XU)*C
      DEF X 
      DEF X 
      DEF C,I 
      JSB .TADD     (XU*CU-N) + (X-XU)*C
      DEF PROD
      DEF PROD
      DEF X 
      LDA C         FORM ADDR CL
      ADA =D4 
      JSB .TMPY     XU*CL 
      DEF X 
      DEF XU
      DEF A,I 
      JSB .TADD     RESULT = X*(4/PI)-N 
      DEF RESLT,I 
      DEF PROD
      DEF X 
      JMP CMRT3     EXIT
* 
*                   LOCALS & CONSTANTS
* 
N     BSS 1         LOW 3 BITS MATCH INTEGER SUBTRACTED.
NVALD BSS 1         -1 IFF N NOT VALID. 
X     BSS 4         ARGUMENT
PROD  BSS 4         GENERAL ACCUMULATOR 
XU    OCT 0,0,0,0   FIRST 28 BITS OF X
FLAG  EQU XU        SIN/COS/TAN FLAG
EXP   EQU XU+1      EXP(X), FOR DETERMINING CANCELLATION. 
FN    BSS 4         4-WORD FLOAT(N) 
KM12  DEC -12 
K12   DEC 12
      END 
                                                                                                                                