ASMB,R,Q,C
*     NAME:   .PACK 
*     SOURCE: 92070-18240 
*     RELOC:  92070-1X240 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
* 
      NAM .PACK,6  92070-1X240  REV.1941  790228  
      ENT .PACK 
      EXT .ZPRV 
* 
* 
* ENTER WITH A SIGNED 31 BIT MANTISSA IN A&B. 
* EXIT WITH A FLOATING POINT, NORMALIZED, NUMBER IN A&B.
*   CALL:      JSB .PACK
*            X BSS 1   (CONTAINS EXPONENT)
*              <RETURN POINT>  X MAY BE CHANGED 
.PACK NOP     ENTRY POINT 
      JSB .ZPRV 
      DEF LIBX
      STA A     SAVE A REGISTER.
      CLA 
      STA EXPON   SET EXPON TO ZERO.
      LDA A 
      SZA,RSS    IF A AND B ARE BOTH ZERO 
      SZB           RETURN IMMEDIATELY. 
      JMP NORML    ELSE GO TO NORMALIZING SECTION.
BACK  CLO        CLEAR OVERFLOW FOR GOOD RETURN.
      ISZ .PACK     BUMP RETURN ADDRESS PAST X. 
      JMP LIBX
* NORMALIZING SECTION * 
SHIFT ISZ EXPON   COUNTS # OF LEFT SHIFTS.
NORML CLE,ELB     ROTATE A&B LEFT INTO E. 
      ELA 
      SEZ,SSA,RSS TEST THE ORIGINAL 2 HIGH BITS.
      JMP SHIFT   BOTH WERE 0--# WAS +UNNORMALIZED. 
      SEZ,SSA 
      JMP SHIFT   BOTH WERE 1--# WAS -    " 
      ERA         UNDO THE SHIFT, PRODUCING A 
      ERB,CLE      NORMALIZED MANTISSA. 
* ROUNDING SECTION *
      ADB .177      ADD IN SUFFICIENT ROUND FOR NEG-
      SSA,RSS        ATIVE NUMBERS. 
      INB           IF POSITIVE, 1 MORE IS NECESSARY. 
      CLO           CLEAR TO TEST FOR A-REG. OVFLOW.
      SEZ           TEST FOR OVERFLOW OUT OF B. 
      CLE,INA           IF SO, BUMP A REGISTER. 
      SOS           IF THE BUMP CAUSES OVERFLOW,, 
      RAL            SKIP THIS SHIFT (A=100000,B=0).
      SSA,SLA,RSS   TEST FOR TOP 2 BITS=1.
      JMP *+3 
* THIS LAST TEST IS NECESSARY TO OBTAIN THE CORRECT RESULT
* WHEN THE UNROUNDED MANTISSA WAS 101...1 AND A ROUND OCCURRED, 
* PRODUCING 110...0, WHICH IS UNNORMALIZED. THIS IS THE RESULT
* WE HAVE IF WE GET HERE. 
      ISZ EXPON BECAUSE WE ARE GOING TO SHIFT LEFT. 
      ARS,SLA,ALS PRODUCES A=10...0 AND SKIPS.
      RAR           UNDOES THE RAL ABOVE. 
* AT THIS POINT, A&B ARE NORMALIZED&ROUNDED, AND THE
* TRUE EXPONENT IS .PACK,I-EXPON(+1 IF OVFF=1). 
      STA A         SAVE A REGISTER.
      LDA 1         REMOVE LOW ORDER 8 BITS OF B. 
      AND MASKH 
      STA 1 
      LDA EXPON     COMPUTE TRUE EXPONENT AS DESCRIBED
      CMA,INA 
      ADA .PACK,I 
      SOC         ADD 1 MORE IF OVERFLOW OCCURRED 
      INA 
      ADA P200      TEST FOR EXPONENT UNDERFLOW.
      SSA 
      JMP XUNDR 
      ADA M400      TEST FOR EXPONENT OVERFLOW
      SSA,RSS 
      JMP XOVER 
      ADA P200      RESTORE ORIGINAL EXPONENT.
      RAL            POSITION SIGN TO LSB.
      AND MASKL     MASK TO 8 BITS. 
      ADB 0         PACK INTO B.
      LDA A        RESTORE HIGH PART
      JMP BACK
* OVERFLOW UNDERFLOW SECTION *
XUNDR CLA           RETURN ZERO FOR UNDERFLOW.
      CLB 
      JMP SETOV 
XOVER LDA INF1      RETURN +INFINITY FOR OVERFLOW 
      LDB INF2
SETOV STF 1         SET OVERFLOW FLAG FOR OVERFLOW
      JMP BACK+1       OR UNDERFLOW.
LIBX  JMP .PACK,I 
      DEF .PACK 
EXPON REP 1 
      NOP 
A     REP 1 
      NOP 
.177  OCT 177 
P200  OCT 200 
M400  OCT -400
MASKL OCT 377 
MASKH EQU M400       (177400) 
INF1  OCT 77777 
INF2  OCT 177776
      END 
* 
                                                      