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 NUMBER TO BE REDUCED * JSB .CMRS * DEF CONST E.G. 4/PI FOR TRIG * DEF N TO RECEIVE INTEGER * * (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