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 "ENTIX/.XENT" DOUBLE PRECISION ENTIER ROUTINE (DLB) NAM ENTIX,6 24998-1X189 REV.2001 750701 ENT ENTIX,.XENT EXT .ZPRV,.ENTP SPC 1 * * THIS ROUTINE WILL PRODUCE THE LARGEST INTERGER (NO FRACTIONAL BITS) * NOT ALGEBRAICALLY EXCEEDING X. WHERE Y = ENTIX (X) IN FTN4. * CALLABLE: * JSB ENTIX * DEF *+3 * DEF Y * DEF X * * WHERE: * X = DOUBLE PRECISION (3 WORD) PARAMETER * Y = ENTIER (X) * A-REG CONTAINS LEAST BIT OF X.(1=ODD, 0=EVEN),(DLOG) * B-REG = 0 IF X=Y ON RETURN (NO-TRUNKCATION DONE),(DDINT) * TIME: * APPROX. TIME IS ABOUT 110 TO 140 2100 MACHINE CYCLE * PLUS THE TIME TO EXECUTE ".ENTP" & PRIVLEGED PROCESSING. SPC 1 XDEF NOP ADDRESS OF RESULTS YDEF NOP ADDRESS OF SOURCE ENTIX NOP .ENTR STYLE ENTRY .XENT EQU ENTIX JSB .ZPRV DO THE PRIVLEGDGE THING DEF LIBX JSB .ENTP GET ADDRESSES DEF XDEF SPC 1 * GET EXPONENT SPC 1 LDA D2 GET PRAM OFFSET ADA YDEF GET ADDRESS OF EXPONENT LDA A,I GET LO-MAN + EXPONENT WORD AND O377 MASK TO GET EXPONENT CLB PREPARE NEG. EXP FLAG O73 CLE,SLA,RAR FORM 16 BIT EXP. WORD CLA,RSS FORCE NEG. CASE TO BE 0 CLB,INB NOT NEG. MAKE FLAG = 1 STB NFLAG SET FLAG IF NOT NEG. EXP. LDB DM40 GET NEG MAX EXP ADB A NOW TEST FOR EXP => 40 CLB,SEZ IF EXP. > 39 ALREADY INTEGERIZED LDA O73 GET # SUCH 3 = NUMB/16 STB BITS INITIALIZE FLAG STB EV/OD INITIALIZE FLAG SPC 1 * NOW CALCULATEMASK AND WORD NUMBER SPC 1 DIV D16 A=WORD# & B=BIT# STA STORE SAVE WORD NUMBER OF MASK CLE,ERB B-REG. = BIT NUMBER TO TRUNK. ADB MTBL POINT TO MASK TABLE LDA B,I PICK UP MASK CMA,SEZ,CCE INVERT MASK & TAKE ADVANTAGE ARS OF TRICK TO HAVE 1/2 SIZE TABLE STA MASK SAVE FOR LATER USE ELA NOW FORM "LEAST BIT MASK" XOR MASK FOR TESTING EVEN/ODD NUMB STA LESBT AND SAVE FOR LATER USE SPC 1 * NOW GO MASK THE DOUBLE NUMBER SPC 1 LDB DM3 GET PRAM LENGTH-1 LDA STORE GET WORD # OF MASK CMA,INA MAKE NEG. TO INDEX BACKWARD ADA DALG0 ADD POINTER TO LAST ALG. JMP A,I JUMP TO CORRECT ALG DALG0 DEF ALG0 ALG3 JSB STORE MOVE FIRST WORD TO OUTPUT BUFF ALG2 JSB STORE ONLY 3 OF THESE SUBS. WILL BE ALG1 JSB STORE EXECUTED ALG0 JSB MASKB MASK HI-MANTISSA JSB CLRBT CLEAR MID-MANTISSA JSB CLRBT CLEAR LO-MANTISSA SPC 1 MASKB NOP MASKING ROUTINE LDA YDEF,I GET WORD TO MASKWORD AND MASK MASK OFF SIGNIFICANT BITS. INB,SZB,RSS LAST PASS = LO-MAN + EXP. AND OM400 MASK OF EXPONENT SZA AND BITS LEFT? ISZ BITS YES, SET FLAG XOR YDEF,I NOW RESTORE LO-MAN + EXPON - MASKED BITS STA XDEF,I AND PUT AND LESBT NOW TEST IF NUMB. EVEN/ODD STA EV/OD AND SET/CLEAR FLAG ISZ YDEF BUMP TO NEXT PRAM ISZ XDEF DITTO SZB DONE? JMP MASKB,I RETURN JMP OUT DONE SPC 1 STORE NOP ENTRY ADVANCE PRAMETER LDA YDEF,I GET CONTENTS STA XDEF,I AND PUT ISZ YDEF BUMP ADDRESS ISZ XDEF BUMP DESTIONATION ADDRESS INB,SZB BUMP COUNTER JMP STORE,I RETURN JMP OUT DONE SPC 1 CLRBT NOP CLEAR BITS ROUTINE LDA YDEF,I GET PRAM INB,SZB,RSS LAST PASS = LO-MAN + EXP. AND OM400 CLEAR ONLY MANTISSA BITS SZA ANY BITS STRIPED? ISZ BITS YES XOR YDEF,I PRODUCE EXPONENT OR 0 CPB NFLAG IF LAST & EXP = 0 THEN = 0 CLA EXPONENT = ZER0 STA XDEF,I PUT ISZ YDEF BUMP TO NEXT WORD ISZ XDEF DITTO SZB DONE JMP CLRBT,I RETURN SPC 1 OUT LDA EV/OD GET EVEN/ODD FLAG LDB BITS GET CHANGED NUMBER FLAG SZA SET? CLA,INA YES (FOR THE "DSIN" ROUTINE) LIBX JMP ENTIX,I RETURN DONE DEF ENTIX SPC 1 MTBL DEF *+1 OCT 100000 OCT 160000 OCT 174000 OCT 177000 OCT 177600 OCT 177740 OCT 177770 OCT 177776 D2 DEC 2 DM3 DEC -3 DM40 DEC -40 MASK NOP NFLAG NOP BITS NOP EV/OD NOP LESBT NOP D16 DEC 16 O377 OCT 377 OM400 OCT -400 A EQU 0 B EQU 1 END *