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 ".XPAK" EXTENDED PRECISION PACKING ROUTINE NAM .XPAK,6 24998-1X195 REV.2001 750701 ENT .XPAK EXT .ZPRV SPC 1 * * THIS ROUTINE NORMALIZES AND PACKS EXTENDED PRECISION NUMBERS. * CALLING SEQUENCE: * LDA (EXPONENT) * JSB .XPAK * DEF X (MANTISSA, 3 WORDS) * RETURN: X CONTAINS THE RESULT SPC 1 X1 NOP X2 NOP X3 NOP EXPON NOP SCNT NOP .XPAK NOP JSB .ZPRV DEF LIBX STA EXPON SAVE EXPONENT CLA STA SCNT SET SHIFT COUNT = 0 LDA .XPAK GET P+1 DIRECT ADDRESS LDA A,I AND SAVE IN X1,X2,X3 RAL,CLE,SLA,ERA INDIRECT? JMP *-2 YES, TRY NEXT LEVEL STA X1 NO, SAVE AS POINTER INA STA X2 INA STA X3 SAVE POINTERS FOR ALL 3 LDA X1,I LDB X2,I IF THE MANTISSA = 0 SZA,RSS THEN RETURN IMMEDIATELY SZB JMP NORML OTHERWISE, NORMALIZE LDA X3,I SZA,RSS JMP RETRN RSS SPC 1 * * NORMALIZING SECTION * SPC 1 SHIFT ISZ SCNT COUNT THE # OF LEFT SHIFTS NORML LDA X3,I TRIPLE REGISTER E LEFT ROTATE CLE,ELA ELB STA X3,I LDA X1,I ELA STA X1,I SEZ,SSA,RSS TEST ORIGINAL 2 HIGH BITS JMP SHIFT BOTH WERE 0 - # WAS POS. UNNORM. SEZ,SSA JMP SHIFT BOTH WERE 1 - # WAS NEG. UNNORM. ERA UNDO SHIFT LEAVING STA X1,I NORMALIZED MANTISSA. LDA X3,I ERB ERA,CLE SPC 1 * * ROUNDING SECTION * SPC 1 ADA =B177 ADD IN SUFFICIENT ROUND FOR -#'S STB X2,I SAVE MID-MANTISSA LDB X1,I SSB,RSS IF POSITIVE, ADD 1 MORE INA LDB X2,I RESTORE MID-MANTISSA STA X3,I SEZ,RSS TEST FOR OVF OUT OF LOW-MANT. JMP DONE NO, NUMBER IS NOW ROUNDED LDA X1,I CLE,INB ADD CARRY TO MID-MANTISSA STB X2,I CLO SEZ TEST FOR CARRY THROUGH CLE,INA,RSS YES, BUMP HIGH MANTISSA JMP DONE NO, DONE STA X1,I SOS JMP NORML TEST FOR RESULT = 110...0 RAR RESULT WAS 10...0, SHIFT RIGHT ISZ EXPON AND BUMP EXPONENT NOP STA X1,I SPC 1 * AT THIS POINT THE MANTISSA IS NORMALIZED AND * THE EXPONENT = EXPON - SCNT SPC 1 DONE LDA X3,I AND =B177400 STRIP OFF LOW 8 BITS OF LOW-MANT STA B LDA SCNT CMA,INA ADA EXPON A = TRUE EXPONENT ADA =B200 CHECK FOR UNDERFLOW SSA JMP XUNDR ADA =B177400 CHECK FOR OVERFLOW SSA,RSS JMP XOVER ADA =B200 RESTORE EXPONENT RAL POSITION IT AND =B377 ADA B PACK IT STA X3,I JMP RETRN RETURN SKP XUNDR CLA UNDERFLOW - STA X1,I SET RESULT = 0 STA X2,I AND OVFF = 1 JMP STORT RETURN O=1 SPC 1 XOVER LDA X1,I GET SIGN OF X1NFINITY ELA SAVE IN E-REG. LDA =B77777 GET POS INF. SEZ CMA MAKE NEG. INF STA X1,I CLA,SEZ,RSS MID MANTISSA CCA STA X2,I LDA =B376 SEZ,RSS IOR =B177400 MIRGE IF POS. STORT STA X3,I STO SET O-REG FOR UNDER/OVERFLOW RSS SPC 1 RETRN CLO CLEAR OVERFLOW ISZ .XPAK LIBX JMP .XPAK,I DEF .XPAK SPC 1 A EQU 0 B EQU 1 END *