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 ".TENT" - TRIPLE PRECISION FLOOR (ENTIER) . 
      NAM .TENT,7 24998-1X160 REV.2001 780424 
      SUP 
* 
      ENT .TENT 
      EXT .FLUN,.ENTR,.CFER 
* 
A     EQU 0 
B     EQU 1 
* 
*     .TENT RETURNS THE GREATEST TRIPLE-PRECISION NUMBER OF INTEGER 
*     VALUE WHICH IS LESS THAN OR EQUAL TO ITS ARGUMENT.
* 
*     CALLING SEQUENCE: 
* 
*                   JSB .TENT 
*                   DEF *+3 
*                   DEF <RESULT>
*                   DEF <ARG> 
*                   <RETURN>         B=0 IFF ARG UNCHANGED. (FOR .YINT) 
* 
*     METHOD:          ARG IN [-.5,+.5): CLEAR ALL BUT SIGN BIT 
*        [-INF,-2**54) OR [+2**54,+INF]: CLEAR NO BITS
*          [-2**54,-.5) OR [+.5,+2**54]: CLEAR BITS AFTER BINARY POINT
      SPC 4 
*                   COPY ADDRESSES, COPY ARG, CHECK EXPONENT. 
* 
RESLT BSS 1 
ARG   BSS 1 
.TENT NOP 
      JSB .ENTR 
      DEF RESLT 
      JSB .CFER     COPY ARG
      DEF RESLT,I 
      DEF ARG,I 
      LDB RESLT     FORM ADDR LAST WORD RESULT AREA 
      ADB =D3 
      STB LAST
      LDB B,I       LAST WORD 
      SLB           EXP < 0 ? 
      JMP TENT3     YES, IN [-.5,+.5) 
      JSB .FLUN     GET EXP 
      ADA =D-55     EXP-55
      CLB           B=0 FOR FAST RETURN 
      SSA,RSS       EXP>54 ?
      JMP .TENT,I   YES, DONE.  NO BITS TRUNCATED.
      STB TRUNC     INITIALLY, NO BITS TRUNCATED
      ADA =D55      EXP = (#BITS TO RETAIN) - 1 
      SKP 
*                   CLEAR BITS IN MANTISSA AFTER BINARY POINT.
* 
      LDB A 
      AND =B17      (# BITS IN LAST WORD RETAINED) - 1
      BRS,BRS 
      BRS,BRS       # WORDS BEFORE THAT 
      ADB RESLT     ADDR LAST WORD RETAINED 
      CLE,ERA       #BITS/2 
      ADA MASKP     GET MASK (1 BIT SHORT IF # BITS ODD)
      LDA A,I 
      CMA,SEZ       COMPLEMENT MASK 
      ARS           IF ODD, EXTEND MASK ONE BIT 
TENT1 AND B,I       BITS WHICH WILL BE CLEARED
      CPB LAST      LAST WORD ? 
      JMP TENT2     YES, SPECIAL. 
      SZA           ANY BITS CLEARED ?
      ISZ TRUNC     YES, NOTE THAT
      XOR B,I       BITS NOT CLEARED
      STA B,I 
      CCA           CLEAR REST OF MANTISSA
      INB           GO TO NEXT WORD 
      JMP TENT1 
TENT2 AND =B177400  DON'T CLEAR EXP 
      SZA           NOTE IF BITS TRUNCATED
      ISZ TRUNC 
      XOR B,I 
      STA B,I 
      LDB TRUNC     RETURN TRUNCATION FLAG
      JMP .TENT,I   EXIT
* 
*                   IN [-.5,+.5) JUST CLEAR ALL BUT SIGN BIT, INCLUDING EXP.
* 
TENT3 LDB RESLT,I   TRUNCATION IFF ARG NONZERO. 
      LDA RESLT,I 
      AND MASKS 
      STA RESLT,I   JUST SIGN BIT 
      CLA 
      ISZ RESLT 
      STA RESLT,I 
      ISZ RESLT 
      STA RESLT,I 
      ISZ RESLT 
      STA RESLT,I 
      JMP .TENT,I   EXIT
* 
*                   LOCALS & CONSTANTS
* 
MASKP DEF MASKS     MASK TABLE ADDR 
MASKS OCT 100000,160000,174000,177000 
      OCT 177600,177740,177770,177776 
TRUNC BSS 1         ZERO IFF NO BITS TRUNCATED
LAST  BSS 1         ADDR LAST WORD RESULT 
      END 
                                                                                                                                                                  