ASMB,R,L,C
      HED "IFIX"  INTEGERIZE REAL TO 16 BIT NUMBER
* 
*     NAME:  IFIX 
*     SOURCE: 92068-18038 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   R.A.G.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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.       *
*  ***************************************************************
* 
      NAM IFIX,6 92068-1X038 REV.2013 750701  
      ENT IFIX
      EXT .ZPRV 
* 
* 
* CALL WITH FLOATING POINT NUMBER IN A&B. RETURN WITH 
* INTEGER EQUIVALENT IN A. IF OVERFLOW, SET OVFF AND
* RETURN 77777. 
IFIX  NOP 
      JSB .ZPRV 
      DEF LIBX
      STA HIMAN         SAVE MANTISSA.
      LDA B         GET LO-MAN+EXP
      AND OM400     MASK TO GET LO-MAN
      CLE,SZA       SET E-REG AS FLAG FOR 
      CCE           BITS IN LOW MAN 
      XOR B         GET EXPONENT
      CLO 
      SLA,RAR       FORM EXPONENT 
      JMP UNFLO       RETURN ZERO.
      ADA M16       COMPUTE SHIFT COUNT.
      SSA,RSS       IF EXP 16 OR MORE,
      JMP OVFLO       OVERFLOW. 
      STA B         SAVE   SHIFT  COUNT IN B. 
      LDA HIMAN 
      JMP CONT
LOOP  SLA,ARS       SHIFT RITHT & TEST BIT LOST?
      CCE           SET E-REG IF BIT LOST 
CONT  ISZ B         ANY MORE SHIFTS?
      JMP LOOP      YES 
      SEZ,SSA       NO,BITS LOST? 
      INA           YES,BUMP IF ALSO NEG. 
      JMP LIBX      RETURN A= ANS 
UNFLO CLA 
      JMP LIBX
OVFLO LDA INFIN 
      STF 1 
LIBX  JMP IFIX,I
      DEF IFIX
OM400 OCT -400
HIMAN NOP 
M16   DEC -16 
INFIN OCT 77777 
B     EQU 1 
      END 
* 
                                                                                                                                                                                                            