ASMB,R,L,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 "XADSB" EXTENDED PRECISION ADD / SUBTRACT 
      NAM XADSB,6 24998-1X191 REV.2001 750701 
      ENT .XADD,.XSUB 
      EXT .ZPRV 
      EXT .XPAK 
      SPC 1 
* 
*     THIS ROUTINE HANDLES FLOATING POINT ADDITION AND SUBTRACTION
*     IN EXTENDED PRECISION. NUMBERS ARE REPRESENTED BY THREE 
*     16 BIT WORDS. THE MANTISSA IS 40 BITS, TWO'S COMPLEMENT.
*     THE EXPONENT IS 8 BITS WITH THE SIGN IN THE LSB.
*     CALLING SEQUENCE: 
* 
*     JSB .XADD OR .XSUB
*     DEF X 
*     DEF Y        X = Y - Z
*     DEF Z        X = Y + Z
      SPC 1 
Y1    NOP 
Y2    NOP 
Y3    NOP 
Y4    NOP 
Z1    NOP 
Z2    NOP 
Z3    NOP 
Z4    NOP 
      SPC 1 
.XADD NOP 
      JSB .ZPRV 
      DEF LIBX
      JSB UNPAK     GET AND UNPAK X & Y ARGS. 
      JMP ADSUB     GO TO COMMON CODE 
      SPC 1 
.XSUB NOP 
      JSB .ZPRV 
      DEF LIBX
      LDA .XSUB 
      STA .XADD     SET CALLERS ADDRES
      JSB UNPAK     GET & UNPACK ARGUMENTS
      LDA Z2        TWO'S COMPLEMENT SECOND ARGUMENT
      LDB Z3        GET LO & MID MANTISSA 
      CMA,CLE       COMPLEMENT MID-MANT.
      CMB,INB,SZB,RSS COMPLEMENT LO-MANT
      CLE,INA       BUMP MID-MANT IF LO-MANT = 0
      STB Z3        PUT BACK LO-MANT
      STA Z2        PUT BACK MID-MANT 
      LDA Z1        GET HI-MANT 
      CMA,SEZ       COMPLEMENT AND INCREMENT
      INA           IF MID-MANT OVERFLOWED (=0) 
      STA Z1
      SPC 1 
*                  * COMMON SECTION * 
      SPC 1 
ADSUB LDA Z4        COMPUTE EXPONENT DIFFERENCE 
AGAIN CMA,INA 
      ADA Y4
      SSA,RSS       IF EXP1 > EXP2 THEN 
      JMP ADDEM      GO TO ADD THEM TOGETHER. 
      LDA Y1        OTHERWIZE EXCHANGE ARGUMENTS
      LDB Z1
      STA Z1
      STB Y1
      LDA Y2
      LDB Z2
      STA Z2
      STB Y2
      LDA Y3
      LDB Z3
      STA Z3
      STB Y3
      LDA Y4
      LDB Z4
      STA Z4
      STB Y4
      JMP AGAIN 
      SPC 1 
ADDEM STA B         SAVE POSSIBLE ABS(EXP1-EXP2)
      ADA DM41      IF SHIFT COUNT IS 41 OR MORE
      SSA,RSS        THEN IGNORE SMALLER ARGUMENT.
      JMP TAKIT 
      SPC 1 
*   DO 3 REGISTER SHIFT ON Z1 - Z3
      SPC 1 
      LDA B         GET DIFFERENCE OF EXPONENTS 
      AND O17       MASK TO GET  MOD(DIF,16)
      CMA           FORM SHIFT BIT COUNT -1 TO -16
      STA TEMP2     SAVE SHIFT BIT COUNT -1 TO -16
      STA TEMP1     REALLY = 0 TO 15
      BRS,BRS       DIVIDE COUNT BY 16
      BRS,CLE,BRS   TO DETERMINE NEG. WORD SHIFT -1 
      CMB 
      STB GETPM     SAVE = -1  TO -3 (0 TO 2 WORDS) 
      LDA Z1        GET HI-MANTISSA 
      LDB Z2        GET MID-MANTISSA
      JMP CONT1     ANY BIT SHIFTS? 
LOOP1 CLE,SLA,ARS   MORE BIT SHIFTS 
      CCE           CARRY NEGATIVE BITS 
      ERB,CLE       INTO B-REG
CONT1 ISZ TEMP2     ANY BIT SHIFTS? 
      JMP LOOP1     YES, TRY MORE 
      ISZ GETPM     ANY WORD SHIFTS?
      JMP SFT12     YES - ONE OR TWO WORDS! 
      STA Z1        NO, PUT IN PLACE
      LDA Z2        GET MID-MANTISSA
      STB Z2        PUT BACK NEW MID-MANTISSA 
      LDB Z3        GET LO-MANTISSA 
      JMP CONT2     NOW SHIFT MID TO LO-MANTISSA
LOOP2 ERA 
      ERB,CLE 
CONT2 ISZ TEMP1     ANY MORE BITS?
      JMP LOOP2     YES, TRY MORE 
      STB Z3        SAVE LO-MANTISSA
      JMP ADDIT     NO, GO ADD THE MANTISSA'S 
      SPC 1 
SFT12 STA Z2        SAVE HI-MAN IN MID WORD 
      STB Z3        AND IN LO WORD
      ISZ GETPM     ONE WORD SHIFT? 
      STA Z3        MID-MANTISSA IN LO WORD 
      CLB,CLE       NOW PATCH UP LEADING BITS 
      SSA           TO BE CLEAR IF +
      CCB           AND BE SET IF - 
      STB Z1        HI-MANTISSA IS FOR SURE 
      ISZ GETPM     IF 2 WORD SHIFT SET MID-WORD
      RSS 
      STB Z2        ELSE SKIP IF 1 WORD SHIFT 
      SPC 1 
*                  * THE ADDITION IS DONE HERE *
      SPC 1 
ADDIT LDA Z3
      LDB Z2
      ADA Y3        ADD LOW MANTISSAS 
      SEZ            IF OVERFLOW
      CLE,INB        BUMP MID-MANTISSA
      STA Y3        SAVE LOW MANTISSA 
      LDA Z1
      ADB Y2        ADD MID-MANTISSAS 
      SEZ           IF CARRY OUT THEN 
      CLE,INA        BUMP HIGH MANTISSA 
      ADA Y1        ADD IN HIGH PART
      STA Y1
      STB Y2
TAKIT LDA Y4
      INA           MULTIPLY BY 2 
      JSB .XPAK     PACK EXPONENT AND LOW MANTISSA
DEFY  DEF Y1
      LDB .XSUB 
      LDA Y1
      STA B,I 
      INB 
      LDA Y2
      STA B,I 
      INB 
      LDA Y3
      STA B,I       MOVE RESULT TO MAIN PROGRAM 
LIBX  JMP .XADD,I 
      DEF .XADD 
      SPC 1 
UNPAK NOP           ENTRY A=NOP OF CALLER (XADD-XSUB) 
      JSB GETAD 
      STB .XSUB     SAVE FOR RETURN PARAM.
      LDB DEFY      GET ADDRESS OF Y1 
      JSB GETPM     GET PARAMS & UNPAK & MOVE 
      LDB DEFZ      GET ADDRESS OF Z1 
      JSB GETPM     GET PRAMS & UNPAK & MOVE TO Z1-4
      JMP UNPAK,I   RETURN
      SPC 1 
GETPM NOP           ENTRY B=ADDRESS OF DESTINATION PLACE
      STB TEMP2     SAVE DEST ADDRESS 
      JSB GETAD     GET DIRECT ADDRESS OF Z 
      STB TEMP1     SAVE ADDRESS OF Z 
      LDB TEMP1,I   GET HI-MAN OF Z 
      CLE,SLB,BRS   DIVIDE BY 2 TO AVOID
      CCE           OVERFLOWS WHEN ADDING 
      STB TEMP2,I   SAVE
      ISZ TEMP2     BUMP TO PARAM(2)
      ISZ TEMP1     BUMP
      LDA TEMP1,I   GET MID-MANTISSA
      ERA           PROPAGATE BITS
      STA TEMP2,I   SAVE
      ISZ TEMP2 
      ISZ TEMP1     BUMP
      LDA TEMP1,I   GET LO-MAN + EXPONENT 
      AND OM400     MASK OF EXPONENT
      ERA           PROPAGATE BITS
      STA TEMP2,I   AND SAVE
      ISZ TEMP2     BUMP TO PARAM(4)
      ELA           RESTORE A-REG. FROM PRE-SHIFT 
      XOR TEMP1,I   NOW GET EXPONENT
      SZB,RSS       FORCE = -200B IF HI-MAN = 0 
      CLA,INA 
      SLA,RAR       POSITION EXPONENT 
      IOR OM200     MIRGE IF NEG. 
      STA TEMP2,I   SAVE EXPONENT 
      JMP GETPM,I   RETURN TO CALLER
      SPC 1 
GETAD NOP           ENTRY A=DEF OF DEF PRAM 
      LDB .XADD     RETURN A-REG = A-REG+1 &
      LDB B,I       B-REG = DIRECT ADDRESS OF PRAM
      RBL,CLE,SLB,ERB  INDIRECT?
      JMP *-2       YES, TRY AGAIN
      ISZ .XADD     BUMP TO NEXT PARAM
      JMP GETAD,I   RETURN
      SPC 1 
DEFZ  DEF Z1
TEMP2 NOP 
TEMP1 NOP 
DM41  DEC -41 
O17   OCT 17
OM200 OCT -200
OM400 OCT -400
B     EQU 1 
      END 
* 
                                                                                                                                  