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 ".CMRS" - COMMON RANGE REDUCTION FOR SINGLE PRECISION MATH. 
      NAM .CMRS,6 24998-1X171 REV.2001 780424 
* 
      ENT .CMRS 
      EXT .ZPRV,.XMPY,.XSUB,SNGL,IFIX,FLOAT 
* 
A     EQU 0 
B     EQU 1 
* 
*     .CMRS PERFORMS ARGUMENT REDUCTION FOR SIN,COS,TAN AND EXP.  THE 
*     OPERATIONS PERFORMED (IN DOUBLE PRECISION) ARE: 
* 
*                   N _ (NEAREST EVEN INTEGER TO) ((A,B)*CONST) 
*                   (A,B) _ ((A,B)*CONST) - N 
* 
*     WHICH IS MATHEMATICALLY EQUIVALENT TO SUBTRACTING N*CONST FROM
*     (A,B), WHERE N IS CHOSEN TO MINIMIZE THE RESULT, AND THEN 
*     MULTIPLYING (A,B) BY CONST AND DOUBLING N.
* 
*     CALLING SEQUENCE: 
* 
*                   DLD <ARG>       NUMBER TO BE REDUCED
*                   JSB .CMRS 
*                   DEF CONST       E.G. 4/PI FOR TRIG
*                   DEF N           TO RECEIVE INTEGER
*                   <ERROR RETURN>
*                   <NORMAL RETURN> (A,B) = REDUCED VALUE.
* 
*     THE ERROR RETURN IS TAKEN IFF THE ARGUMENT IS OUTSIDE THE RANGE 
*     [-32768/CONST,+32768*CONST).
      SKP 
.CMRS NOP 
      JSB .ZPRV     IN CASE MEM-RES 
      DEF LIBX
      STA ARG       STORE ARG AS DOUBLE 
      LDA B 
      AND =B177400
      STA ARG+1 
      XOR B 
      STA ARG+2 
      LDA .CMRS,I   A = ADDR OF CONST 
      STA CMRS1 
      ISZ .CMRS 
      JSB .XMPY     MULTIPLY BY CONSTANT
      DEF PROD
      DEF ARG 
CMRS1 DEF *-*       CONST 
      JSB SNGL      REDUCE TO SINGLE
      DEF *+2 
      DEF PROD
      JSB IFIX      TO INTEGER
      SSA,RSS       FIND NEAREST EVEN INTEGER 
      INA 
      ERA,CLE,ELA 
      LDB .CMRS,I   STORE IT
      STA B,I 
      ISZ .CMRS 
      SOC           TOO BIG ? 
      JMP LIBX      YES, TAKE ERROR EXIT
      ISZ .CMRS     NO, SET NORMAL EXIT 
      JSB FLOAT     FLOAT(N)
      STA ARG       STORE AS DOUBLE 
      LDA B 
      AND =B177400
      STA ARG+1 
      XOR B 
      STA ARG+2 
      JSB .XSUB     X*CONST-N (IN DOUBLE) 
      DEF ARG 
      DEF PROD
      DEF ARG 
      JSB SNGL      TAKE SINGLE PART
      DEF *+2 
      DEF ARG 
LIBX  JMP .CMRS,I   EXIT
      DEF .CMRS 
* 
ARG   BSS 3         FOR DBLE(ARG) AND X*CONST-N 
PROD  BSS 3         FOR X*CONST 
      END 
                                                                                                                                                                                    