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 ".XCOM" EXTENDED PRECISION MANTISSA COMPLEMENT
      NAM .XCOM,6 24998-1X072 REV.2001 750701 
      ENT .XCOM 
      EXT .ZPRV 
      SPC 1 
* 
*     THIS ROUTINE COMPLEMENTS A THREE WORD MANTISSA IN PLACE 
*     CALLING SEQUENCE: 
*         JSB .XCOM 
*         DEF X 
*     ON RETURN -A- CONTAINS THE ADJUSTMENT TO THE EXPONENT (0 OR 1)
*     TIME:  APPROX 56-74  2100 MACHINE CYCLES + PRIV. PROC.
      SPC 1 
.XCOM NOP 
      JSB .ZPRV 
      DEF LIBX
      LDA .XCOM 
      LDA A,I       WE CAN BEAT .DFER 
      RAL,CLE,SLA,ERA 
      JMP *-2       TRACK DOWN INDIRECTS
      STA X1        SAVE ADDRESS OF 1ST 
      INA 
      STA X2        2ND 
      INA 
      STA X3        3RD 
      LDA X3,I
      LDB X2,I
      CMB           COMPLEMENT MID-MANTISSA 
      CMA,INA,SZA   2'S COMPLEMENT LOW MANTISSA 
      JMP OK        NO CARRY
      LDA X1,I
      CMA           COMPLEMENT HIGH-MANTISSA
      CLE,INB,SZB   CARRY-IN TO MID-MANTISSA
      JMP OK1       NO CARRY OUT, DONE
      CLE,SSA,INA,RSS  CARRY-IN TO HIGH 
      SSA,RSS       IF POSITIVE, CHECK OVERFLOW 
      JMP OK1       NO, DONE
      RAR           YES, SHIFT IT DOWN AND
      CCE           BUMP EXPONENT 
      JMP OK1 
OK    STA X3,I      SAVE LOW MANTISSA 
      LDA X1,I      FINISH COMPLEMENTING HIGH 
      CMA,CLE        MANTISSA 
OK1   STA X1,I      SAVE HIGH AND MID MANTISSA
      STB X2,I
      CLA,SEZ       ADJUST EXPONENT 
      CLE,INA 
      ISZ .XCOM     BUMP RETURN ADDRESS 
LIBX  JMP .XCOM,I 
      DEF .XCOM 
X1    NOP 
X2    NOP 
X3    NOP 
A     EQU 0 
      END 
* 
* 
* 
* 
* 
* 
                                                                  