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 "AINT" REAL TO REAL TRUNCATION NAM AINT,6 24998-1X134 REV.2001 750701 ENT AINT EXT .ZPRV SPC 2 * * CALLING SEQUENCE * DLD Y (REAL NUMBER) * JSB AINT * (RESULT IN A AND B) SPC 2 X1 NOP X2 NOP AINT NOP JSB .ZPRV DEF LIBX STA X1 STB X2 SAVE POS. VALUE LDA B AND O377 MASK DOWN TO EXPONENT CLE,SLA,RAR FORM EXPONENT JMP ZERO NEG. EXP ANS = 0 LDB =D-23 TEST IF EXP > 22 ADB A CLB,SEZ,CLE EXP > 22, ALREADY INTEGER JMP EXIT DIV D16 CLE,ERB DIV BY 2 AND E=EVEN/ODD FLAG ADB MTBL POINT TO MASK LDB B,I GET MASK CMB,SEZ,CLE NEED TO BE ODD MASK? BRS OF TRICK TO HAVE 1/2 SIZE TABLE SLA MASK 1ST OR 2ND WORD? JMP SECND JUST SECONE LDA X1 GET HI-MANTISSA AND B MASK IT SZA ANY BITS SET? CCE YES, SET FLAG XOR X1 MAKE HI-MANTISSA STA X1 CCB SET MASK FULL SECND LDA X2 GET LO-MAN+EXPONENT AND OM400 MASK OF EXPONENT AND B MASK LEAST BITS SZA ANY BITS SET? CCE YES SET FLAG XOR X2 MAKE LO-MANTISSA+EXP STA X2 AND PUT IN B-REG EXIT LDB X2 RESTORE REGS. LDA X1 RESTORE A&B REG. SEZ NEED POSSIBLE BUMP? SSA,RSS YES, BUT ONLY OF NEG. JMP LIBX RETURN DONE FAD =F1.0 ADD ONE. LIBX JMP AINT,I DEF AINT SPC 1 ZERO CLB CLA RETURN A&B = 0 JMP LIBX SPC 1 MTBL DEF *+1 OCT 100000 OCT 160000 OCT 174000 OCT 177000 OCT 177600 OCT 177740 OCT 177770 OCT 177776 SPC 1 O377 OCT 377 OM400 OCT -400 D16 DEC 16 A EQU 0 B EQU 1 END *