	NAME	FLPT
	CSEG

	PUBLIC	OVERF,FLOAD,FSTOR,FADD,FSUB,FMUL,FDIV,FTEST
	PUBLIC	FCHS,FABS,RSH,LSH,ADD10,FZERO,FCOMP,FSTR0
	EXTRN	OVER,PREX,ACCE,ACCS,ACC1,ACC2,ACC3,SF

 ;     8008 BINARY FLOATING POINT SYSTEM
 ;     ARITHMETIC AND UTILITY PACKAGE
 ;     PROGRAMMER  CAL OHME
 ;     DATE  26 DECEMBER 1973


 ;     FSTOR SUBROUTINE ENTRY POINT.
 FSTR0:  MOV     M,E;       STORE ZEROETH WORD
        INR     L;       TO ADDRESS FIRST WORD
 FSTOR:   MOV     M,A;       STORE FIRST WORD
 STR1:  INR     L;       TO ADDRESS SECOND WORD
        MOV     M,B;       STORE SECOND WORD
        INR     L;       TO ADDRESS THIRD WORD
        MOV     M,C;       STORE THIRD WORD
        INR     L;       TO ADDRESS FOURTH WORD
        MOV     M,D;       STORE FOURTH WORD
        RET     ;       RETURN TO CALLER
 ;     FLOATING POINT ZERO SUBROUTINE ENT. PNT.
 FZERO:	LXI	H,ACCE;	TO ADDRESS ACCUM EXPONENT
        XRA     A;       ZERO
        MOV     M,A;       CLEAR ACCUMULATOR EXPONENT
        RET     ;       RETURN TO CALLER
 ;     FLOATING POINT CHS SUBROUTINE ENT. PNT.
 FCHS:   MVI     A,80H;  MASK FOR SIGN BIT
        DB      00EH;  LBI INST TO SKIP NEXT WD
 ;     FLOATING POINT ABS SUBROUTINE ENT. PNT.
 FABS:   XRA     A;       ZERO
        LXI     H,ACCS;  TO ADDRESS ACCUM SIGN
        ANA     M       ;       COMPLEMENT OF SIGN
        XRI     80H;  COMPLEMENT THE SIGN BIT
        MOV     M,A;       ACCUMULATOR SIGN
 ;     FLOATING POINT TEST ENTRY POINT.
 FTEST: LXI    H,ACCE;  TO ADDR ACCUM EXPONENT
        MOV     A,M;       ACCUMULATOR EXPONENT
        ANA     A       ;       SET CONTROL BITS
        JZ      FZERO;   IF ACCUMULATOR IS ZERO
        MOV     E,A;       ACCUMULATOR EXPONENT
        INR     L;       TO ADDR ACCUMULATOR SIGN
        MOV     A,M;       ACCUMULATOR SIGN
        INR     L;       TO ADDR ACCUM 1ST FRCTN
        XRA     M;       ACCUM SIGN AND 1ST FRCTN
        INR     L;       TO ADDR ACCUM 2ND FRCTN
        MOV     C,M;       ACCUMULATOR 2ND FRACTION
        INR     L;       TO ADDR ACCUM 3RD FRCTN
        MOV     D,M;       ACCUMULATOR 3RD FRCTN
        JMP     ADD12; TO SET EXIT CONDITIONS
 ;     FLOATING POINT LOAD ENTRY POINT.
 FLOAD:   MOV     A,M;       OPERAND EXPONENT
        ANA     A       ;       SET CONTROL BITS
        JZ      FZERO;   IF OPERAND IS ZERO
        MOV     E,A;       OPERAND EXPONENT
        INR     L;       TO ADDR OP SIGN AND 1ST
        MOV     A,M;       OPERAND SIGN AND 1ST FRCTN
        INR     L;       TO ADDRESS OPERAND 2ND FRACTION
        MOV     C,M;       OPERAND 2ND FRACTION
        INR     L;       TO ADDRESS OPERAND 3RD FRACTION
        MOV     D,M;       OPERAND 3RD FRACTION
 ;     STORE THE OPERAND IN THE ACCUMULATOR.
        MOV     L,A;       OPERAND SIGN AND 1ST FRCTN
 FLOAD1:  ORI     80H;  ACCUMULATOR 1ST FRACTION
        MOV     B,A;       ACCUMULATOR 1ST FRACTION
        XRA     L;       ACCUMULATOR SIGN
        LXI     H,ACCE;  TO ADDR ACCUM EXPONENT
        CALL    FSTR0;  SET THE ACCUMULATOR
        XRA     B;       ACCUM SIGN AND 1ST FRCTN
 ;     SET CONTROL BITS AND EXIT
        MOV     B,A;       ACCUM SIGN AND 1ST FRACTION
        ORI     1;     SET SIGN BIT FOR EXIT
        MOV     A,E;       ACCUMULATOR EXPONENT
        RET     ;       RETURN TO CALLER
 ;     FLOATING POINT MUL SUBROUTINE ENT. PNT.
 FMUL:   MOV     A,M;       OPERAND EXPONENT
        ANA     A       ;       SET CONTROL BITS
        CNZ     MDEX;  READ OPERAND IF NOT ZERO
        JZ      FZERO;   IF ZERO OR UNDERFLOW
        JC      OVERF; IF OVERFLOW
        CALL    MULX;  CALL FIXED MULT SUBRTN
 ;     NORMALIZE IF NECESSARY.
        MOV     A,B;       1ST PRODUCT
        ANA     A       ;       SET CONTROL BITS
        JM      RNDA;  IF NO NORMALIZATION REQUIRED
        LXI     H,ACCE;  TO ADDR ACCUM EXPONENT
        MOV     A,M;       ACCUMULATOR EXPONENT
        SBI     1;     DECREMENT ACCUMULATOR EXPONENT
        MOV     M,A;       ACCUMULATOR EXPONENT
        RZ      ;       RETURN TO CALLER IF UNDERFLOW
        CALL    LSH;   CALL LEFT SHIFT SUBROUTINE
 ;     ROUND IF NECESSARY.
 RNDA:  CALL    ROND;  CALL ROUNDING SUBROUTINE
        JC      OVERF; IF OVERFLOW
        MOV     B,A;       ACCUM SIGN AND 1ST FRACTION
        ORI     1;     SET SIGN BIT
        MOV     A,E;       ACCUMULATOR EXPONENT
        RET     ;       RETURN TO CALLER
 ;     FLOATING POINT DIV SUBROUTINE ENT. PNT.
 FDIV:   XRA     A;       ZERO
        SUB     M;       COMPLEMENT OF DIVISOR EXPONENT
        CPI     1;     SET CARRY IF DIVISION BY ZERO
        CNC     MDEX;  READ OPERAND IF NOT ZERO
        JC      OVERF; IF OVERFLOW OR DIVISION BY ZERO
        JZ      FZERO;  IF UNDERFLOW OR ZERO
        MOV     C,A;       DIVISOR 1ST FRACTION
        CALL    DIVX;  CALL FIXED DIV SUBRTN
        JC      RNDA;  IF NO OVERFLOW
 ;     SET OVERFLOW FLAG.
 OVERF:	LXI	H,OVER;	TO ADDR OVERFLOW FLAG
        MVI     A,0FFH;  OVERFLOW FLAG
        MOV     M,A;       OVERFLOW FLAG
        RLC     ;       SET CARRY BIT FOR EXIT
        RET     ;       RETURN TO CALLER
        DB      0;     CHECK SUM WORD
 ;     FLOATING POINT SUB SUBROUTINE ENT. PNT.
 FSUB:    MVI     A,80H;  MASK TO CHANGE OP SIGN
        DB      0EH;  LBI INST TO SKIP NEXT WD
 ;     FLOATING POINT ADD SUBROUTINE ENT. PNT.
 FADD:    XRA     A;       ZERO
 ;     LOAD THE OPERAND.
        MOV     E,M;       OPERAND EXPONENT
        INR     L;       TO ADDR OP SIGN, 1ST FRCTN
        XRA     M;       OPERAND SIGN AND 1ST FRCTN
        MOV     B,A;       OPERAND SIGN AND 1ST FRCTN
        INR     L;       TO ADDR OPERAND 2ND
        MOV     C,M;       OPERAND 2ND FRACTION
        INR     L;       TO ADDR OPERAND 3RD FRCTN
        MOV     D,M;       OPERAND 3RD FRACTION
 ;     SAVE INITIAL EXPONENT.
	LXI	H,ACCE;	TO ADDR ACCUM EXPONENT
        MOV     A,M;       ACCUMULATOR EXPONENT
        DCR     L;       TO ADDR INITIAL EXPONENT
        MOV     M,A;       INITIAL EXPONENT
 ;     CHECK FOR ZERO OPERAND.
        MOV     A,E;       OPERAND EXPONENT
        ANA     A       ;       SET CONTROL BITS
        JZ      FTEST;  IF OPERAND IS ZERO
 ;     GENERATE SUBTRACTION FLAG, RESTORE
 ;     SUPPRESSED FRACTION BIT.
        MOV     L,B;       OPERAND SIGN AND 1ST FRCTN
        MOV     A,B;       OPERAND SIGN AND 1ST FRACTION
        ORI     80H;  OPERAND 1ST FRACTION
        MOV     B,A;       OPERAND 1ST FRACTION
        XRA     L;       OPERAND SIGN
        MVI     L,LOW(ACCS);  TO ADDRESS ACCUMULATOR SIGN
        XRA     M;       SUBTRACTION FLAG
        MVI     L,LOW(SF);    TO ADDRESS SUBTRACTION FLAG
        MOV     M,A;       SUBTRACTION FLAG
 ;     DETERMINE RELATIVE MAGNITUDES OF
 ;     OPERAND AND ACCUMULATOR.
        MVI     L,LOW(ACCE);  TO ADDRESS ACCUMULATOR EXPONENT
        MOV     A,M;       ACCUMULATOR EXPONENT
        ANA     A       ;       SET CONTROL BITS
        JZ      ADD17; IF ACCUMULATOR IS ZERO
        SUB     E;       DIFFERENCE IN EXPONENTS
        JC      ADD2;  IF ACCUM SMALLER THAN OP
 ;     CHECK FOR INSIGNIFICANT OPERAND.
        JM      FTEST;  IF THE OPERAND IS INSIGNIFICANT
        CPI     25;  COMPARE SHIFT COUNT TO 25
        JC      ADD3;  JOIN EXCH PATH IF OP SIGNIF
        JMP     FTEST;  OPERAND IS INSIGNIFICANT
 ;     CHECK FOR INSIGNIFICANT ACCUMULATOR
 ADD2:  JP      ADD17; IF ACCUM IS INSIGNIFICANT
        CPI     0E7H;  COMPARE SHIFT COUNT TO MINUS 25
        JC      ADD17; IF ACCUM IS INSIGNIFICANT
        MOV     M,E;       OPERAND EXPONENT
        MOV     E,A;       SHIFT COUNT
        LXI     H,SF;    TO ADDRESS THE SUBTRACTION FLAG
        MOV     A,M;       SUBTRACTION FLAG
        MVI     L,LOW(ACCS);  TO ADDRESS THE ACCUMULATOR SIGN
        XRA     M;       OPERAND SIGN
        MOV     M,A;       ACCUMULATOR SIGN
        XRA     A;       ZERO
        SUB     E;       COMPLEMENT SHIFT COUNT
 ;     EXCHANGE ACCUMULATOR AND OPERAND.
        INR     L;       TO ADDR ACCUM 1ST FRACTION
        MOV     E,M;       ACCUMULATOR 1ST FRACTION
        MOV     M,B;       OPERAND 1ST FRACTION
        MOV     B,E;       ACCUMULATOR 1ST FRACTION
        INR     L;       TO ADDR ACCUM 2ND FRACTION
        MOV     E,M;       ACCUMULATOR 2ND FRACTION
        MOV     M,C;       OPERAND 2ND FRACTION
        MOV     C,E;       ACCUMULATOR 2ND FRACTION
        INR     L;       TO ADDR ACCUM 3RD FRACTION
        MOV     E,M;       ACCUMULATOR 3RD FRACTION
        MOV     M,D;       OPERAND 3RD FRACTION
        MOV     D,E;       ACCUMULATOR 3RD FRACTION
 ;     POSITION THE OPERAND.
 ADD3:  CALL    RSH;   POSITION THE OPERAND
        LXI     H,SF;    TO ADDRESS SUBTRACTION FLAG
        MOV     A,M;       SUBTRACTION FLAG
        ANA     A       ;       SET CONTROL BITS
        MVI     L,LOW(ACC3);  TO ADDR ACCUM 3RD FRCTN
        JM      ADD9;  IF SUBTRACTION REQUIRED
 ;     ADD ADDEND TO AUGEND.
        MOV     A,M;       AUGEND 3RD FRACTION
        ADD     D;       ADDEND 3RD FRACTION
        MOV     D,A;       SUM 3RD FRACTION
        DCR     L;       TO ADDRESS AUGEND 2ND FRACTION
        MOV     A,M;       AUGEND 2ND FRACTION
        ADC     C;       ADDEND 2ND FRACTION
        MOV     C,A;       SUM 2ND FRACTION
        DCR     L;       TO ADDRESS AUGEND 1ST FRACTION
        MOV     A,M;       AUGEND 1ST FRACTION
        ADC     B;       ADDEND 1ST FRACTION
        MOV     B,A;       SUM 1ST FRACTION
        JNC     ADD11; IF NO CARRY FROM 1ST FRCTN
 ;     RIGHT SHIFT SUM TO NORMALIZED POSITION.
        RAR     ;       RIGHT SHIFT SUM 1ST FRACTION
        MOV     B,A;       SUM 1ST FRACTION
        MOV     A,C;       SUM 2ND FRACTION
        RAR     ;       RIGHT SHIFT SUM 2ND FRACTION
        MOV     C,A;       SUM 2ND FRACTION
        MOV     A,D;       SUM 3RD FRACTION
        RAR     ;       RIGHT SHIFT SUM 3RD FRACTION
        MOV     D,A;       SUM 3RD FRACTION
        RAR     ;       4TH FRCTN = LOW BIT OF 3RD
        MOV     E,A;       SUM 4TH FRACTION
        MVI     L,LOW(ACCE);  TO ADDRESS ACCUMULATOR EXPONENT
        MOV     A,M;       ACCUMULATOR EXPONENT
        ADI     1;     INCREMENT ACCUMULATOR EXPONENT
        JC      OVERF; IF OVERFLOW
        MOV     M,A;       ACCUMULATOR EXPONENT
        JMP     ADD11; TO ROUND FRACTION
 ;     SUBTRACT SUBTRAHEND FROM MINUEND.
 ADD9:  XRA     A;       MINUEND 4TH FRCTN IS ZERO
        SUB     E;       SUBTRAHEND 4TH FRACTION
        MOV     E,A;       DIFFERENCE 4TH FRACTION
        MOV     A,M;       MINUEND 3RD FRACTION
        SBB     D;       SUBTRAHEND 3RD FRACTION
        MOV     D,A;       DIFFERENCE 3RD FRACTION
        DCR     L;       TO ADDRESS MINUEND 2ND FRACTION
        MOV     A,M;       MINUEND 2ND FRACTION
        SBB     C;       SUBTRAHEND 2ND FRACTION
        MOV     C,A;       DIFFERENCE 2ND FRACTION
        DCR     L;       TO ADDRESS MINUEND 1ST FRACTION
        MOV     A,M;       MINUEND 1ST FRACTION
        SBB     B;       SUBTRAHEND 1ST FRACTION
        MOV     B,A;       DIFFERENCE 1ST FRACTION
 ADD10: CC      FCOMP;  COMPLEMENT IF NEGATIVE
        CP      NORM;  NORMALIZE IF NECESSARY
        JP      FZERO;  IF UNDERFLOW OR ZERO
 ADD11: CALL    ROND;  CALL ROUNDING SUBROUTINE
        JC      OVERF; IF OVERFLOW
 ADD12: MOV     B,A;       ACCUM SIGN AND 1ST FRCTN
        LXI     H,PREX;  TO ADDRESS PREV EXPONENT
        MOV     A,E;       ACCUMULATOR EXPONENT
        SUB     M;       DIFFERENCE IN EXPONENTS
        MOV     L,A;       DIFFERENCE IN EXPONENTS
        MOV     A,B;       ACCUM SIGN AND 1ST FRCTN
        ORI     1;     SET SIGN BIT FOR EXIT
        MOV     A,E;       ACCUMULATOR EXPONENT
        MOV     E,L;       SIGNIFICANCE INDEX
        RET     ;       RETURN TO CALLER
 ;     LOAD THE ACCUMULATOR WITH THE OPERAND.
 ADD17: LXI     H,SF;    TO ADDR SUBTRACTION FLAG
        MOV     A,M;       SUBTRACTION FLAG
        MVI     L,LOW(ACCS);  TO ADDR ACCUMULATOR SIGN
        XRA     M;       OPERAND SIGN
        DCR     L;       TO ADDR ACCUM EXPONENT
        CALL    FSTR0;  SET THE ACCUMULATOR
        XRA     B;       ACCUM SIGN AND 1ST FRCTN
        JMP     ADD12; JOIN EXIT CODE
        DB      0;     CHECK SUM WORD
 ;     SUBROUTINE TO READ THE OPERAND AND
 ;     CHECK THE ACCUMULATOR EXPONENT.
 MDEX:  MOV     B,A;       EXPONENT MODIFIER
        INR     L;       TO ADDR OP SIGN, 1ST FRCTN
        MOV     C,M;       OPERAND SIGN AND 1ST FRACTION
        INR     L;       TO ADDRESS OPERAND 2ND FRACTION
        MOV     D,M;       OPERAND 2ND FRACTION
        INR     L;       TO ADDRESS OPERAND 3RD FRACTION
        MOV     E,M;       OPERAND 3RD FRACTION
        LXI     H,ACCE;  TO ADDRESS ACCUMULATOR EXPONENT
        MOV     A,M;       ACCUMULATOR EXPONENT
        ANA     A       ;       SET CONTROL BITS
        RZ      ;       RETURN IF ACCUM IS ZERO
        ADD     B;       RESULT EXPONENT PLUS BIAS
        MOV     B,A;       RESULT EXPONENT PLUS BIAS
        RAR     ;       CARRY TO SIGN
        XRA     B;       CARRY AND SIGN MUST DIFFER
        MOV     A,B;       RESULT EXPONENT PLUS BIAS
        MVI     B,80H;  EXP BIAS, SIGN MASK, MS BIT
        JP      OVUN;  IF OVERFLOW OR UNDERFLOW
        SUB     B;       REMOVE EXCESS EXP BIAS
        RZ      ;       RETURN IF UNDERFLOW
        MOV     M,A;       RESULT EXPONENT
        INR     L;       TO ADDRESS ACCUMULATOR SIGN
        MOV     A,M;       ACCUMULATOR SIGN
        XRA     C;       RESULT SIGN IN SIGN BIT
        ANA     B       ;       RESULT SIGN
        MOV     M,A;       RESULT SIGN
        MOV     A,C;       OPERAND SIGN AND 1ST FRCTN
        ORA     B;       OPERAND 1ST FRACTION
        RET     ;       RETURN TO CALLER
 OVUN:  RLC     ;       SET CARRY BIT IF OVERFLOW
        RC      ;       RETURN IF OVERFLOW
        XRA     A;       ZERO
        RET     ;       RETURN IF UNDERFLOW
 ;     SUBROUTINE TO LEFT SHIFT THE B, C,
 ;     D, AND E REGISTERS ONE BIT.
 LSH:   MOV     A,E;       ORIGINAL CONTENTS OF E
        RAL     ;       LEFT SHIFT E
        MOV     E,A;       RESTORE CONTENTS OF E REGISTER
 LSH1:  MOV     A,D;       ORIGINAL CONTENTS OF D REGISTER
        RAL     ;       LEFT SHIFT D
        MOV     D,A;       RESTORE CONTENTS OF D REGISTER
        MOV     A,C;       ORIGINAL CONTENTS OF C REGISTER
        RAL     ;       LEFT SHIFT C
        MOV     C,A;       RESTORE CONTENTS OF C REGISTER
        MOV     A,B;       ORIGINAL CONTENTS OF B REGISTER
        ADC     A;       LEFT SHIFT B
        MOV     B,A;       RESTORE CONTENTS OF B REGISTER
        RET     ;       RETURN TO CALLER
 ;     RIGHT SHIFT THE B, C, D AND E REGISTERS
 ;     BY THE SHIFT COUNT IN THE A REGISTER
 ;     SHIFT OPERAND TO REGISTER INDICATED BY
 ;     SHIFT COUNT
 RSH:   MVI     E,0;     OPERAND 4TH FRCTN IS ZERO
 RSH0:  MVI     L,8;  EACH REG IS 8 BITS OF SHIFT
 RSH1:  CMP     L;       COMPARE SHIFT COUNT TO 8
        JM      RSH2;  IF REQ SHIFT LESS THAN 8
        MOV     E,D;       OPERAND 4TH FRACTION
        MOV     D,C;       OPERAND 3RD FRACTION
        MOV     C,B;       OPERAND 2ND FRACTION
        MVI     B,0;     OPERAND 1ST FRACTION IS ZERO
        SUB     L;       REDUCE SHIFT COUNT BY 1 REG
        JNZ     RSH1;  IF MORE SHIFTS REQUIRED
 ;     SHIFT OPERAND RIGHT BY -SHIFT COUNT-
 ;     BITS.
 RSH2:  ANA     A       ;       SET CONTROL BITS
        RZ      ;       RETURN IF SHIFT COMPLETE
        MOV     L,A;       SHIFT COUNT
 RSH3:  ANA     A       ;       CLEAR CARRY BIT
        MOV     A,B;       OPERAND 1ST FRACTION
        RAR     ;       RIGHT SHIFT OP 1ST FRCTN
        MOV     B,A;       OPERAND 1ST FRACTION
        MOV     A,C;       OPERAND 2ND FRACTION
        RAR     ;       RIGHT SHIFT OP 2ND FRCTN
        MOV     C,A;       OPERAND 2ND FRACTION
        MOV     A,D;       OPERAND 3RD FRACTION
        RAR     ;       RIGHT SHIFT OP 3RD FRCTN
        MOV     D,A;       OPERAND 3RD FRACTION
        MOV     A,E;       OPERAND 4TH FRACTION
        RAR     ;       RIGHT SHIFT OP 4TH FRCTN
        MOV     E,A;       OPERAND 4TH FRACTION
        DCR     L;       DECREMENT SHIFT COUNT
        JNZ     RSH3;  IF MORE SHIFTS REQUIRED
        RET     ;       RETURN TO CALLER
 ;     COMPLEMENT THE B, C, D, AND E REGISTERS.
 FCOMP:  DCR     L;       TO ADDR ACCUM SIGN
        MOV     A,M;       ACCUMULATOR SIGN
        XRI     80H;  CHANGE SIGN
        MOV     M,A;       ACCUMULATOR SIGN
 COMP1: XRA     A;       ZERO
        MOV     L,A;       ZERO
        SUB     E;       COMPLEMENT 4TH FRCTN
        MOV     E,A;       4TH FRACTION
        MOV     A,L;       ZERO
        SBB     D;       COMPLEMENT 3RD FRCTN
        MOV     D,A;       3RD FRACTION
        MOV     A,L;       ZERO
        SBB     C;       COMPLEMENT 2ND FRCTN
        MOV     C,A;       2ND FRACTION
        MOV     A,L;       ZERO
        SBB     B;       COMPLEMENT 1ST FRCTN
        MOV     B,A;       1ST FRACTION
        RET     ;       RETURN TO CALLER
 ;     NORMALIZE THE REGISTERS.
 NORM:  MVI     L,20H;  MAX NORMALIZING SHIFT
 NORM1: MOV     A,B;       1ST FRACTION
        ANA     A       ;       SET CONTROL BITS
        JNZ     NORM3; IF 1ST FRACTION NONZERO
        MOV     B,C;       1ST FRACTION
        MOV     C,D;       2ND FRACTION
        MOV     D,E;       3RD FRACTION
        MOV     E,A;       ZERO 4TH FRACTION
        MOV     A,L;       NORMALIZING SHIFT COUNT
        SUI     8;  REDUCE SHIFT COUNT
        MOV     L,A;       NORMALIZING SHIFT COUNT
        JNZ     NORM1; IF FRACTION NONZERO
        RET     ;       IF FRACTION IS ZERO
 NORM2: DCR     L;       DECREMENT SHIFT COUNT
        MOV     A,E;       ORIGINAL CONTENTS OF E
        RAL     ;       LEFT SHIFT E
        MOV     E,A;       RESTORE CONTENTS OF E REGISTER
        MOV     A,D;       ORIGINAL CONTENTS OF D REGISTER
        RAL     ;       LEFT SHIFT D
        MOV     D,A;       RESTORE CONTENTS OF D REGISTER
        MOV     A,C;       ORIGINAL CONTENTS OF C REGISTER
        RAL     ;       LEFT SHIFT C
        MOV     C,A;       RESTORE CONTENTS OF C REGISTER
        MOV     A,B;       ORIGINAL CONTENTS OF B REGISTER
        ADC     A;       LEFT SHIFT B
        MOV     B,A;       RESTORE CONTENTS OF B REGISTER
 NORM3: JP      NORM2; IF NOT NORMALIZED
        MOV     A,L;       NORMALIZING SHIFT COUNT
        SUI     20H;  REMOVE BIAS
        LXI     H,ACCE;  TO ADDR ACCUM EXPONENT
        ADD     M;       ADJUST ACCUM EXPONENT
        MOV     M,A;       NEW ACCUM EXPONENT
        RZ      ;       RETURN IF ZERO EXP
        RAR     ;       BORROW BIT TO SIGN
        ANA     A       ;       SET SIGN TO IND. UNDERFLOW
        RET     ;       RETURN TO CALLER
 ;     SUBROUTINE TO ROUND THE B, C, D REGISTERS.
 ROND:  LXI     H,ACCE;  TO ADDR ACCUM EXPONENT
        MOV     A,E;       4TH FRACTION
        ANA     A       ;       SET CONTROL BITS
        MOV     E,M;       ACCUMULATOR EXPONENT
        CM      RNDR;  CALL 2ND LEVEL ROUNDER
        RC      ;       IF OVERFLOW
        MOV     A,B;       1ST FRACTION
        INR     L;       TO ADDR ACCUM SIGN
        XRA     M;       ACCUM SIGN AND 1ST FRCTN
        JMP     STR1;  RETURN THRU STORE SUBR.
 ;     SECOND LEVEL ROUNDING SUBROUTINE.
 RNDR:  INR     D;       ROUND 3RD FRACTION
        RNZ     ;       RETURN IF NO CARRY
        INR     C;       CARRY TO 2ND FRACTION
        RNZ     ;       RETURN IF NO CARRY
        INR     B;       CARRY TO 1ST FRACTION
        RNZ     ;       RETURN IF NO CARRY
        MOV     A,E;       ACCUMULATOR EXPONENT
        ADI     1;     INCREMENT ACCUM EXPONENT
        MOV     E,A;       NEW ACCUM EXPONENT
        MVI     B,80H;  NEW 1ST FRACTION
        MOV     M,A;       NEW ACCUM EXPONENT
        RET     ;       RETURN TO ROND SUBROUTINE
 ;     FIXED POINT MULTIPLY SUBROUTINE.
 MULX:  LXI     H,MULP1+1; TO ADDR 1ST MULTIPLICAND
        MOV     M,A;       1ST MULTIPLICAND
        LXI     H,MULP2+1; TO ADDR 2ND MULTIPLICAND
        MOV     M,D;       2ND MULTIPLICAND
        LXI     H,MULP3+1; TO ADDR 3RD MULTIPLICAND
        MOV     M,E;       3RD MULTIPLICAND
        XRA     A;       CLEAR 6TH PRODUCT
        MOV     E,A;       CLEAR 5TH PRODUCT
        MOV     D,A;       CLEAR 4TH PRODUCT
 ;     MULTIPLY BY EACH ACCUMULATOR
 ;     FRACTION IN TURN.
        LXI     H,ACC3;  TO ADDRESS 3RD FRCTN
        CALL    MULX2; MULTIPLY BY ACCUM 3RD FRCTN
        MVI     L,LOW(ACC2);  TO ADDRESS 2ND FRCTN
        CALL    MULX1; MULTIPLY BY ACCUM 2ND FRCTN
        MVI     L,LOW(ACC1);  TO ADDRESS 1ST FRCTN
 ;     MULTIPLY BY ONE ACCUMULATOR WORD.
 MULX1: MOV     A,D;       5TH PARTIAL PRODUCT
        MOV     E,C;       4TH PARTIAL PRODUCT
        MOV     D,B;       3RD PARTIAL PRODUCT
 MULX2: MOV     B,M;       MULTIPLIER
        MOV     L,A;       5TH PARTIAL PRODUCT
        XRA     A;       ZERO
        MOV     C,A;       2ND PARTIAL PRODUCT
        SUB     B;       SET CARRY BIT FOR EXIT FLAG
        JC      MULX3; IF MULTIPLIER IS NOT ZERO
        MOV     C,D;       2ND PARTIAL PRODUCT
        MOV     D,E;       3RD PARTIAL PRODUCT
        RET     ;       MULT BY ZERO COMPLETE
 ;     COMPLETE ADDITION OF MULTIPLICAND.
 MULX5: MOV     C,A;       2ND PARTIAL PRODUCT
        JNC     MULX3; IF NO CARRY TO 1ST PRODUCT
        INR     B;       ADD CARRY TO 1ST PRODUCT
        ANA     A       ;       CLEAR CARRY BIT
 ;     LOOP FOR EACH BIT OF MULTIPLIER WORD.
 MULX3: MOV     A,L;       5TH PART PRODUCT, EXIT FLAG
        ADC     A;       SHIFT EXIT FLAG OUT IF DONE
        RZ      ;       EXIT IF MULTIPLICATION DONE
        MOV     L,A;       5TH PART PRODUCT, EXIT FLAG
        MOV     A,E;       4TH PARTIAL PRODUCT
        RAL     ;       SHIFT 4TH PARTIAL PRODUCT
        MOV     E,A;       4TH PARTIAL PRODUCT
        MOV     A,D;       3RD PARTIAL PRODUCT
        RAL     ;       SHIFT 3RD PARTIAL PRODUCT
        MOV     D,A;       3RD PARTIAL PRODUCT
        MOV     A,C;       2ND PARTIAL PRODUCT
        RAL     ;       SHIFT 2ND PARTIAL PRODUCT
        MOV     C,A;       2ND PARTIAL PRODUCT
        MOV     A,B;       1ST PART PROD AND MULTPLIER
        RAL     ;       SHIFT 1ST PROD AND MULTIPLIER
        MOV     B,A;       1ST PART PROD AND MULTIPLIER
        JNC     MULX3; IF NO ADDITION REQUIRED
 ;     ADD THE MULTIPLICAND TO THE PRODUCT
 ;     IF THE MULTIPLIER BIT IS ONE.
        MOV     A,E;       4TH PARTIAL PRODUCT

;  THE FOLLOWING CODE WAS MOVED FROM THE BEGINNING
;  OF THE PROGRAM TO THIS LOCATION TO MAKE THINGS
;  A LITTLE EASIER...

MULX4:
MULP3:
	ADI	0;	ADD OPERAND 3RD FRACTION
	MOV	E,A;	4TH PARTIAL PRODUCT
	MOV	A,D;	3RD PARTIAL PRODUCT
MULP2:
	ACI	0;	ADD OPERAND 2ND FRACTION
	MOV	D,A;	3RD PARTIAL PRODUCT
	MOV	A,C;	2ND PARTIAL PRODUCT
MULP1:
	ACI	0;	ADD OPERAND 1ST FRACTION

	JMP	MULX5
 ;     FIXED POINT DIVIDE SUBROUTINE.
 ;     SUBTRACT DIVISOR FROM ACCUMULATOR TO
 ;     OBTAIN 1ST REMAINDER.
 DIVX:  LXI     H,ACC3;  TO ADDRESS ACCUM 3RD FRCTN
        MOV     A,M;       ACCUMULATOR 3RD FRACTION
        SUB     E;       DIVISOR 3RD FRACTION
        MOV     M,A;       REMAINDER 3RD FRACTION
        DCR     L;       TO ADDRESS ACCUM 2ND FRCTN
        MOV     A,M;       ACCUMULATOR 2ND FRACTION
        SBB     D;       DIVISOR 2ND FRACTION
        MOV     M,A;       REMAINDER 2ND FRACTION
        DCR     L;       TO ADDRESS ACCUM 1ST FRCTN
        MOV     A,M;       ACCUMULATOR 1ST FRACTION
        SBB     C;       DIVISOR 1ST FRACTION
        MOV     M,A;       REMAINDER 1ST FRACTION
 ;     HALVE THE DIVISOR AND STORE FOR
 ;     ADDITION OR SUBTRACTION.
        MOV     A,C;       DIVISOR 1ST FRACTION
        RAL     ;       SET CARRY BIT
        MOV     A,C;       DIVISOR 1ST FRACTION
        RAR     ;       HALF OF DIVISOR 1ST FRCTN
 ;               + 80H TO CORRECT QUOTIENT
        LXI     H,OP1S+1;  TO ADDRESS 1ST SUBTRACT DIVISOR
        MOV     M,A;       1ST SUBTRACT DIVISOR
        LXI     H,OP1A+1;  TO ADDRESS 1ST ADD DIVISOR
        MOV     M,A;       1ST ADD DIVISOR
        MOV     A,D;       DIVISOR 2ND FRACTION
        RAR     ;       HALF OF DIVISOR 2ND FRACTION
        LXI     H,OP2S+1;  TO ADDRESS 2ND SUBTRACT DIVISOR
        MOV     M,A;       2ND SUBTRACT DIVISOR
        LXI     H,OP2A+1;  TO ADDRESS 2ND ADD DIVISOR
        MOV     M,A;       2ND ADD DIVISOR
        MOV     A,E;       DIVISOR 3RD FRACTION
        RAR     ;       HALF OF DIVISOR 3RD FRACTION
        LXI     H,OP3S+1;  TO ADDRESS 3RD SUBTRACT DIVISOR
        MOV     M,A;       3RD SUBTRACT DIVISOR
        LXI     H,OP3A+1;  TO ADDRESS 3RD ADD DIVISOR
        MOV     M,A;       3RD ADD DIVISOR
        MVI     B,0;     INIT QUOTIENT 1ST FRCTN
        MOV     A,B;       DIVISOR FOURTH FRACTION IS ZERO
        RAR     ;       LOW BIT OF DIVISOR 3RD FRACTION
        LXI     H,OP4S+1;  TO ADDRESS 4TH SUBTRACT DIVISOR
        MOV     M,A;       4TH SUBTRACT DIVISOR
        LXI     H,OP4A+1;  TO ADDRESS 4TH ADD DIVISOR
        MOV     M,A;       4TH ADD DIVISOR
        LXI     H,OP4X+1;  TO ADDRESS 4TH ADD DIVISOR
        MOV     M,A;       4TH ADD DIVISOR
 ;     LOAD 1ST REMAINDER, CHECK SIGN.
        LXI     H,ACC1;  TO ADDR REMAINDER 1ST FRCTN
        MOV     A,M;       REMAINDER 1ST FRACTION
        INR     L;       TO ADDR REMAINDER 2ND FRCTN
        MOV     D,M;       REMAINDER 2ND FRACTION
        INR     L;       TO ADDR REMAINDER 3RD FRCTN
        MOV     E,M;       REMAINDER 3RD FRACTION
        ANA     A       ;       SET CONTROL BITS
        JM      DIVX4; IF REMAINDER IS NEGATIVE
 ;     ADJUST EXPONENT,POSITION REMAINDER
 ;     AND INITIALIZE THE QUOTIENT.
        MVI     L,LOW(ACCE);  TO ADDRESS ACCUMULATOR EXPONENT
        MOV     C,M;       QUOTIENT EXPONENT
        INR     C;       INCREMENT QUOTIENT EXPONENT
        RZ      ;       RETURN IF OVERFLOW
        MOV     M,C;       QUOTIENT EXPONENT
        MOV     L,E;       REMAINDER 3RD FRACTION
        MOV     H,D;       REMAINDER 2ND FRACTION
        MOV     E,A;       REMAINDER 1ST FRACTION
        MVI     D,1;     INITIALIZE QUOT 3RD FRCTN
        MOV     C,B;       INITIALIZE QUOT 2ND FRCTN
 ;     SUBTRACT THE DIVISOR FROM THE REMAINDER
 ;     IF IT IS POSITIVE
 DIVX1: XRA     A;       REMAINDER 4TH FRCTN IS ZERO
        CALL    DIVX5;
 DIVX2: RLC     ;       SHFT REM 4TH FRCTN TO CY
 ;     SHIFT THE REMAINDER LEFT ONE BIT.
        MOV     A,B;       QUOTIENT 1ST FRACTION
        RAL     ;       MS BIT OF QUOTIENT TO CY
        RC      ;       IF DIVISION COMPLETE
        RAR     ;       REMAINDER 4TH FRCTN TO CY
        MOV     A,L;       REMAINDER 3RD FRACTION
        RAL     ;       LEFT SHIFT REM 3RD FRCTN
        MOV     L,A;       REMAINDER 3RD FRACTION
        MOV     A,H;       REMAINDER 2ND FRACTION
        RAL     ;       LEFT SHIFT REM 2ND FRCTN
        MOV     H,A;       REMAINDER 2ND FRACTION
        CALL    LSH;   CALL LEFT SHIFT SUBROUTINE
 ;     BRANCH IF SUBTRACTION IS REQUIRED
        MOV     A,D;       QUOTIENT 3RD FRACTION
        RRC     ;       REM SIGN INDIC TO CARRY BIT
        JC      DIVX1; TO SUB DIVISOR IF REM POS
 ;     ADD THE DIVISOR IF THE REMAINDER
 ;     IS NEGATIVE.
 DIVX3: MOV     A,L;       REMAINDER 3RD FRACTION
        JMP     DIVX6;
 ;     POSITION THE REMAINDER AND INITIALIZE
 ;     THE QUOTIENT.
 DIVX4: MOV     L,E;       REMAINDER 3RD FRACTION
        MOV     H,D;       REMAINDER 2ND FRACTION
        MOV     E,A;       REMAINDER 1ST FRACTION
        MOV     D,B;       INITIALIZE QUOT 3RD FRCTN
        MOV     C,B;       INITIALIZE QUOT 2ND FRCTN
        JMP     DIVX3; ADD DIVISOR IF REM IS NEG
;  ORIGINALLY, THIS CODE WAS AT THE BEGINNING
;  OF THE PROGRAM...

DIVX5:
OP4S:
	SUI	0;	SUB DIVISOR 4TH FRACTION
	MOV	A,L;	REM 3RD FRACTION
OP3S:
	SBI	0;	SUB DIVISOR 3RD FRACTION
	MOV	L,A;	REM 3RD FRACTION
	MOV	A,H;	REM 2ND FRACTION
OP2S:
	SBI	0;	SUB DIVISOR 2ND FRACTION
	MOV	H,A;	REM 2ND FRACTION
	MOV	A,E;	REM 1ST FRACTION
OP1S:
	SBI	0;	SUB DIVISOR 1ST FRACTION
	MOV	E,A;	REM 1ST FRACTION
OP4A:
	MVI	A,0;	REM 4TH FRACTION
	RET

DIVX6:
OP3A:
	ADI	0;	ADD DIVISOR 3RD FRACTION
	MOV	L,A;	REM 3RD FRACTION
	MOV	A,H;	REM 2ND FRACTION
OP2A:
	ACI	0;	ADD DIVISOR 2ND FRACTION
	MOV	H,A;	REM 2ND FRACTION
	MOV	A,E;	REM 1ST FRACTION
OP1A:
	ACI	0;	ADD DIVISOR 1ST FRACTION
	MOV	E,A;	REM 1ST FRACTION
OP4X:
	MVI	A,0;	REM 4TH FRACTION

	JMP	DIVX2

        END     
