;FMATH 06/09/80
;XYBASIC Interpreter Source Module
;Copyright (C) 1978, 1979, 1980 by Mark Williams Company, Chicago
;floating point math package


	if	float and (not f9511) and (not fpbcd)

;The floating point (FP) math package operates on normalized floating
;binary point numbers stored in four consecutive bytes of memory.
;Byte 1			Binary exponent E
;Byte 2 bit 7		Sign S
;Byte 2 bits 6-0	Mantissa msb M1
;Byte 3			Mantissa 2sb M2
;Byte 4			Mantissa lsb M3
;If E is 0, the value is 0 and bytes 2-4 are meaningless;  otherwise
;E represents the binary exponent with a bias of 80H.
;The sign bit S is 0 for positive, 1 for negative.
;The complete mantissa is M1-M3 with a hidden 1 replacing S in M1 bit 7
;and the binary point located left of M1.  Thus a nonzero value is
; S * [2^(E-80H)] * [(80H+M1) * (2^-8)] * [M2 * (2^-16)] * [M3 * (2^-24)].

;The floating point accumulator (FACC) contains a floating point value
;unpacked into five consecutive bytes of RAM starting at ACCE.
;Byte 1 (ACCE)		Exponent E, biased as above
;Byte 2 (ACCS)		Sign, 0 if negative and 80H if positive
;Bytes 3-5 (ACC1-ACC3)	Mantissa with hidden 1 restored in ACC1

;FLOATING POINT STORE
FSTR0:	MOV  M,E	;STORE ZEROETH WORD
	INX  H		;TO ADDR THE 1ST WORD
FSTOR:	MOV  M,A	;STORE 1ST WORD
FSTR1:	INX  H		;TO ADDR THE 2ND WORD
	MOV  M,B	;STORE 2ND WORD
	INX  H		;TO ADDR THE 3RD WORD
	MOV  M,C	;STORE 3RD WORD
	INX  H		;TO ADDR THE 4TH WORD
	MOV  M,D	;STORE 4TH WORD
	RET		;RETURN TO CALLER

;FLOATING POINT ZERO
FZRO:	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	XRA  A		;ZERO
	MOV  M,A	;CLEAR ACC EXPONENT
	RET		;RETURN TO CALLER

;FLOATING POINT CHANGE SIGN
FCHS:	MVI  A,80H	;MASK TO CHANGE ACC SIGN BIT
	DB   6		;THIS MVI A, SAVES A JUMP
			;AND CONTINUE AS IN FABS

;FLOATING POINT ABSOLUTE VALUE
FABS:	XRA  A		;NB MUST BE 1-BYTE INSTRUCTION
	LXI  H,ACCS	;TO ADDR THE ACC SIGN
	ANA  M		;COMPLIMENT OF SIGN
	XRI  80H	;COMPLIMENT THE SIGN BIT
	MOV  M,A	;ACC SIGN

;FLOATING POINT TEST
FTEST:	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	ANA  A		;SET CONTROL BITS
	JZ   FZRO	;IF ACC IS ZERO
	MOV  E,A	;ACC EXPONENT
	INX  H		;TO ADDR THE ACC SIGN
	MOV  A,M	;ACC SIGN
	INX  H		;TO ADDR THE ACC 1ST FRACTION
	XRA  M		;ACC SIGN AND 1ST FRACTION
	INX  H		;TO ADDR THE ACC 2ND FRACTION
	MOV  C,M	;ACC 2ND FRACTION
	INX  H		;TO ADDR THE ACC 3RD FRACTION
	MOV  D,M	;ACC 3RD FRACTION
	JMP  FADD8	;TO SET EXIT CONDITIONS

;FLOATING POINT LOAD
FLOAD:	MOV  A,M	;OPERAND EXPONENT
	ANA  A		;SET CONTROL BITS
	JZ   FZRO	;IF OPERAND IS ZERO
	MOV  E,A	;OPERAND EXPONENT
	INX  H		;TO ADDR THE OPERAND SIGN AND 1ST FRACTION
	MOV  A,M	;OPERAND SIGN AND 1ST FRACTION
	INX  H		;TO ADDR THE OPERAND 2ND FRACTION
	MOV  C,M	;OPERAND 2ND FRACTION
	INX  H		;TO ADDR THE OPERAND 3RD FRACTION
	MOV  D,M	;OPERAND 3RD FRACTION

;STORE THE OPERAND IN THE ACCUMULATOR
	MOV  L,A	;OPERAND SIGN AND 1ST FRACTION
	ORI  80H	;ACC 1ST FRACTION
	MOV  B,A	;ACC 1ST FRACTION
	XRA  L		;ACC SIGN
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	CALL FSTR0	;SET THE ACC
	XRA  B		;ACC SIGN AND 1ST FRACTION

; SET CONTROL BITS AND EXIT

	MOV  B,A	;ACC SIGN AND 1ST FRACTION
	ORI  01		;SET SIGN BIT FOR EXIT
	MOV  A,E	;ACC EXPONENT
	RET		;RETURN TO CALLER

;FLOATING POINT MULTIPLY
FMUL:	MOV  A,M	;OPERAND EXPONENT
	ANA  A		;SET CONTROL BITS
	CNZ  MDEX	;READ OPERAND IF NOT ZERO
	JZ   FZRO	;IF ZERO OR UNDERFLOW
	JC   FOVER	;IF OVERFLOW
	CALL MULX	;FIXED POINT MULTIPLY 

;NORMALIZE IF NECESSARY
	MOV  A,B	;1ST PRODUCT
	ANA  A		;SET CONTROL BITS
	JM   RNDA	;IF NO NORMALIZATION REQUIRED
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	SBI  01		;DECREMENT ACC EXPONENT
	MOV  M,A	;ACC EXPONENT
	RZ		;RETURN TO CALLER IF UNDERFLOW
	CALL LSH	;LEFT SHIFT SUBROUTINE

;ROUND IF NECESSARY
RNDA:	CALL ROND	;ROUNDING SUBROUTINE
	JC   FOVER	;IF OVERFLOW
	MOV  B,A	;ACC SIGN AND 1ST FRACTION
	ORI  01		;SET SIGN BIT
	MOV  A,E	;ACC EXPONENT
	RET		;RETURN TO CALLER

;FLOATING POINT DIVIDE
FDIVD:	XCHG		;XYBASIC ENTRY POINT
	INX	H
FDIV:	XRA  A		;ZERO
	SUB  M		;COMPLEMENT OF DIVISOR EXPONENT
	CPI  01		;SET CARRY IF DIVISION BY ZERO
	CNC  MDEX	;READ OPERAND IF NOT ZERO
	JC   FOVER	;IF OVERFLOW OR DIVISION BY ZERO
	JZ   FZRO	;IF UNDERFLOW OR ZERO
	MOV  C,A	;DIVISOR 1ST FRACTION
	CALL DIVX	;FIXED POINT DIVIDE
	JC   RNDA	;IF NO OVERFLOW
;FLOATING OVERFLOW -- ISSUE NONFATAL OV ERROR AND RETURN MAX VALUE
FOVER:	ERROR N, O, V	;ISSUE NONFATAL OV ERROR
	LXI  H,FPMAX	;MAX POSITIVE FP VALUE
	JMP  FLOAD	;TO ACC AND RETURN

;FLOATING POINT SUBTRACT
FSUB:	MVI  A,80H	;MASK TO CHANGE OPERAND SIGN
	DB   6		;THIS MVI B, SAVES A JUMP
			;CONTINUE AS IN FADD

;FLOATING POINT ADD
FADD:	XRA  A		;NB MUST BE 1-BYTE INSTRUCTION
;LOAD THE OPERAND
	MOV  E,M	;OPERAND EXPONENT
	INX  H		;TO ADDR THE OPERAND SIGN, 1ST FRACTION
	XRA  M		;OPERAND SIGN AND 1ST FRACTION
	MOV  B,A	;OPERAND SIGN AND 1ST FRACTION
	INX  H		;TO ADDR THE OPERAND 2ND FRACTION
	MOV  C,M	;OPERAND 2ND FRACTION
	INX  H		;TO ADDR THE OPERAND 3RD FRACTION
	MOV  D,M	;OPERAND 3RD FRACTION

;SAVE INITIAL EXPONENT
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	DCX  H		;TO ADDR THE 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 SUBTRACT FLAG AND RESTORE SUPPRESSED FRACTION BIT
	MOV  L,B	;OPERAND SIGN AND 1ST FRACTION
	MOV  A,B	;OPERAND SIGN AND 1ST FRACTION
	ORI  80H	;OPERAND 1ST FRACTION
	MOV  B,A	;OPERAND 1ST FRACTION
	XRA  L		;OPERAND SIGN
	LXI  H,ACCS	;TO ADDR THE ACC SIGN
	XRA  M		;SUBTRACTION FLAG
	STA  SFLAG	;SUBTRACTION FLAG

;DETERMINE RELATIVE MAGNITUDES OF OPERAND AND ACCUMULATOR
	DCX  H		;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	ANA  A		;SET CONTROL BITS
	JZ   FADD9	;IF ACC IS ZERO
	SUB  E		;DIFFERENCE OF EXPONENTS
	JC   FADD2	;IF ACC SMALLER THAN OPERAND

;CHECK FOR INSIGNIFICANT OPERAND
	JM   FTEST	;IF OPERAND IS INSIGNIFICANT
	CPI  19H	;COMPARE SHIFT COUNT TO 25
	JC   FADD3	;POSITION THE OPERAND
	JMP  FTEST	;OPERAND IS INSIGNIFICANT

;CHECK FOR INSIGNIFICANT ACCUMULATOR
FADD2:	JP   FADD9	;IF ACC IS INSIGNIFICANT
	CPI  0E7H	;COMPARE SHIFT COUNT TO -25
	JC   FADD9	;IF ACC IS INSIGNIFICANT
	MOV  M,E	;OPERAND EXPONENT
	MOV  E,A	;SHIFT COUNT
	LDA  SFLAG	;SUBTRACT FLAG
	LXI  H,ACCS	;TO ADDR THE ACC SIGN
	XRA  M		;OPERAND SIGN
	MOV  M,A	;ACC SIGN
	XRA  A		;ZERO
	SUB  E		;COMPLIMENT SHIFT COUNT

;EXCHANGE ACCUMULATOR AND OPERAND
	INX  H		;TO ADDR THE ACC 1ST FRACTION
	MOV  E,M	;ACC 1ST FRACTION
	MOV  M,B	;OPERAND 1ST FRACTION
	MOV  B,E	;ACC 1ST FRACTION
	INX  H		;TO ADDR THE ACC 2ND FRACTION
	MOV  E,M	;ACC 2ND FRACTION
	MOV  M,C	;OPERAND 2ND FRACTION
	MOV  C,E	;ACC 2ND FRACTION
	INX  H		;TO ADDR THE ACC 3RD FRACTION
	MOV  E,M	;ACC 3RD FRACTION
	MOV  M,D	;OPERAND 3RD FRACTION
	MOV  D,E	;ACC 3RD FRACTION

;POSITION THE OPERAND
FADD3:	CALL RSH	;POSITION THE OPERAND
	LDA  SFLAG	;SUBTRACT FLAG
	ANA  A		;SET CONTROL BITS
	LXI  H,ACC3	;TO ADDR THE ACC 3RD FRACTION
	JM   FADD5	;IF SUBTRACT REQUIRED

;ADD ADDEND TO AUGEND
FADD4:	MOV  A,M	;AUGEND 3RD FRACTION
	ADD  D		;ADDEND 3RD FRACTION
	MOV  D,A	;SUM 3RD FRACTION
	DCX  H		;TO ADDR THE AUGEND 2ND FRACTION
	MOV  A,M	;AUGEND 2ND FRACTION
	ADC  C		;ADDEND 2ND FRACTION
	MOV  C,A	;SUM 2ND FRACTION
	DCX  H		;TO ADDR THE AUGEND 1ST FRACTION
	MOV  A,M	;AUGEND 1ST FRACTION
	ADC  B		;ADDEND 1ST FRACTION
	MOV  B,A	;SUM 1ST FRACTION
	JNC  FADD7	;IF NO CARRY FROM 1ST FRACTION

;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 FRACTION = LOW BIT OF 3RD
	MOV  E,A	;SUM 4TH FRACTION
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	ADI  1		;INCREMENT THE ACC EXPONENT
	JC   FOVER	;IF OVERFLOW
	MOV  M,A	;ACC EXPONENT
	JMP  FADD7	;TO ROUND FRACTION

;SUBTRACT SUBTRAHEND FROM MINUEND
FADD5:	XRA  A		;MINUEND 4TH FRACTION 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
	DCX  H		;TO ADDR THE MINUEND 2ND FRACTION
	MOV  A,M	;MINUEND 2ND FRACTION
	SBB  C		;SUBTRAHEND 2ND FRACTION
	MOV  C,A	;DIFFERENCE 2ND FRACTION
	DCX  H		;TO ADDR THE MINUEND 1ST FRACTION
	MOV  A,M	;MINUEND 1ST FRACTION
	SBB  B		;SUBTRAHEND 1ST FRACTION
	MOV  B,A	;DIFFERENCE 1ST FRACTION
FADD6:	CC   COMP	;COMPLIMENT IF NEGATIVE
	CP   NORM	;NORMALIZE IF NECESSARY
	JP   FZRO	;IF UNDERFLOW OR ZERO
FADD7:	CALL ROND	;ROUNDING
	JC   FOVER	;IF OVERFLOW
FADD8:	MOV  B,A	;ACC SIGN AND 1ST FRACTION
	LXI  H,PREX	;TO ADDR THE PREVIOUS EXPONENT
	MOV  A,E	;ACC EXPONENT
	SUB  M		;DIFFERENCE THE EXPONENTS
	MOV  L,A	;DIFFERENCE IN EXPONENTS
	MOV  A,B	;ACC SIGN AND 1ST FRACTION
	ORI  1		;SET SIGN BIT FOR EXIT
	MOV  A,E	;ACC EXPONENT
	MOV  E,L	;SIGNIFICANCE INDEX
	RET		;RETURN TO CALLER

;LOAD THE ACCUMULATOR WITH THE OPERAND
FADD9:	LDA  SFLAG	;SUBTRACTION FLAG
	LXI  H,ACCS	;TO ADDR THE ACC SIGN
	XRA  M		;OPERAND SIGN
	DCX  H		;TO ADDR THE ACC EXPONENT
	CALL FSTR0	;SET THE ACC
	XRA  B		;ACC SIGN AND 1ST FRACTION
	JMP  FADD8	;JOIN EXIT CODE

;READ THE OPERAND AND CHECK THE ACCUMULATOR EXPONENT
MDEX:	MOV  B,A	;EXPONENT MODIFIER
	INX  H		;TO ADDR THE OPERAND SIGN AND 1ST FRACTION
	MOV  C,M	;OPERAND SIGN AND 1ST FRACTION
	INX  H		;TO ADDR OPERAND 2ND FRACTION
	MOV  D,M	;OPERAND 2ND FRACTION
	INX  H		;TO ADDR OPERAND 3RD FRACTION
	MOV  E,M	;OPERAND 3RD FRACTION
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	ANA  A		;SET CONTROL BITS
	RZ		;RETURN IF ACC IS ZERO
	ADD  B		;RESULT EXPONENT PLUS BIAS
	MOV  B,A	;RESULT EXPONENT PLUS BIAS
	RAR		;CARRY TO SIGN BIT
	XRA  B		;CARRY AND SIGN MUST DIFFER
	MOV  A,B	;RESULT EXPONENT PLUS BIAS
	MVI  B,80H	;EXPONENT BIAS, SIGN MASK, MSB
	JP   OVUN	;IF OVERFLOW OR UNDERFLOW
	SUB  B		;REMOVE EXCESS EXPONENT BIAS
	RZ		;RETURN IF UNDERFLOW
	MOV  M,A	;RESULT EXPONENT
	INX  H		;TO ADDR THE ACC SIGN
	MOV  A,M	;ACC SIGN
	XRA  C		;RESULT SIGN IN SIGN BIT
	ANA  B		;RESULT SIGN
	MOV  M,A	;RESULT SIGN
	MOV  A,C	;OPERAND SIGN AND 1ST FRACTION
	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

;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 TO E
	MOV  A,D	;ORIGINAL CONTENTS OF D
	RAL		;LEFT SHIFT D
	MOV  D,A	;RESTORE TO D
	MOV  A,C	;ORIGINAL CONTENTS OF C
	RAL		;LEFT SHIFT C
	MOV  C,A	;RESTORE TO C
	MOV  A,B	;ORIGINAL CONTENTS OF B
	ADC  A		;LEFT SHIFT B
	MOV  B,A	;RESTORE TO B
	RET		;RETURN TO CALLER

;RIGHT SHIFT THE B, C, D, AND E REGISTERS
;BY THE SHIFT COUNT IN THE A REGISTER.
;              - OR -
;SHIFT OPERAND TO REGISTER INDICATED
;BY THE SHIFT COUNT(MODULO 8).
RSH:	MVI  E,0	;OPERAND 4TH FRACTION IS ZERO
	MVI  L,08	;EACH REG IS 8 BITS OF SHIFT
RSH1:	CMP  L		;COMPARE SHIFT COUNT TO 8
	JM   RSH2	;IF REQUIRED SHIFT IS < 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 ONE REGISTER
	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 1ST FRACTION
	MOV  B,A	;OPERAND 1ST FRACTION
	MOV  A,C	;OPERAND 2ND FRACTION
	RAR		;RIGHT SHIFT 2ND FRACTION
	MOV  C,A	;OPERAND 2ND FRACTION
	MOV  A,D	;OPERAND 3RD FRACTION
	RAR		;RIGHT SHIFT 3RD FRACTION
	MOV  D,A	;OPERAND 3RD FRACTION
	MOV  A,E	;OPERAND 4TH FRACTION
	RAR		;RIGHT SHIFT 4TH FRACTION
	MOV  E,A	;OPERAND 4TH FRACTION
	DCR  L		;DECREMENT SHIFT COUNT
	JNZ  RSH3	;IF MORE SHIFTS REQUIRED
	RET		;RETURN TO CALLER

;COMPLIMENT THE B, C, D, AND E REGISTERS
COMP:	DCX  H		;TO ADDR THE ACC SIGN
	MOV  A,M	;ACC SIGN
	XRI  80H	;CHANGE SIGN
	MOV  M,A	;ACC SIGN
COMP1:	XRA  A		;ZERO -- FFIX ENTRY POINT
	MOV  L,A	;ZERO
	SUB  E		;COMPLIMENT 4TH FRACTION
	MOV  E,A	;RESTORE TO E
	MOV  A,L	;ZERO
	SBB  D		;COMPLIMENT 3RD FRACTION
	MOV  D,A	;RESTORE TO D
	MOV  A,L	;ZERO
	SBB  C		;COMPLIMENT 2ND FRACTION
	MOV  C,A	;RESTORE TO C
	MOV  A,L	;ZERO
	SBB  B		;COMPLIMENT 1ST FRACTION
	MOV  B,A	;RESTORE TO B
	RET		;RETURN TO CALLER

;NORMALIZE THE REGISTERS
NORM:	MVI  L,20H	;MAXIMUM NORMALIZING SHIFT
NORM1:	MOV  A,B	;1ST FRACTION
	ANA  A		;SET CONTROL BITS
	JNZ  NORM3	;IF 1ST FRACTION IS NON ZERO
	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  08		;REDUCE SHIFT COUNT
	MOV  L,A	;NORMALIZING SHIFT COUNT
	JNZ  NORM1	;IF FRACTION NON ZERO
	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 TO E
	MOV  A,D	;ORIGINAL CONTENTS OF D
	RAL		;LEFT SHIFT D
	MOV  D,A	;RESTORE TO D
	MOV  A,C	;ORIGINAL CONTENTS OF C
	RAL		;LEFT SHIFT C
	MOV  C,A	;RESTORE TO C
	MOV  A,B	;ORIGINAL CONTENTS OF B
	ADC  A		;LEFT SHIFT B
	MOV  B,A	;RESTORE TO B
NORM3:	JP   NORM2	;IF NOT YET NORMALIZED
	MOV  A,L	;NORMALIZING SHIFT COUNT
	SUI  20H	;REMOVE BIAS
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	ADD  M		;ADJUST ACC EXPONENT
	MOV  M,A	;NEW ACC EXPONENT
	RZ		;RETURN IF ZERO EXPONENT
	RAR		;BORROW BIT TO SIGN
	ANA  A		;SET SIGN TO INDICATE UNDERFLOW
	RET		;RETURN TO CALLER

;ROUND THE B, C, AND D REGISTERS
ROND:	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,E	;4TH FRACTION
	ANA  A		;SET CONTROL BITS
	MOV  E,M	;ACC EXPONENT
	CM   RNDR	;CALL 2ND LEVEL ROUNDER
	RC		;RETURN IF OVERFLOW
	MOV  A,B	;1ST FRACTION
	INX  H		;TO ADDR THE ACC SIGN
	XRA  M		;ACC SIGN AND 1ST FRACTION
	JMP  FSTR1	;RETURN THRU 'STORE' SUBROUTINE

;SECOND LEVEL ROUNDER
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	;ACC EXPONENT
	ADI  1		;INCREMENT ACC EXPONENT
	MOV  E,A	;NEW ACC EXPONENT
	MVI  B,80H	;NEW 1ST FRACTION
	MOV  M,A	;NEW ACC EXPONENT
	RET		;RETURN TO 1ST LEVEL ROUNDER

;FIXED POINT MULTIPLY
MULX:	LXI  H,MULX4+9	;TO ADDR THE 1ST MULTIPLICAND
	MOV  M,A	;1ST MULTIPLICAND
	LXI  H,MULX4+5	;TO ADDR THE 2ND MULTIPLICAND
	MOV  M,D	;2ND MULTIPLICAND
	LXI  H,MULX4+1	;TO ADDR THE 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 ADDR THE 3RD FRACTION
	CALL MULX2	;MULTIPLY BY ACC 3RD FRACTION
	LXI  H,ACC2	;TO ADDR THE 2ND FRACTION
	CALL MULX1	;MULTIPLY BY ACC 2ND FRACTION
	LXI  H,ACC1	;TO ADDR THE 1ST FRACTION

;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	;TO 2ND PARTIAL PRODUCT
	SUB  B		;SET CARRY BIT FOR EXIT FLAG
	JNC  FFIX0	;MULTIPLY BY 0

;LOOP FOR EACH BIT OF MULTIPLIER WORD
MULX3:	MOV  A,L	;5TH PARTIAL PRODUCT, EXIT FLAG
	ADC  A		;SHIFT EXIT FLAG OUT IF DONE
	RZ		;EXIT IF MULTIPLICATION DONE
	MOV  L,A	;5TH PARTIAL 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 PARTIAL PRODUCT AND MULTIPLIER
	RAL		;SHIFT THEM
	MOV  B,A	;1ST PARTIAL PRODUCT AND MULTIPLIER
	JNC  MULX3	;IF NO ADDITION REQUIRED

;ADD THE MULTIPLICAND TO THE PRODUCT IF THE MULTIPLIER BIT IS A ONE
	MOV  A,E	;4TH PARTIAL PRODUCT
	CALL MULX4	;TO RAM CODE

;COMPLETE ADDITION OF MULTIPLICAND
	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
	JMP  MULX3

;FIXED POINT DIVIDE
;
;SUBTRACT THE DIVISOR FROM THE ACCUMULATOR TO OBTAIN THE FIRST REMAINDER
DIVX:	LXI  H,ACC3	;TO ADDR THE ACC 3RD FRACTION
	MOV  A,M	;ACC 3RD FRACTION
	SUB  E		;DIVISOR 3RD FRACTION
	MOV  M,A	;REMAINDER 3RD FRACTION
	DCX  H		;TO ADDR THE ACC 2ND FRACTION
	MOV  A,M	;ACC 2ND FRACTION
	SBB  D		;DIVISOR 2ND FRACTION
	MOV  M,A	;REMAINDER 2ND FRACTION
	DCX  H		;TO ADDR THE ACC 1ST FRACTION
	MOV  A,M	;ACC 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 FRACTION
	STA  DIVX5+12	;1ST SUBTRACT DIVISOR
	STA  DIVX6+9	;1ST ADD DIVISOR
	MOV  A,D	;DIVISOR 2ND FRACTION
	RAR		;HALF OF DIVISOR 2ND FRACTION
	STA  DIVX5+8	;2ND SUBTRACT DIVISOR
	STA  DIVX6+5	;2ND ADD DIVISOR
	MOV  A,E	;DIVISOR 3RD FRACTION
	RAR		;HALF OF DIVISOR 3RD FRACTION
	STA  DIVX5+4	;3RD SUBTRACT DIVISOR
	STA  DIVX6+1	;3RD ADD DIVISOR
	MVI  B,0	;INIT QUOTIENT 1ST FRACTION
	MOV  A,B	;DIVISOR 4TH QUOTIENT IS ZERO
	RAR		;LOW BIT OF DIVISOR 3RD FRACTION
	STA  DIVX5+1	;4TH SUBTRACT DIVISOR
	STA  DIVX5+15	;4TH ADD DIVISOR
	STA  DIVX6+12	;4TH ADD DIVISOR

;LOAD FIRST REMAINDER AND CHECK SIGN
	LXI  H,ACC1	;TO ADDR THE REMAINDER 1ST FRACTION
	MOV  A,M	;REMAINDER 1ST FRACTION
	INX  H		;TO ADDR THE REMAINDER 2ND FRACTION
	MOV  D,M	;REMAINDER 2ND FRACTION
	INX  H		;TO ADDR THE REMAINDER 3RD FRACTION
	MOV  E,M	;REMAINDER 3RD FRACTION
	ANA  A		;SET CONTROL BITS
	JM   DIVX4	;IF REMAINDER IS NEGATIVE

;ADJUST THE EXPONENT, POSITION THE REMAINDER, AND INITIALIZE THE QUOTIENT
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  C,M	;QUOTIENT EXPONENT
	INR  C		;INCREMENT THE 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 QUOTIENT 3RD FRACTION
	MOV  C,B	;INITIALIZE QUOTIENT 2ND FRACTION

;SUBTRACT THE DIVISOR FROM THE REMAINDER IF IT IS POSITIVE
DIVX1:	XRA  A		;REMAINDER 4TH FRACTION IS ZERO
	CALL DIVX5	;CALL RAM CODE
DIVX2:	RLC		;SHIFT REMAINDER 4TH FRACTION TO CARRY

;SHIFT THE REMAINDER LEFT ONE BIT
	MOV  A,B	;QUOTIENT 1ST FRACTION
	RAL		;MSB OF QUOTIENT TO CARRY
	RC		;IF DIVISION COMLPETE
	RAR		;REMAINDER 4TH FRACTION TO CARRY
	MOV  A,L	;REMAINDER 3RD FRACTION
	RAL		;LEFT SHIFT REMAINDER 3RD FRACTION
	MOV  L,A	;REMAINDER 3RD FRACTION
	MOV  A,H	;REMAINDER 2ND FRACTION
	RAL		;LEFT SHIFT REMAINDER 2ND FRACTION
	MOV  H,A	;REMAINDER 2ND FRACTION
	CALL LSH	;LEFT SHIFT IT

;BRANCH IF SUBTRACTION IS REQUIRED
	MOV  A,D	;QUOTIENT 3RD FRACTION
	RRC		;REMAINDER SIGN TO CARRY BIT
	JC   DIVX1	;SUBTRACT DIVISOR IF REMAINDER IS POSITIVE

;ADD THE DIVISOR IF THE REMAINDER IS NEGATIVE
DIVX3:	MOV  A,L	;REMAINDER 3RD FRACTION
	CALL DIVX6	;TO RAM CODE
	JMP  DIVX2

;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 QUOTIENT 3RD FRACTION
	MOV  C,B	;INITIALIZE QUOTIENT 2ND FRACTION
	JMP  DIVX3	;ADD DIVISOR IF REMAINDER IS NEGATIVE

;FIXED POINT TO FLOATING POINT CONVERSION
FFLOT:	MOV  L,E	;INPUT EXPONENT
	MOV  E,D	;4TH INPUT FRACTION
	MOV  D,C	;3RD INPUT FRACTION
	MOV  C,B	;2ND INPUT FRACTION
	MOV  B,A	;1ST INPUT FRACTION
	MOV  A,L	;INPUT EXPONENT
FLOT1:	XRI  80H	;APPLY EXPONENT BIAS
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  M,A	;ACC EXPONENT
	INX  H		;TO ADDR THE ACC SIGN
	MVI  M,80H	;SET ACC SIGN POSITIVE
	INX  H		;TO ADDR THE ACC 1ST FRACTION
	MOV  A,B	;1ST INPUT FRACTION
	ANA  A		;SET SIGN BIT
	RAL		;INPUT SIGN TO CARRY
	JMP  FADD6	;COMPLETE THE CONVERSION

;FLOATING POINT TO FIXED POINT CONVERSION
FFIX:	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  A,M	;ACC EXPONENT
	ANA  A		;SET CONTROL BITS
	JZ   FFIX1	;IF ACC IS ZERO
	MOV  A,E	;INPUT EXPONENT
	ADI  7FH	;APPLY BIAS-1
	SUB  M		;SHIFT COUNT - 1
	jc   ffix2	;check for -32768 if too large
	CPI  1FH	;COMPARE TO LARGE SHIFT
	JNC  FFIX1	;IF ACC TOO SMALL
	ADI  1		;SHIFT COUNT
	LXI  H,ACC1	;TO ADDR THE ACC 1ST FRACTION
	MOV  B,M	;ACC 1ST FRACTION
	INX  H		;TO ADDR THE ACC 2ND FRACTION
	MOV  C,M	;ACC 2ND FRACTION
	INX  H		;TO ADDR THE ACC 3RD FRACTION
	MOV  D,M	;ACC 3RD FRACTION
	CALL RSH	;POSITION THE FRACTION
	LXI  H,ACCS	;TO ADDR THE ACC SIGN
	MOV  A,M	;ACC SIGN
	ANA  A		;SET CONTROL BITS
	CP   COMP1	;COMPLIMENT FRACTION IF NEGATIVE
	MVI  A,1	;NON-ZERO
	ORA  B		;SET CONTROL BITS FOR EXIT
	MOV  A,B	;1ST RESULT
	MOV  B,C	;2ND RESULT
FFIX0:	MOV  C,D	;3RD RESULT  -- MULX2 ENTRY POINT
	MOV  D,E	;4TH RESULT
	RET		;RETURN TO CALLER
FFIX1:	XRA  A		;ZERO
	MOV  B,A	;ZERO
	MOV  C,A	;ZERO
	MOV  D,A	;ZERO
	RET		;RETURN TO CALLER
;FIX2 checks for -32768 (90H, 0, 80H, 0, 0) in FACC, otherwise returns Carry.
ffix2:	mov  a,m
	sui  90H
	inx  h
	ora  m
	inx  h
	mov  c,m	;ACC1 to C
	inx  h
	ora  m
	inx  h
	ora  m
	stc
	rnz		;ACCE <> 90H or ACCS, ACC2, ACC3 <> 0
	mov  b,a	;0 to B in case success
	mov  a,c
	cpi  80H
	rz		;-32768, return 80H in A and 0 in B
	stc
	ret		;ACC1 <> 80H

;floating point increment routine for fast NEXT code
fincr:	mov	a,m	;get argument exponent
	cpi	81h	;does it have the exponent of a fp one?
	jnz	fadd	;nope - have to plow thru a fp add
	push	h	;yup - test remainder of bytes
	inx	h
	mov	a,m
	inx	h
	ora	m
	inx	h
	ora	m
	pop	h
	jnz	fadd	;not a fp one, have to use add
	push	h
	lxi	h,acce	;see if acc is easy to increment
	mov	a,m
	ora	a	;is it zero?
	jz	finc1	;yes - hard to increment
	dcr	a	;generate a carry if FACC is >=1 and
	inx	h
	add	m	;positive
finc1:	pop	h
	jnc	fadd	;not easy to increment
	lda	acce	;get current exponent
	mvi	e,0	;to defeat etest
	cpi	25+81h	;will exponents differ by more than 23?
	rnc		;yes - no point in adding
	sui	81h	;difference of exponents now in reg a
	lxi	b,8000h	;put mantissa of fp one into regs BCD
	mov	d,c
	jz	finc4
	mov	e,a	;save difference
	ani	7	;take difference mod 8
	mov	l,a	;bits to rotate the signifficant bit
	mov	a,b	;fetch sig bit to rotate
	jz	finc3	;bit in right pos, now pick right byte
finc2:	rrc		;keep rotating until in right place
	dcr	l
	jnz	finc2
finc3:	mov	b,a	;assume bit belongs in 1st fraction
	mov	a,e	;test number of bits to see if it is so
	cpi	8	;set carry if it belongs here
	jc	finc4	;in which case, all is shifted
	mov	c,b	;assume bit belongs in 2nd fraction
	mov	b,l	;zero 1st fraction
	cpi	16	;set carry if it belongs in 2nd fraction
	jc	finc4
	mov	d,c	;well, it must belong in 3rd fraction
	mov	c,l	;zero second fraction
finc4:	lxi	h,acc3	;needed by add4
	jmp	fadd4


	endif		;end of FLOAT conditional

;end of FMATH
	PAGE
