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 "SNGL" DOUBLE PRECISION TO REAL WITH ROUNDING (DLB) NAM SNGL,6 24998-1X190 REV.2001 750701 ENT SNGL EXT .ZPRV SPC 1 * * THIS ROUTINE WILL CONVERT A DOUBLE PRECISION NUMBER (3 WORDS) * TO A REAL NUMBER (2 WORDS) WITH ROUNDING. THIS MEANS THAT * THE ABSOLUTE VALUE OF THE RESULTANT NUMBER WILL HAVE 1/2 THE * LEAST SIGNIFICANT BIT ADDED AND THEN THE NUMBER WILL BE * TRUNCATED. MAX ERROR FROM DOUBLE PRECISION WILL BE LESS THAN * 1/2 THE LEAST SIGNIFICANT BIT. * * CALLABLE: * JSB SNGL * DEF *+2 * DEF X * * WHERE: * X = DOUBLE PRECISION (3 WORD) PARAMETER * A-REG & B-REG = REAL (2 WORD) RESULTS * * ERRORS: IF X=> 1*2**127, THEN Y = (1-2**-23)*2**127 * AND O-REG. WILL BE SET * * TIME: * APPROX. TIME IS 70 2100 MACHINE CYCLES (100 MAX) * PLUS THE TIME TO EXECUTE PRIVLEGED PROCESSING. SPC 1 SNGL NOP ENTRY A&B = SNGL (X) JSB .ZPRV DEF LIBX LDA SNGL,I WE CAN BEAT .ENTR ISZ SNGL BUMP TO P+2 LDB SNGL STA SNGL PUT BACK THE RETURN ADDRESS LDB B,I PICK UP CONTENTS OF P+2 RBL,CLE,SLB,ERB INDIRECTS?+ (CLE) JMP *-2 YES, TRY AGAIN STB ADDR SAVE ADDRESS OF X LDB ADDR,I GET X(1) ISZ ADDR BUMP TO X(2) LDA ADDR,I GET X(2) STA Y2 SAVE TEMPORARY ISZ ADDR BUMP TO X(3) LDA ADDR,I GET X(3) AND O377 GET EXPONENT STA Y3 SAVE TEMPORARY CPA ADDR,I TRUNCATED ANY BITS? CCE NO, CLEAR TRUNK FLAG. LDA O177 PREPARE FOR ROUNDING SEZ,CLE,SSB,RSS IF NEG & NO BITS TRUNK, SKIP INA IF POSITIVE OR TRUNKED BITS A=200B ADA Y2 ROUND AND OM400 MASK OFF LO-BITS IOR Y3 MIRGE IN EXPONENT SEZ,RSS ROUND UP INTO HI-MAN IF E SET JMP SWAPR SWAP REGISTERS AND RETURN CPB PINF CHECK IF ROUND MANT TO 1. JMP SPECP YES, MANT = .5, EXP = EXP+1 INB BUMP UP HI-MANT CPB O140K CHECK IF ROUND MANT TO -.5 JMP SPECM YES, MANT = -1., EXP = EXP-1 SWAPR SWP SWAP A&B REGISTERS CLO RETURN O-REG = 0 LIBX JMP SNGL,I RETURN DEF SNGL SPC 1 SPECM CLB INIT B=0 LDA Y3 GET EXP.(MANT=-1 OR 0 IF EXP=-200) SLA,RAR POSITION EXP IOR OM200 MIRGE IN BITS IF NEG. CPA OM200 EXP = -200? CCA,CLE,RSS YES, RETURN Y = 0 CMA,CCE,INA DECREMENT EXPONENT ERB SET B=0 OR 100000B CMA CONTU RAL POSITION EXPONENT BACK AND O377 MASK OFF NEG. BITS JMP SWAPR DONE SPC 1 SPECP LDB O40K SET B=.5 LDA Y3 GET EXPONENT SLA,RAR POSITION IOR OM200 MIRGE IN NEG. BITS IF NEG CPA O177 ALREADY MAX EXP? JMP PLINF YES, SET TO +INF INA BUMP JMP CONTU RETURN SPC 1 PLINF LDA PINF LDB PINF+1 STO SET THE O-REG FOR PLUS INFINITY JMP LIBX RETURN PLUS INF SPC 1 ADDR NOP OM400 OCT -400 OM200 OCT -200 O377 OCT 377 O177 OCT 177 O40K OCT 40000 O140K OCT 140000 PINF OCT 77777 OCT 177776 Y2 NOP Y3 NOP B EQU 1 *ASMB,R,L,C * HED "SNGL" ROUND DOUBLE TO SINGLE PRECISION VALUEION * NAM SNGL,6 PRE-REL 7-15-75 (DLB) * ENT SNGL * EXT .ZPRV,.XFER,.FLUN,.PACK * SPC 1 * * THREE WORD EXTENDED PRECISION NUMBERS ARE ROUNDED TO * TWO WORD FLOATING POINT QUANTITIES. THE RESULT IS * RETURNED IN THE A AND B REGISTERS * CALLING SEQUENCE: * JSB SNGL * DEF *+2 * DEF X (ARGUMENT:3 WORDS) * (RESULT IN A AND B REGISTERS) * SPC 1 *SNGL NOP * JSB .ZPRV * DEF LIBX * ISZ SNGL * LDA SNGL,I GET ADDRESS OF X * ISZ SNGL * LDB .X1 * JSB .XFER MOVE ARGUMENT IN * LDB X3 * JSB .FLUN EXTRACT EXPONENT * STA X4 * LDA X1 * CLE,SZB * CCE ADD ROUND FOR NEG. # * LDB X2 GET DBL LO-MAN+EXP * SLB,RSS IF LEAST BIT SET, NO NEED TO * RBR,ELB PROPAGATE. ELSE SET LEAST BIT * JSB .PACK PACK IN EXPONENT *X4 NOP *LIBX JMP SNGL,I * DEF SNGL *X1 NOP *X2 NOP *X3 NOP *.X1 DEF X1 * END END