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 ".FIXD" - FIX 2-WORD FLOATING TO DOUBLE INTEGER.
      NAM .FIXD,7 24998-1X193 REV.2001 780822 
      ENT .FIXD,.FXDE 
      EXT .FLUN 
* 
*     .FIXD CONVERTS A 2-WORD FLOATING-POINT NUMBER 
*     TO A TWO-WORD INTEGER.  ALSO CONTAINS COMMON CODE 
*     USED BY .XFXD AND .TFXD . 
*     CALLING SEQUENCE: 
* 
*                   DLD <ARG> 
*                   JSB .FIXD 
*                   <RETURN>   (A,B) = RESULT 
* 
*     OVERFLOW OCCURS IF THE ARGUMENT IS OUTSIDE THE RANGE
*     [-2**31,+2**31) .  THE OVERFLOW BIT IS SET AND THE
*     VALUE RETURNED IS (77777,177777) .
* 
*                   UNPACK AND CHECK EXP. 
* 
.FIXD NOP 
      STA X         MANTISSA UPPER
      CLA           CLEAR TRUNCATION FLAG 
      STA TRUNC 
      JSB .FLUN     A=EXP, B=LAST 8 MANTISSA BITS 
      STB X+1       MANTISSA LOWER
FIXD1 SSA           EXPONENT NEG ?
      JMP ZERO      YES, IN [-.5,+.5), RESULT = 0 
      ADA =D-32     (EXP-32) = -(# BITS TO SHIFT)-1 
      CMA,SSA       EXP > 31 ?   (A = # BITS TO SHIFT)
      JMP FIXD9     YES, OFL. 
      STA EXP 
* 
*                   SHIFT BY (N-1)/16 WORDS, THEN MOD(N-1,16)+1 BITS
* 
      CLE,SZA,RSS   IF ZERO, DON'T SHIFT   (E=0 HERE) 
      JMP FIXD8 
      AND =B17      # BITS OVER WORD SHIFT (0=16) 
      IOR ASR16     FORM "ASR N"
      STA FIXD3 
      XOR LSMRS     "ASL N" 
      STA FIXD4 
      LDA EXP       SHIFT COUNT 
      ADA =D-17     E=1 IFF WORD SHIFT
      LDB X         MANTISSA
      LDA X+1 
      SEZ,RSS       WORD SHIFT ?
      JMP FIXD2     NO. 
      IOR TRUNC     YES, NOTE TRUNCATED BITS. 
      STA TRUNC 
ASR16 ASR 16        WORD SHIFT (ONLY IF COUNT > 16) 
FIXD2 STA EXP       REMEMBER LOW WORD 
FIXD3 ASR 16        BIT SHIFT  (1-16 BITS)
      SSB,RSS       MANTISSA NEGATIVE ? 
      JMP FIXD6     NO, IGNORE TRUNCATED BITS, DONE.
      SKP 
*                   MANTISSA NEGATIVE, MUST ADD ONE IF BITS TRUNCATED.
* 
      STB X         SAVE RESULT 
      STA X+1 
FIXD4 ASL 16        UNDO BIT SHIFT
      XOR EXP       TRUNCATED BITS
      IOR TRUNC     PLUS PREVIOUSLY TRUNCATED BITS
      LDB X         UPPER WORD
FIXD5 SZA           BITS TRUNCATED ?
      ISZ X+1       YES, INCREMENT LOWER
      JMP *+2       NO CARRY OR NO BITS TRUNC 
      INB           PROPOGATE CARRY (NO OFL)
      LDA X+1       LOWER WORD
* 
*                   EXIT. 
* 
FIXD6 SWP           (A,B) = RESULT, OVERFLOW CLEAR. 
FIXD7 CLO 
      JMP .FIXD,I   EXIT
FIXD8 LDB X         (B,A) = MANTISSA  (SHIFT = 0) 
      LDA X+1 
      SSB,RSS       IF POSITIVE,
      JMP FIXD6       SWAP & EXIT.
      LDA TRUNC     ELSE MAY INCREMENT. 
      JMP FIXD5 
* 
*                   IN [-.5,+.5), RESULT = 0
* 
ZERO  CLA           (A,B) = 0 
      CLB 
      JMP FIXD7     EXIT. 
* 
*                   EXP > 31, OFL 
* 
FIXD9 LDA =B77777   RETURN MAX POS NUMBER 
      CCB 
      STO           SET OFL 
      JMP .FIXD,I   EXIT
* 
*                   LOCALS
* 
.FXDE DEF FIXD1     ENTRY FROM .XFXD,.TFXD
X     BSS 4         MANTISSA (SET BY .XFXD, .TFXD)
TRUNC EQU X+2       BITS TRUNCATED
EXP   EQU X+3       SHIFT COUNT  (SCRATCH FOR .XFXD, .TFXD) 
LSMRS OCT 001000    "ASR 16" .XOR. "ASL 16" 
      END 
                                                                                                                                                                                                                                    