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 ".XDIV"  EXTENDED PRECISION DIVIDE
      NAM .XDIV,6 24998-1X172 REV.2001 750701 
      ENT .XDIV 
      EXT .ZRNT,.XPAK 
      SPC 1 
* 
*     EXTENDED PRECISION DIVISION IS PERFORMED BY THIS ROUTINE
*     CALLING SEQUENCE: 
* 
*     JSB .XDIV 
*     DEF X 
*     DEF Y 
*     DEF Z 
*     WHERE    X = Y / Z
      SPC 2 
TDB   NOP 
      DEC 23
      NOP 
GETAD NOP 
      JMP GETAX 
GETPM NOP 
      JMP GETPX 
X1    NOP 
X2    NOP           QUOTIENT
X3    NOP 
TEM1  NOP 
TEM2  NOP           TEMPORARY 
TEM3  NOP 
Y1    NOP 
Y2    NOP           DIVIDEND
Y3    NOP 
EXPY  NOP 
Z1    NOP 
Z2    NOP           DIVISOR 
Z3    NOP 
EXPZ  NOP 
SIGN  NOP 
X     NOP           QUOTIENT
      SPC 1 
.XDIV NOP 
      JSB .ZRNT 
      DEF LIBX
      LDA *-2 
      LDB *-4 
      SSA,RSS 
      STB TDB+2     CHECK IF RE-ENTERENT OR NOT 
      JSB GETAD     GET ADDRESS OF X
      STB X         SAVE FOR LATER USE
      CLA,INA       SET SIGN NEG. 
      STA SIGN      INITIALIZE SIGN 
      LDB DEFY
      JSB GETPM     PRODUCE +ABS (Y)
      CCA           PRODUCE -ABS (Z)
      LDB DEFZ
      JSB GETPM 
      CCE,SZB       CHECK FOR 0 DIVISOR (Z) 
      JMP NZERO     NOT ZERO SO CONTINUE
      ERB,RBR       SET B-REG TO 40000B 
      STB X1        SET HI-MANTISSA TO APPROX +1
      STB EXPY      SET EXPONENT TO + INFINITY
      JMP OUTPT     PACK AND PUT IN X 
NZERO CLA,CLE 
      STA X3        INITIALIZE QUOTIENT 
      LDA =D-47 
      STA GETAD     SET SHIFT COUNT TO -47
      SPC 1 
*                 * PERFORM THE DIVIDE *
      SPC 1 
LOOP  LDB Y3        T = Y + Z 
      ADB Z3        LO-MANT Z 
      LDA Y2        MID-MANT Y
      SEZ,CLE       CARRY FROM LO-MANT? 
      INA           YES 
      ADA Z2        ADD MID-MANTS 
      STA TEM2      AND SAVE
      LDA Y1        HI-MANT Y 
      SEZ,CLE       CARRY FROM MID-MANT?
      INA           YES 
      ADA Z1        ADD HI-MANTS? 
      STA TEM1      WITH E-REG = OVERFLOW 
      STB TEM3
      SPC 1 
*      SHIFT E-REG INTO X 
      SPC 1 
      LDA X3        NOW SHIFT E-REG 
      LDB X2        INTO LEAST BIT OF X 
      ELA 
      ELB 
      STA X3
      STB X2
      LDB X1
      ELB,CLE       EXIT E-REG = 0
      STB X1
      SLA,RSS       LEAST BIT OF X = 1
      JMP SHFTY     NO
      SPC 1 
*    SET Y  =  Y  +  Z  IF  Y  +  Z  OVERFLOWED 
      SPC 1 
      LDA TEM3      YES, LET Y = Y + Z
      STA Y3
      LDA TEM2
      STA Y2
      LDA TEM1
      STA Y1
      SPC 1 
*    SHIFT Y LEFT ONE PLACE  (MPY BY 2) 
      SPC 1 
SHFTY LDA Y3        NOW SHIFT Y LEFT
      LDB Y2        ONE PLACE (MPY BY 2)
      ELA 
      ELB 
      STA Y3
      STB Y2
      LDA Y1
      ELA,CLE 
      STA Y1
      ISZ GETAD     TEST FOR END OF LOOP
      JMP LOOP
      SPC 1 
*     MOVE RESULTS TO X 
      SPC 1 
OUTPT LDA SIGN      CHECK IF SIGN CHANGE
      ERA           SAVE CHANGE IN E-REG
      LDA X         GET X'S ADDRESS 
      STA TEM1      SAVE TEMPORARY
      LDA X1
      SEZ           COMPLEMENT IF SIGN CHANGE 
      CMA 
      STA X,I       PUT IN HI-MANTISSA
      LDA X2
      SEZ 
      CMA 
      LDB X3
      SEZ 
      CMB,INB,SZB   LO-MANTISSA & CHECK IF BUMP 
      JMP PACK      NO BUMP CONTINUE
      INA,SZA       BUMP MID-MANTISSA 
      JMP PACK      NO BUMP, CONTINUE 
      ISZ X,I       BUMP HI-MANTISSA
      NOP           0 IS POSSIBLE, BUT -1 IS NOT. 
PACK  ISZ TEM1      NOW PUT IN CALLERS Z PARAM
      STA TEM1,I
      ISZ TEM1
      STB TEM1,I
      LDA EXPZ      CALCULATE EXPONENT
      CMA,INA       EXP = EXPY - EXPZ + 1 
      ADA EXPY
      INA           PLUS 1
      JSB .XPAK     PACK RESULT 
      DEF X,I       IN "X'S" PLACE
LIBX  JMP TDB+2,I 
      DEF TDB 
      DEC 0 
      SPC 1 
GETPX EQU *         ENTRY B=ADDRESS OF DESTINATION PLACE
      STB X1        SAVE DEST ADDRESS 
      INB 
      STB X2
      INB 
      STB X3
      JSB GETAD     GET DIRECT ADDRESS
      STB TEM1      SAVE ADDRESS OF Y OR Z
      LDB TEM1,I    GET HI-MAN OF Y OR Z
      XOR B         RESULTS = SIGN(Y-OR-Z,A-REG.) 
      RAL,SLA,ERA   "SIGN CHANGE NEEDED" IN E-REG 
      ISZ SIGN      MARK A CHANGE OF SIGN 
      ISZ TEM1      BUMP
      LDA TEM1,I    GET MID-MANTISSA
      SEZ           COMPLEMENT IF NEG.
      CMA 
      STA X2,I      SAVE
      ISZ TEM1      BUMP
      LDA TEM1,I    GET LO-MAN + EXPONENT 
      AND OM400     MASK OF EXPONENT
      SEZ           COMPLEMENT IF NEG.
      CMA 
      STA X3,I      AND SAVE
      SEZ           RESTORE IF CHANGED
      CMA 
      XOR TEM1,I    NOW GET EXPONENT
      SLA,RAR       POSITION EXPONENT 
      IOR OM200     MIRGE IF NEG. 
      SEZ,RSS       NEED TO COMPLEMENT HI-MAN 
      JMP DONE      NO, FINISH UP 
      CMB           COMPLEMENT & CHECK FURTHER PROC.
      ISZ X3,I      NOW DO THE INA'S
      JMP DONE
      ISZ X2,I      BUMP MID-MANTISSA 
      JMP DONE
      SSB,INB,RSS   BUMP HI-MANTISSA
      SSB,RSS       OVERFLOWED? 
      JMP DONE
      RBR           DIVIDE BY 2 AND 
      INA           BUMP EXPONENT 
DONE  ISZ X3        BUMP X3 TO EXPONENT 
      STA X3,I      STORE EXPONENT
      STB X1,I      SAVE HI-MANTISSA
      JMP GETPM,I   RETURN, B-REG = HI-MANTISSA 
      SPC 1 
GETAX EQU *         ENTRY A=DEF OF DEF PRAM 
      LDB TDB+2     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 TDB+2     BUMP TO NEXT PARAM
      JMP GETAD,I   RETURN, E-REG = 0 
      SPC 1 
DEFZ  DEF Z1
DEFY  DEF Y1
OM200 OCT -200
OM400 OCT -400
      SPC 1 
B     EQU 1 
      END 
* 
                  