	DOSSEG
	.MODEL SMALL
	.DATA?
;
; BCD floating-point math package
; Some Assembly Required - BYTE Magazine
; April 1989
; -- Rick Grehan
; The interface routines in this version are compatible with
; Turbo C.  Shouldn't be hard to modify them for your favorite
; language.
;
NUM_BYTES	EQU	12		;Number of bytes per mantissa
NUM_WORDS	EQU	NUM_BYTES/2
NUM_DIGITS	EQU	NUM_BYTES*2
BIAS		EQU	16384

; Error definitions

DIVZ_ERR	EQU	1		;Divide by zero
EXPO_ERR	EQU	2		;Exponent overflow error
EXPU_ERR	EQU	3		;Exponent underflow error

FAC1_SIGN	DB	?
FAC1_EXP	DW	?
FAC1_MAN	DW	NUM_WORDS DUP(?)

FAC2_SIGN	DB	?
FAC2_EXP	DW	?
FAC2_MAN	DW	NUM_WORDS DUP(?)

FAC3_MAN	DW	NUM_WORDS DUP(?)

	.CODE
	PUBLIC	_fltadd
;_fltadd
; Add two floating-point numbers.  Return result
;    fltadd(num1,num2,num3)
; num3 = num1 + num2
; Function value is error code (0 if ok)
;
_fltadd:
	PUSH	BP		;Save registers
	MOV	BP,SP
	PUSH	SI		;For Turbo C
	PUSH	DI
;First load the accumulators
	MOV	SI,[BP+4]
	MOV	DI,OFFSET FAC1_SIGN
	CALL	FLDACC
	MOV	SI,[BP+6]
	MOV	DI,OFFSET FAC2_SIGN
	CALL	FLDACC
;Do the addition
	CALL	FPADD
;Return result
	MOV	SI,OFFSET FAC1_SIGN
	MOV	DI,[BP+8]
	CALL	FSTACC
;Restore registers
	POP	DI
	POP	SI
	POP	BP
	RET

	PUBLIC	_fltsub
;_fltsub
; Subtract two floating-point numbers.  Return result
;    fltsub(num1,num2,num3)
; num3 = num1 - num2
; Function value is error code (0 if ok)
;
_fltsub:
	PUSH	BP		;Save registers
	MOV	BP,SP
	PUSH	SI		;For Turbo C
	PUSH	DI
;First load the accumulators
	MOV	SI,[BP+4]
	MOV	DI,OFFSET FAC1_SIGN
	CALL	FLDACC
	MOV	SI,[BP+6]
	MOV	DI,OFFSET FAC2_SIGN
	CALL	FLDACC
;Do the subtraction
	CALL	FPSUB
;Return result
	MOV	SI,OFFSET FAC1_SIGN
	MOV	DI,[BP+8]
	CALL	FSTACC
;Restore registers
	POP	DI
	POP	SI
	POP	BP
	RET

	PUBLIC	_fltmul
;_fltmul
; Multiply two floating-point numbers.  Return result
;    fltmul(num1,num2,num3)
; num3 = num1 * num2
; Function value is error code (0 if ok)
;
_fltmul:
	PUSH	BP		;Save registers
	MOV	BP,SP
	PUSH	SI		;For Turbo C
	PUSH	DI
;First load the accumulators
	MOV	SI,[BP+4]
	MOV	DI,OFFSET FAC1_SIGN
	CALL	FLDACC
	MOV	SI,[BP+6]
	MOV	DI,OFFSET FAC2_SIGN
	CALL	FLDACC
;Do the multiplication
	CALL	FPMUL
;Return result
	MOV	SI,OFFSET FAC1_SIGN
	MOV	DI,[BP+8]
	CALL	FSTACC
;Restore registers
	POP	DI
	POP	SI
	POP	BP
	RET

	PUBLIC	_fltdiv
;_fltdiv
; Divide two floating-point numbers.  Return result
;    fltdiv(num1,num2,num3)
; num3 = num1 / num2
; Function value is error code (0 if ok)
;
_fltdiv:
	PUSH	BP		;Save registers
	MOV	BP,SP
	PUSH	SI		;For Turbo C
	PUSH	DI
;First load the accumulators
	MOV	SI,[BP+4]
	MOV	DI,OFFSET FAC1_SIGN
	CALL	FLDACC
	MOV	SI,[BP+6]
	MOV	DI,OFFSET FAC2_SIGN
	CALL	FLDACC
;Do the division
	CALL	FPDIV
;Return result
	MOV	SI,OFFSET FAC1_SIGN
	MOV	DI,[BP+8]
	CALL	FSTACC
;Restore registers
	POP	DI
	POP	SI
	POP	BP
	RET

	PUBLIC	_fltint
;_fltint
; Convert BCD floating-point number to integer.
; fltint(bcdnum,integer)
; struct bcdtype *bcdnum;
; int *integer
; Returns -1 if conversion failed, 0 if ok.
;
_fltint:
	PUSH	BP		;Save registers
	MOV	BP,SP
	PUSH	SI		;For Turbo C
	PUSH	DI
;First load the accumulator
	MOV	SI,[BP+4]
	MOV	DI,OFFSET FAC1_SIGN
	CALL	FLDACC
;Convert
	CALL	FLTINT
	OR	BX,BX		;Error?
	JZ	_fltint1
	MOV	AX,-1
	JMP	_fltintx
_fltint1:
	MOV	DI,[BP+6]
	MOV	[DI],AX
	XOR	AX,AX		;Show no error
_fltintx:
	POP	DI
	POP	SI
	POP	BP
	RET

	PUBLIC	_intflt
;_intflt
; Convert integer to BCD floating-point number.
; intflt(integer,bcdnum)
; struct bcdtype *bcdnum;
; int integer
; Returns error if conversion failed, 0 if ok.
;
_intflt:
	PUSH	BP		;Save registers
	MOV	BP,SP
	PUSH	SI		;For Turbo C
	PUSH	DI
	MOV	AX,[BP+4]
;Convert
	CALL	INTFLT
	OR	AX,AX		;Error?
	JNZ	_intfltx
	MOV	DI,[BP+6]
	MOV	SI,OFFSET FAC1_SIGN
	CALL	FSTACC
	XOR	AX,AX
_intfltx:
	POP	DI
	POP	SI
	POP	BP
	RET


;FLDACC
;Load the floating-point accumulator pointed to
;by the DI register with the number stored at
;the location pointed to by the SI register.
;DI points to the _SIGN field of the accumulator.
FLDACC:
	MOV	AX,[SI]
	MOV	BL,AH
	AND	BL,80H		;Get sign bit
	MOV	[DI],BL		;Store it
	INC	DI		;Bump to exponent field
	AND	AH,7FH		;Clear sign
	MOV	[DI],AX
	INC	DI
	INC	DI		;Point to mantissa
	MOV	DX,DI		;Save for later
	INC	SI		;SI points to mantissa, too.
	INC	SI
	MOV	CX,NUM_WORDS-1
	CLD			;Clear dir. just to make sure
	REP	MOVSW		;Move in mantissa
	MOV	[DI],CX		;Clear last word of mantissa
	MOV	SI,DX		;Get saved pointer
	CALL	RSHIFT_NIBB	;Shift mantissa right
	RET
;FSTACC
;Store an accumulator to an external location
;SI points to sign field of the accumulator to store.
;DI is location to store to.
FSTACC:
	PUSH	SI		;Save pointers
	PUSH	DI
	ADD	SI,3		;Re-align mantissa
	CALL	LSHIFT_NIBB
;Set up exponent (presumes hi bit clear)
	POP	DI		;Restore pointer registers
	POP	SI
	MOV	DL,[SI]		;Get sign
	INC	SI
	MOV	AX,[SI]
	OR	AH,DL		;Set the sign bit
	MOV	[DI],AX		;Store exponent
	INC	SI
	INC	SI
	INC	DI
	INC	DI
	MOV	CX,NUM_WORDS-1
	REP	MOVSW		;Move out the mantissa
	RET
;
;FPADD
;Add the contents of FAC1 and FAC2.
;Result in FAC1.
FPADD:
;Compare exponents of FAC1 and FAC2.
;Place number with largest exponent
;in FAC1.

	MOV	AX,FAC1_EXP
	CMP	AX,FAC2_EXP
	JAE	FAD1A

;Swap FAC1 and FAC2

	MOV	AL,FAC1_SIGN
	XCHG	AL,FAC2_SIGN
	MOV	FAC1_SIGN,AL
	MOV	SI,OFFSET FAC1_EXP
	MOV	DI,OFFSET FAC2_EXP
	MOV	CX,NUM_WORDS+1
FAD1:	MOV	AX,[SI]
	XCHG	[DI],AX
	MOV	[SI],AX
	INC	SI
	INC	SI
	INC	DI
	INC	DI
	LOOP	FAD1
;The difference between the two
;exponents indicate how many times
;we have to multiply the mantissa
;of FAC2 by 10 (i.e., shift it
;right 1 place).
;If we have to shift more times than
;we have digits, the result is already
;in FAC1.
FAD1A:
	MOV	CX,FAC1_EXP
	SUB	CX,FAC2_EXP
	JZ	FAD3		;Any shifting necessary?
	CMP	CX,NUM_DIGITS
	JAE	FAD6
FAD2:	PUSH	CX
	MOV	SI,OFFSET FAC2_MAN
	CALL	RSHIFT_NIBB
	POP	CX
	LOOP	FAD2
;See if the signs of the two numbers
;are the same.  If so, add; if not,
;subtract.

FAD3:	MOV	AL,FAC1_SIGN
	CMP	AL,FAC2_SIGN
	JNE	FAD4

;Add
	MOV	DI,OFFSET FAC1_MAN
	MOV	SI,OFFSET FAC2_MAN
	MOV	BX,NUM_BYTES-1
	CLC
FAD3A:	MOV	AL,[SI+BX]
	ADC	AL,[DI+BX]
	DAA
	MOV	[DI+BX],AL
	DEC	BX
	JNS	FAD3A
	JMP	NORM_FAC1		;Exit through normalization

;Subtract FAC2 from FAC1
;
FAD4:	MOV	DI,OFFSET FAC1_MAN
	MOV	SI,OFFSET FAC2_MAN
	MOV	BX,NUM_BYTES-1
	CLC
FAD5:	MOV	AL,[DI+BX]
	SBB	AL,[SI+BX]
	DAS
	MOV	[DI+BX],AL
	DEC	BX
	JNS	FAD5
;If there's a borrow, flip sign of FAC1
	JNC	FAD6
	XOR	BYTE PTR FAC1_SIGN,80H
;Adjust
	MOV	SI,OFFSET FAC1_MAN
	MOV	BX,NUM_BYTES-1
	STC
	XOR	AH,AH
FAD5A:	MOV	AL,AH
	SBB	AL,[SI+BX]
	DAS
	MOV	[SI+BX],AL
	DEC	BX
	JNS	FAD5A
FAD6:	JMP	NORM_FAC1
;
;Subtract
;Flip the sign of FAC2 and branch to add
;
FPSUB:	XOR	BYTE PTR FAC2_SIGN,80H
	JMP	FPADD
;
;Multiply
;Multiply the contents of FAC1 by FAC2.
;Result in FAC1.
FPMUL:
;Check exponents.  If either is zero,
;the result is zero
	CMP	WORD PTR FAC1_EXP,0
	JZ	FMUL1
	CMP	WORD PTR FAC2_EXP,0
	JNZ	FMUL2
;Result is zero...clear FAC1.
FMUL1:	XOR	AX,AX
	MOV	CX,5
	MOV	SI,OFFSET FAC1_MAN
FMUL1A:	MOV	[SI],AX
	LOOP	FMUL1A
	JMP	NORM_FAC1
;Now determine exponent of result.
;As you do...watch for overflow.
FMUL2:	MOV	AX,FAC2_EXP
	SUB	AX,BIAS
	ADD	AX,FAC1_EXP
	JNS	FMUL3
	MOV	AX,EXPO_ERR
	RET
FMUL3:	MOV	FAC1_EXP,AX
;Determine the sign of the product
	MOV	AL,FAC1_SIGN
	XOR	AL,FAC2_SIGN
	MOV	FAC1_SIGN,AL
;Move FAC1 mantissa to FAC3.
	MOV	SI,OFFSET FAC1_MAN
	MOV	DI,OFFSET FAC3_MAN
	MOV	CX,NUM_WORDS
	REP	MOVSW
;Clear FAC1's mantissa
	MOV	CX,NUM_WORDS
	MOV	DI,OFFSET FAC1_MAN
	XOR	AX,AX
	REP	STOSW
;For number of digits in the floating
;point number, add FAC2 to FAC1 number
;of times given by lowest nibble in
;FAC3.  Then shift FAC1 and FAC3
;right 1 digit and repeat.
	MOV	CX,NUM_DIGITS
FMUL4:	MOV	DL,BYTE PTR FAC3_MAN+NUM_BYTES-1
	AND	DL,0FH
FMUL5:	DEC	DL
	JS	FMUL7
	MOV	DI,OFFSET FAC1_MAN
	MOV	SI,OFFSET FAC2_MAN
	MOV	BX,NUM_BYTES-1
	CLC
FMUL6:	MOV	AL,[SI+BX]
	ADC	AL,[DI+BX]
	DAA
	MOV	[DI+BX],AL
	DEC	BX
	JNS	FMUL6
	JMP	FMUL5
FMUL7:	DEC	CX
	JNZ	FMUL8
	JMP	NORM_FAC1		;Exit through nomalize
FMUL8:	PUSH	CX
	MOV	SI,OFFSET FAC1_MAN
	CALL	RSHIFT_NIBB
	MOV	SI,OFFSET FAC3_MAN
	CALL	RSHIFT_NIBB
	POP	CX
	JMP	FMUL4

; Floating-point divide
; Divide number in FAC1 by number in FAC2.
; Result in FAC1.
FPDIV:
; If FAC2 = 0, return
; a divide-by-zero error and
; bail out.
	CMP	WORD PTR FAC2_EXP,0
	JNZ	FPD1
	MOV	AX,DIVZ_ERR
	RET
; If FAC1 = 0 the result is
; 0...just return
FPD1:	CMP	WORD PTR FAC1_EXP,0
	JNZ	FPD2
	XOR	AX,AX		;Show no error
	RET
FPD2:
; Calculate the exponent of
; the quotient.
	MOV	AX,FAC1_EXP
	SUB	AX,FAC2_EXP
	ADD	AX,BIAS
	MOV	FAC1_EXP,AX
; Calculate the sign of the
; quotient.
	MOV	AL,FAC2_SIGN
	XOR	FAC1_SIGN,AL
; Clear FAC3 - this will hold the
; mantissa of the result
	XOR	AX,AX
	MOV	CX,NUM_WORDS
	MOV	DI,OFFSET FAC3_MAN
	REP	STOSW
;Set up for looped-subtract
	MOV	CX,NUM_DIGITS
;Subtract FAC2 from FAC1
FPD2A:	MOV	DI,OFFSET FAC1_MAN
	MOV	SI,OFFSET FAC2_MAN
	MOV	BX,NUM_BYTES-1
	CLC
FPD3:	MOV	AL,[DI+BX]
	SBB	AL,[SI+BX]
	DAS
	MOV	[DI+BX],AL
	DEC	BX
	JNS	FPD3
;Did the subtraction fail? If so,
;add FAC2 back into FAC1
	JNC	FPD5
	MOV	DI,OFFSET FAC1_MAN
	MOV	SI,OFFSET FAC2_MAN
	MOV	BX,NUM_BYTES-1
	CLC
FPD4:	MOV	AL,[SI+BX]
	ADC	AL,[DI+BX]
	DAA
	MOV	[DI+BX],AL
	DEC	BX
	JNS	FPD4
	JMP	FPD6
;If subtract succeeded, add 1 to
;lowmost nibble of FAC3 and try another
;subtract.
FPD5:	INC	BYTE PTR FAC3_MAN+NUM_BYTES-1
	JMP	FPD2A
;Shift FAC3 and FAC1 left 1 nibble
FPD6:	DEC	CX			;Done?
	JZ	FPD7
	PUSH	CX
	MOV	SI,OFFSET FAC3_MAN
	CALL	LSHIFT_NIBB
	MOV	SI,OFFSET FAC1_MAN
	CALL	LSHIFT_NIBB
;Loop and repeat for number of digits
	POP	CX
	JMP	FPD2A
;Move FAC3_MAN into FAC1_MAN
FPD7:	MOV	SI,OFFSET FAC3_MAN
	MOV	DI,OFFSET FAC1_MAN
	MOV	CX,NUM_WORDS
	REP	MOVSW
;Exit through normalization routine.
	JMP	NORM_FAC1
; Normalize the number in FAC1
; All routines exit through this one.
; We leave AX=0 if normalization was
; ok...else AX = error code.
NORM_FAC1:

;See if the mantissa is all zeros.
;If so, set the exponent and sign
;equal to 0.
	MOV	SI,OFFSET FAC1_MAN
	MOV	CX,NUM_WORDS
	XOR	AX,AX
NRM1:	OR	AX,[SI]
	INC	SI
	LOOP	NRM1
	OR	AX,AX
	JNZ	NRM1A
	MOV	WORD PTR FAC1_EXP,0
	MOV	BYTE PTR FAC1_SIGN,0
	JMP	SHORT NORMX
;If the highmost nibble in FAC1_MAN is nonzero,
;shift the mantissa right 1 nibble and
;increment the exponent
NRM1A:	MOV	AL,BYTE PTR FAC1_MAN
	AND	AL,0F0H
	JZ	NRM2
	MOV	SI,OFFSET FAC1_MAN
	CALL	RSHIFT_NIBB
	INC	WORD PTR FAC1_EXP
	JMP	NRM4			;Skip next step
;Now shift FAC1_MAN 1 to the left until a
;nonzero digit appears in the next-to-highest
;nibble of FAC1_MAN.  Decrement exponent for
;each shift.
NRM2:	MOV	AL,BYTE PTR FAC1_MAN
	AND	AL,0FH
	JNZ	NRM4
	MOV	SI,OFFSET FAC1_MAN
	CALL	LSHIFT_NIBB
	DEC	WORD PTR FAC1_EXP
	JNZ	NRM2
	MOV	AX,EXPU_ERR
	RET
;Check for overflow/underflow
NRM4:	MOV	AX,FAC1_EXP
	OR	AX,AX
	JNS	NORMX
	MOV	AX,EXPO_ERR
	RET
NORMX:	XOR	AX,AX
	RET
; Integer-to-floating
; This routine takes an integer in AX
; and converts it into a BCD floating-
; point number in FAC1.
INTFLT:
;Set FAC1_SIGN appropriately
	MOV	BYTE PTR FAC1_SIGN,0
	OR	AX,AX
	JNZ	INTF1
	MOV	BYTE PTR FAC1_SIGN,80H
	NEG	AX
;Convert things digit at a time.
;First load the exponent with 0 and
;clear the mantissa.
INTF1:	MOV	WORD PTR FAC1_EXP,0
	MOV	CX,NUM_WORDS
	XOR	DX,DX
	MOV	SI,OFFSET FAC1_MAN
INTF2:	MOV	[SI],DX
	INC	SI
	INC	SI
	LOOP	INTF2
;Divide number by 10, and grab the
;remainder; put remainder in topmost
;nibble of FAC1_MAN.
;First, be sure there's something to
;divide - if not, you're done.
INTF3:	OR	AX,AX
	JNZ	INTF4
	CMP	WORD PTR FAC1_EXP,0
	JZ	INTFX
	ADD	WORD PTR FAC1_EXP,BIAS
INTFX:	JMP	NORM_FAC1
INTF4:	MOV	BX,10
	DIV	BX
	MOV	CX,4
	SHL	DL,CL
	OR	BYTE PTR FAC1_MAN,DL
;Shift FAC1_MAN right by 1 nibble
	PUSH	AX		;Save quotient
	MOV	SI,OFFSET FAC1_MAN
	CALL	RSHIFT_NIBB
	POP	AX
;Increment exponent
	INC	WORD PTR FAC1_EXP
	JMP	INTF3

;
; Floating-point to integer
; Converts the floating-point number
; in FAC1 and returns its value in
; AX.  If BX = 0 the conversion went
; ok...if BX <> 0 there was an
; overflow (number to big to be
; represented as an integer).
; NOTE: Currently, this routine
; converts by truncation.
FLTINT:
;Examine the exponent, if it is <=
;BIAS, the number has no integer
;part and we can skip out.
	XOR	AX,AX		;Clear accumulator
	CMP	FAC1_EXP,BIAS
	JG	FLTIN1
	XOR	BX,BX		;No error
	RET
;Exponent - BIAS shows how many digits
;are to the left of the decimal point.
;If this is greater than 5...bail out
;with an overflow error.
FLTIN1:
	MOV	CX,FAC1_EXP
	SUB	CX,BIAS
	CMP	CX,5
	JLE	FLTIN2
	MOV	BL,1		;Overflow error
	RET
;Move out exponent-BIAS digits.
;Multiply the accumulator by 10.
;(Check for overflow).
FLTIN2:
	MOV	BX,10
	MUL	BX
	JNC	FLTIN3
	RET			;Overflow error (BX is nonzero)
;See if high bit of AX set (wrapped to negative)
FLTIN3:
	OR	AH,AH
	JNS	FLTIN4
	RET			;Overflow error
;Get a nibble.
FLTIN4:
	MOV	SI,OFFSET FAC1_MAN
	PUSH	CX		;Save counter
	PUSH	AX
	CALL	LSHIFT_NIBB	;Digit in high nibble
	POP	AX
	POP	CX		;Restore counter
	MOV	DL,BYTE PTR FAC1_MAN
	AND	DX,0F0H
	SHR	DL,1
	SHR	DL,1
	SHR	DL,1
	SHR	DL,1
;Add the nibble in. (If the result
;wraps to negative - indicate overflow).
	ADD	AX,DX
	JNS	FLTIN5
	MOV	BL,1		;Overflow error
	RET
FLTIN5:
	LOOP	FLTIN2
;Finally, examine FAC1_SIGN - if the
;number is less than 0, complement
;AX.
	CMP	BYTE PTR FAC1_SIGN,0
	JZ	FLTIN6
	NEG	AX
FLTIN6:	XOR	BX,BX		;All is ok
	RET
;
;Rotate right by 1 nibble the
;contents of the mantissa pointed
;to by SI.
;Uses AX, BX, CX, DX, and SI.
RSHIFT_NIBB:
	MOV	BL,4	;Number of bits
	MOV	DX,NUM_BYTES	;Number of bytes
	XOR	AH,AH	;Clear hi byte
RSHF1:	MOV	AL,[SI]	;Get a byte
	MOV	CL,BL	;Get bits to shift
	ROR	AX,CL	;Rotate low nibble out
	MOV	CL,BL
	SHR	AH,CL	;Setup nibble rotated out
	MOV	[SI],AL	;Store shifted byte
	INC	SI	;Go to next byte
	DEC	DX	;Decr count
	JNZ	RSHF1	;Loop and repeat
	RET

;Rotate left by 1 nibble the
;contents of the mantissa pointed
;to by SI.
;Uses AX, BX, CX, DX, and SI.
LSHIFT_NIBB:
	MOV	BL,4	;Number of bits
	MOV	DX,NUM_BYTES	;Number of bytes
	ADD	SI,NUM_BYTES-1	;Adjust pointer
	XOR	AH,AH	;Clear hi byte
LSHF1:	MOV	AL,[SI]	;Get a byte
	MOV	CL,BL	;Get bits to shift
	ROL	AX,CL	;Rotate low nibble out
	MOV	CL,BL
	SHL	AH,CL	;Setup nibble rotated out
	MOV	[SI],AL	;Store shifted byte
	DEC	SI	;Go to next byte
	DEC	DX	;Decr count
	JNZ	LSHF1	;Loop and repeat
	RET

	END