ASMB,R,Q,C
*     NAME:   .FMP  
*     SOURCE: 92070-18224 
*     RELOC:  92070-1X224 
*     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 .FMP,6  92070-1X224  REV.1941  790418 
* 
      ENT .FMP
      EXT .PACK,.ZPRV 
* 
* 
*     CALLING SEQUENCE:      DLD <ARG1> 
*                            JSB .FMP 
*                            DEF <ARG2> 
*                            (RESULT IN (A,B))
* 
*     IF UNDERFLOW OCCURS, ZERO IS RETURNED.
*     IF OVERFLOW OCCURS, (077777,177777) IS RETURNED.
*     IF UNDERFLOW OR OVERFLOW OCCUR, THE OVERFLOW BIT IS 
*     SET, OTHERWISE IT IS CLEARED. 
      SPC 3 
*                   UNPACK OPERANDS, ADD EXPONENTS. 
* 
.FMP  NOP 
      JSB .ZPRV 
      DEF LIBX
      STA A1        SAVE HIGH PART OF MULTIPLICAND. 
      STB A2        (IN CASE WE ARE SQUARING) 
      ERA           SAVE "E". 
      STA ESAVE 
      LDA 1         GET LO-MAN+EXP
      AND OM400     MASK OF EXP 
      STA B1
      XOR 1         FORM EXPONENT 
      SLA,RAR 
      IOR OM200 
      STA EXPON     SAVE EXPONENT.
      LDA .FMP,I     GET ADDRESS OF MULTIPLIER. 
      STA B2        GET MULTIPLIER WITH CARE. 
      LDA A1
      LDB A2
      DLD B2,I      THIS WORKS EVEN IF SQUARING OPERAND.
      STA A2        SAVE HIGH PART
      LDA 1         GET LO-MAN+EXP
      AND OM400     MASK OFF EXP
      STA B2        SAVE TEMP 
      XOR 1         GET EXPONENT
      SLA,RAR       AND POS+FORM
      IOR OM200 
      INA 
      ADA EXPON 
      STA EXPON 
      SKP 
*                   MULTIPLY MANTISSAS. 
* 
      LDA B2        FIRST CROSS PRODUCTS. THEY ARE HALVED SO THAT 
      RAR           THE MULTIPLY IS EASY AND THE SUM DOESN'T OVERFLOW.
      MPY A1        COMPUTE FIRST CROSS PRODUCT.
      STB B2        SAVE UPPER PART ONLY. 
      LDA B1        COMPUTE SECOND CROSS PRODUCT. 
      RAR 
      MPY A2
      ADB B2        ADD THE 2 CROSS PRODUCTS. 
      CLE,ELB       LEFT SHIFT & REMEMBER SIGN. 
      STB B2        SAVE IT.
      LDA A1        COMPUTE UPPER * UPPER.
      MPY A2
      SEZ           IF SUM OF CROSS PRODUCTS IS NEGATIVE, 
      ADB KM1       MUST ACCOUNT FOR ITS SIGN EXTENSION.
      CLE           NOW ADD CROSS PRODUCTS. 
      ADA B2
      SEZ           AND PROPOGATE CARRY.
      INB 
      SWP           RESTORE NORMAL ORDER. 
* 
*                   NORMALIZE, PACK & EXIT. 
* 
      JSB .PACK     NORMALIZE AND PACK
EXPON NOP 
      ISZ .FMP
      STA A1        RESTORE "E".
      LDA ESAVE 
      ELA 
      LDA A1
LIBX  JMP .FMP,I    EXIT. 
      DEF .FMP
* 
*                   TEMPS & CONSTANTS.
* 
A1    NOP 
A2    NOP 
B1    NOP 
B2    NOP 
ESAVE NOP 
KM1   DEC -1
OM400 OCT -400
OM200 OCT -200
* 
      END 
                                                                                                                                              