ASMB,R,L,C
      HED ".FADS" 2-WORD FLOATING-POINT ADD & SUBTRACT. 
* 
*     NAME:  .FADS
*     SOURCE: 92068-18039 
*     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 .FADS,6 92068-1X039 REV.2013 790417 
      ENT .FAD,.FSB 
      EXT .PACK,.ZPRV 
* 
* 
*     CALLING SEQUENCE
* 
*        DLD X          DLD X 
*        JSB .FAD       JSB .FSB
*        DEF Y          DEF Y 
* 
*          FLOATING RESULT (X+Y) OR (X-Y) IN A AND B REGISTERS. 
*          "E" BIT PRESERVED. 
      SPC 3 
*                   ADD: UNPACK, GO ADD.
* 
* 
.FAD  NOP            ENTRY FOR FLOATING ADD.
      JSB .ZPRV 
      DEF LIBX
      STA A1        SAVE (A). 
      LDA .FAD      COPY ENTRY POINT. 
      STA .FSB
      LDA A1        RESTORE (A).
      JSB UNPAK     GET ARGUMENTS UNPACKED
      JMP ADMUP     GO TO COMMON SECTION
* 
*                   SUBTRACT: UNPACK, NEGATE, GO ADD. 
* 
.FSB  NOP            ENTRY FOR FSB. EXIT FOR FAD/FSB. 
      JSB .ZPRV 
      DEF LIBX
      STA A1        SAVE (A). 
      JSB UNPAK      GET ARGUMENTS UNPACKED.
      LDA A2        (A,B) = SECOND MANTISSA.
      LDB B2
      CMA           DOUBLE LENGTH TWOS COMPLEMENT.
      CMB,INB,SZB   IF LOW PART NOT ZERO, THEN ALL
      JMP FSB01       DONE. 
      SSA,INA,RSS   OTHERWISE BUMP A. IF A WAS NEGA-
      SSA,RSS        TIVE, AND REMAINS SO,
      JMP FSB01 
      RAR             THEN SHIFT IT DOWN &
      ISZ X2           BUMP THE EXPONENT. (SKIP O.K.) 
FSB01 STB B2
      STA A2
      SKP 
*                   COMMON: FIRST, ENSURE FIRST ARG HAS LARGER EXPONENT.
* 
ADMUP ISZ .FSB       BUMP RETURN ADDRESS. 
      LDA X2        COMPUTE EXPONENT DIFFERENCE.
      CMA,INA 
      ADA X1
      CMA,SSA,INA   IF ARG1 IS LARGER, GO TO ADD
      JMP ADDEM       SECTION.
      LDA A1        OTHERWISE, EXCHANGE THE ARGS. 
      LDB A2
      STA A2
      STB A1
      LDA B1
      LDB B2
      STA B2
      STB B1
      LDA X2        RE-COMPUTE EXPONENT DIFFERENCE, 
      CMA,INA       BUT DON'T NEGATE. 
      ADA X1
      LDB X2        RESET X1. 
      STB X1
* 
*                   SHIFT SMALLER ARGUMENT RIGHT. 
* 
ADDEM ADA K24       IF SHIFT COUNT IS 25 OR MORE, 
      CMA,SSA,INA,RSS  THEN IGNORE SMALLER ARGUMENT.
      JMP TAKIT 
      ADA K24       RESTORE SHIFT COUNT.
      CLE,ERA       DIVIDE BY TWO.
      SZA           WAS IT ZERO OR ONE ?
      ADA ASR00     NO, CONSTRUCT SHIFTS (ELSE NOPS)
      STA XEQ1      STORE THEM. 
      STA XEQ2
      LDB A2        (B,A) = SMALLER ARGUMENT. 
      LDA B2
XEQ1  NOP           ** VARIABLE SHIFT **
XEQ2  NOP           ** VARIABLE SHIFT **
      SEZ,CLE       EXTRA SHIFT ? 
      ASR 1         YES. DO IT. 
* 
*                   ADD LARGER ARGUMENT TO (B,A). 
* 
      ADA B1        ADD LOWERS. 
      CLO           WILL CHECK FOR OFL. 
      SEZ,RSS       CARRY OUT OF LOWER ADD ?
      JMP FAD05     NO. JUST GO ADD UPPERS. 
      CLE,SSB       YES. CHECK SIGN OF UPPER IN B.
      JMP FAD04     B<0. ADD THE CARRY TO IT. 
      ADB A1        B>=0. ADD THE OTHER UPPER,
      INB           THEN THE CARRY. 
      JMP FAD06 
FAD04 INB           ADD CARRY.
FAD05 ADB A1        ADD OTHER UPPER.
      SKP 
*                   COMPENSATE FOR MANTISSA OVERFLOW. SWAP. 
* 
FAD06 SOS           OVERFLOW ?
      JMP FAD07     NO. 
      ISZ X1        YES. BUMP EXPONENT. 
      NOP           DON'T REMOVE !! 
      ERB           AND RIGHT SHIFT.
      ERA 
FAD07 SWP 
* 
*                   PACK, RESTORE "E" & EXIT. 
* 
DONE  JSB .PACK     PACK IT.
X1    NOP 
      STA A1        RESTORE "E".
      LDA ESAVE 
      ELA 
      LDA A1
LIBX  JMP .FSB,I
      DEF .FSB
* 
*                   SHIFT > 24, JUST RETURN LARGER NUMBER.
* 
TAKIT LDA A1
      LDB B1
      JMP DONE
      SKP 
*                   COMMON UNPACK FOR ADD & SUBTRACT. 
* 
UNPAK NOP           UNPACKING SECTION 
      STB A2        (IN CASE SECOND ARG IN (A,B) )
      SZA,RSS       IF FIRST ARGUMENT = 0,
      CLB,INB       SET ITS EXPONENT TO MAX NEG.
      ERA           SAVE "E". 
      STA ESAVE 
      LDA 1         GET LO-MAN+EXP
      AND OM400     MASK OF EXP 
      STA B1        SAVE LOW PART OF ARG1 
      XOR 1         GET EXPONENT
      SLA,RAR       FORM AND POSITION 
      IOR OM200 
      STA X1        SAVE EXP. OF ARG1 
      LDA .FSB,I    (A) = ADDRESS OF SECOND ARGUMENT. 
      STA B2        BE CAREFUL. 
      LDA A1        RESTORE A,B 
      LDB A2
      DLD B2,I      GET SECOND ARGUMENT 
      STA A2        SAVE HIGH PART
      SZA,RSS       IF SECOND ARGUMENT = 0, 
      CLB,INB       SET ITS EXPONENT TO MAX NEG.
      LDA 1         GET LO-MAN+EXP
      AND OM400     MASK TO GET LO-MAN
      STA B2        SAVE LOW PART 
      XOR 1         GET EXPONENT
      SLA,RAR 
      IOR OM200 
      STA X2        SAVE EXP
      JMP UNPAK,I 
* 
*                   CONSTANTS & TEMPS.
* 
A1    NOP           UPPER OF FIRST / LARGER.
B1    NOP           LOWER OF FIRST / LARGER.
A2    NOP           UPPER OF SECOND / SMALLER.
B2    NOP           LOWER OF SECOND / SMALLER.
X2    EQU .FAD      SECOND EXPONENT.
ESAVE NOP           "E" BIT IN SIGN.
* 
K24   DEC 24
OM400 OCT -400
OM200 OCT -200
ASR00 ASR 16
* 
      END 
                                                                                                          