/* --- Copyright University of Sussex 1995. All rights reserved. ----------
 * File:		S.pcwnt/src/afloat.s
 * Purpose:		FP arithmetic for Intel 387/486 (Microsoft assembler)
 * Author:		Robert John Duncan, Apr 15 1994 (see revisions)
 * Related Files:	S.pcunix/src/afloat.s
 */

/*************************************************************************
		THIS FILE WAS GENERATED AUTOMATICALLY FROM
		 /rsuna/pop/master/S.pcunix/src/afloat.s
		     ON Fri Apr 15 10:37:31 BST 1994
	  AND SUBSEQUENTLY EDITED ON Fri Apr 15 10:55:47 BST 1994
*************************************************************************/

#_<

#_INCLUDE 'declare.ph'

constant
	procedure Sys$-Float_qrem
	;

lconstant macro	(

	;;; User stack pointer

	USP 	= "ebx",

	;;; Pop ddecimal structure fields:
	;;; _DD_1 = MS part, _DD_2 = LS part

	_DD_1	= @@DD_1,
	_DD_2	= @@DD_2,

);

>_#

	.erre	@Version ge 611
	option	casemap:none
	.386
	.model	flat


/************************* wrapping structures ************************/

	.code
	dword	L$text_size, C_LAB(Sys$-objmod_pad_key)
L$text_start:
	.data
	assume	cs:nothing
	dword	L$data_size, C_LAB(Sys$-objmod_pad_key)
L$data_start:

/**********************************************************************/


	.data
	assume	cs:nothing

CW:	;;; For changing the control word
	dword	0
WORK:
	dword	0, 0

	.code

;;; Masks for extracting the exponent field from single and double floats

S_EXP	equ	07f800000h	;;; Single, bits 23-30
D_EXP	equ	07ff00000h	;;; Double, bits 52-62


;;; === FPU INITIALISATION ============================================

;;; FPU_INIT:
;;;     reset the FP unit to a known state: we assume for a PC-type
;;;     environment that the default state set by fninit has all
;;;     exceptions masked and rounding set to round-to-nearest.

	public	fpu_init
fpu_init:
	fninit
	ret

	align	4


;;; === MOVEMENT AND TYPE CONVERSION ==================================

;;; _PFCOPY:
;;;	Copy a machine-format double float (64-bit real).

;;; Call:
;;;	_pfcopy(_DST_DFLOAT_ADDR, _SRC_DFLOAT_ADDR);

;;; Register usage:
;;;	ESI	source dfloat address
;;;	EDI	destination dfloat address

DEF_C_LAB(_pfcopy)

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	add	USP, 8

	;;; Move the double float in two longword slices

	mov	eax, dword ptr [esi]
	mov	dword ptr [edi], eax
	mov	eax, dword ptr [esi+4]
	mov	dword ptr [edi+4], eax
	ret

	align	4

;;; _PF_SFLOAT_DEC:
;;;	Float a pop decimal.

;;; Call:
;;;	_pf_sfloat_dec(DEC) -> _SFLOAT;

DEF_C_LAB(_pf_sfloat_dec)

	dec	dword ptr [USP]
	ret

	align	4

;;; _PF_DFLOAT_INT:
;;;	Double float a system integer.

;;; Call:
;;;	_pf_dfloat_int(_INT, _DFLOAT_ADDR);

;;; Register usage:
;;;	EDI	destination dfloat address
;;;	ST(0)	the value, loaded as integer, stored as real

DEF_C_LAB(_pf_dfloat_int)

	mov	edi, dword ptr [USP]
	fild	dword ptr [USP+4]
	add	USP, 8
	fstp	qword ptr [edi]
	wait
	ret

	align	4

;;; _PF_DFLOAT_DEC:
;;;	Double float a pop decimal.

;;; Call:
;;;	_pf_dfloat_dec(DEC, _DFLOAT_ADDR);

;;; Register usage:
;;;	EDI	destination dfloat address
;;;	ST(0)	the value, loaded as single and stored as double

DEF_C_LAB(_pf_dfloat_dec)

	mov	edi, dword ptr [USP]

	;;; Clear the bottom tag bit of DEC before loading

	dec	dword ptr [USP+4]
	fld	dword ptr [USP+4]
	add	USP, 8
	fstp	qword ptr [edi]
	wait
	ret

	align	4

;;; _PF_DFLOAT_DDEC:
;;;	Double float a pop ddecimal.

;;; Call:
;;;	_pf_dfloat_ddec(DDEC, _DFLOAT_ADDR);

;;; Register usage:
;;;	ESI	source pop ddecimal
;;;	EDI	destination dfloat address
;;;	EAX	work

DEF_C_LAB(_pf_dfloat_ddec)

	;;; Copy the low and high halves of the pop ddecimal in two
	;;; longword moves

	mov	edi, dword ptr [USP]
	mov	esi, dword ptr [USP+4]
	add	USP, 8
	mov	eax, dword ptr [esi+_DD_2]
	mov	dword ptr [edi], eax
	mov	eax, dword ptr [esi+_DD_1]
	mov	dword ptr [edi+4], eax
	ret

	align	4

;;; _PF_CVT_TO_DEC:
;;;	Convert a machine double float to a pop decimal.
;;;	Return <false> if overflow.

;;; Call:
;;;	_pf_cvt_to_dec(_DFLOAT_ADDR) -> DEC
;;;	_pf_cvt_to_dec(_DFLOAT_ADDR) -> <false>

;;; Register usage:
;;;	ESI	source dfloat address
;;;	EAX	low word of dfloat argument; single float result; exponent
;;;	EDX	high word of dfloat argument
;;;	ST(0)	conversion register

;;; Memory usage:
;;;	WORK	temporary for communication with the 387

DEF_C_LAB(_pf_cvt_to_dec)

	;;; Load the double float to EDX:EAX

	mov	esi, dword ptr [USP]
	mov	eax, dword ptr [esi]
	mov	edx, dword ptr [esi+4]

	;;; Set bits in the low word to force rounding of 22nd bit of
	;;; mantissa except where 'tied' and 21st bit is 0 (even)

	cmp	eax, 040000000h
	je	L$1$1
	or	eax, 038000000h

L$1$1:	;;; Copy the transformed dfloat to the work area, load it to the
	;;; 387 as a double float then store it back as a single

	mov	dword ptr WORK, eax
	mov	dword ptr WORK+4, edx
	fld	qword ptr WORK
	fstp	dword ptr WORK
	wait

	;;; Get the result back and convert to a pop decimal by setting
	;;; the bottom tag bits to 01

	mov	eax, dword ptr WORK
	and	al, 0fch
	or	al, 1
	mov	dword ptr [USP], eax

	;;; Now check for overflow/underflow by examining the exponent of
	;;; the result

	and	eax, S_EXP

	;;; If exponent is zero, result must be +/-0.0 or denormal:
	;;; return pop zero

	jz	L$1$2

	;;; If exponent is all ones, result must be inifinite or NaN:
	;;; return <false>

	cmp	eax, S_EXP
	je	L$2$1

	;;; Otherwise OK

	ret

L$1$2:	;;; Underflow -- return pop 0.0

	mov	dword ptr [USP], 1
	ret

L$2$1:	;;; Overflow -- return <false>

	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PF_CVT_TO_DDEC:
;;;	Convert machine double float to pop ddecimal, converting -0.0 and
;;;	denormals to plain zero.

;;; Call:
;;;	_pf_cvt_to_ddec(_DFLOAT_ADDR, DDEC);

;;; Register usage:
;;;	ESI	address of the machine double float
;;;	EDI	address of the Pop ddecimal structure
;;;	EAX	work

DEF_C_LAB(_pf_cvt_to_ddec)

	mov	edi, dword ptr [USP]
	mov	esi, dword ptr [USP+4]
	add	USP, 8

	;;; Load high part of dfloat.
	;;; Test the exponent for zero (implies zero or denormal)

	mov	eax, dword ptr [esi+4]
	test	eax, D_EXP
	jz	L$1$3

	;;; Non-zero number: store high and low halves in the pop structure
	;;; and return

	mov	dword ptr [edi+_DD_1], eax
	mov	eax, dword ptr [esi]
	mov	dword ptr [edi+_DD_2], eax
	ret

L$1$3:	;;; Zero or denormal: make the pop ddecimal really zero

	mov	dword ptr [edi+_DD_1], 0
	mov	dword ptr [edi+_DD_2], 0
	ret

	align	4

;;; _PF_ROUND_D_TO_S:
;;;	Round a machine double float to a single float. The double float
;;;	argument is overwritten with its single equivalent. Returns <true>
;;;	for OK, <false> for overflow.

;;; Call:
;;;	_pf_round_d_to_s(_SRCADDR) -> BOOL

;;; Register usage:
;;;	ESI	address of input double/output single
;;;	EAX	work

DEF_C_LAB(_pf_round_d_to_s)

	;;; Load the argument to the 387 as a double and store as a single

	mov	esi, dword ptr [USP]
	fld	qword ptr [esi]
	fstp	dword ptr [esi]
	wait

	;;; Examine the result for infinity/NaN: return <false> if so

	mov	eax, dword ptr [esi]
	and	eax, S_EXP
	cmp	eax, S_EXP
	je	L$1$4

	;;; Result OK: return <true>

	mov	dword ptr [USP], C_LAB(true)
	ret

L$1$4:	;;; Overflow: return <false>

	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PF_EXTEND_S_TO_D:
;;;	Extend a machine single float to a double float. The argument
;;;	points to the single float but in a double float space: the
;;;	converted result is written back in the space.
;;;	Checks first for Inf or NaN and returns <false> if so.

;;; Call:
;;;	_pf_extend_s_to_d(_SRCADDR) -> _SRCADDR
;;;	_pf_extend_s_to_d(_SRCADDR) -> <false>

;;; Register usage:
;;;	EAX	single float exponent
;;;	ESI	address of input single/output double

DEF_C_LAB(_pf_extend_s_to_d)

	mov	esi, dword ptr [USP]
	mov	eax, dword ptr [esi]

	;;; Check exponent for Inf or NaN

	and	eax, S_EXP
	cmp	eax, S_EXP
	je	L$1$5

	;;; OK -- do the conversion

	fld	dword ptr [esi]	;;; Load as single
	fstp	qword ptr [esi]	;;; Store as double
	wait
	ret

L$1$5:	;;; Inf or NaN -- return <false>

	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PF_CHECK_D:
;;;	Check double float for Inf or NaN.

;;; Call:
;;;	_pf_check_d(_DFLOAT_ADDR) -> _DFLOAT_ADDR
;;;	_pf_check_d(_DFLOAT_ADDR) -> <false>

;;; Registers:
;;;	EAX	MS word of dfloat/exponent
;;;	ESI	address of dfloat

DEF_C_LAB(_pf_check_d)

	mov	esi, dword ptr [USP]
	mov	eax, dword ptr [esi+4]
	and	eax, D_EXP
	cmp	eax, D_EXP
	je	L$1$6
	ret
L$1$6:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4


;;; === DISSECTING FLOATS =============================================

;;; _PF_INTOF:
;;;	Return the integer part of a double float (i.e truncate the
;;;	argument to a system integer). Return <true> for OK, <false> for
;;;	overflow.

;;; Call:
;;;	_pf_intof(_DFLOAT_ADDR) -> <true> -> _INT
;;;	_pf_intof(_DFLOAT_ADDR) -> <false>

;;; Register usage:
;;;	ESI	source dfloat address
;;;	AX	the 387 control word, then status word

;;; Memory usage:
;;;	CW	for loading and storing the 387 control word

DEF_C_LAB(_pf_intof)

	;;; Get the address of the dfloat argument in ESI and load the
	;;; argument to the 387

	mov	esi, dword ptr [USP]
	fld	qword ptr [esi]

	;;; Change the rounding mode of the 387 to "chop" by setting
	;;; bits 10 & 11 of the control word and clear exception flags
	;;; in the status word register

	fstcw	word ptr CW
	fnclex
	mov	ax, word ptr CW
	or	ax, 00c00h
	mov	word ptr CW+2, ax
	fldcw	word ptr CW+2

	;;; Store the value back to memory as an integer. Overflow will
	;;; cause an Invalid Operation exception; on the assumption that
	;;; this is masked, we can test for it by examining the status
	;;; word.

	fistp	dword ptr [USP]
	fstsw	ax

	;;; Restore the original control word and return

	fldcw	word ptr CW
	test	ax, 1
	jnz	@f
	sub	USP, 4
	mov	dword ptr [USP], C_LAB(true)
	ret
@@:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PFMODF:
;;;	Extract integer and fractional parts of a double float (both parts
;;;	as double floats). The source is overwritten with its integer part,
;;;	the fractional part is written to the first argument.

;;; Call:
;;;	_pfmodf(_FRAC, _DFLOAT_ADDR);

;;; Register usage:
;;;	ESI	address of input double float/output integer part (as dfloat)
;;;	EDI	address for fractional part (also as dfloat)
;;;	AX	the 387 control word
;;;	ST(0), ST(1)
;;;		work

;;; Memory usage:
;;;	CW	for loading and storing the 387 control word

DEF_C_LAB(_pfmodf)

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	add	USP, 8

	;;; Load the source dfloat to ST(0) and copy to ST(1)

	fld	qword ptr [esi]
	fst	st(1)

	;;; Truncate ST(0) to an integer.
	;;; This means changing the rounding mode to "chop" by setting bits
	;;; 10 & 11 of the control word

	fstcw	word ptr CW
	wait
	mov	ax, word ptr CW
	or	ax, 00c00h
	mov	word ptr CW+2, ax
	fldcw	word ptr CW+2
	frndint
	fldcw	word ptr CW

	;;; Write ST(0) to the source address, then subtract ST(1) to get
	;;; the fractional part and pop that into the fraction address.

	fst	qword ptr [esi]
	fsub
	fstp	qword ptr [edi]

	wait
	ret

	align	4

;;; _PF_EXPOF:
;;;	Get and set the exponent, E, of a double float, where E is the
;;;	number of bits needed for the integer part, i.e 1 for 1.0,
;;;	0 for 0.5, -1 for 0.05 etc.
;;;	The updater returns a flag indicating whether or not the new value
;;;	was OK.

;;; Call:
;;;	_pf_expof(_DFLOAT_ADDR) -> _INT
;;;	_INT -> _pf_expof(_DFLOAT_ADDR) -> BOOL;

;;; Register usage:
;;;	ESI	address of the machine double float
;;;	EAX	the high word of the dfloat (containing the exponent)
;;;	ECX	(updater only): the new exponent

DEF_C_LAB(_pf_expof)

	;;; Load high part of argument to EAX

	mov	esi, dword ptr [USP]
	mov	eax, dword ptr [esi+4]

	;;; Mask out everything except the exponent and shift it to the
	;;; bottom of EAX

	and	eax, D_EXP
	shr	eax, 20

	;;; Unbias the exponent by subtracting 1022 and return

	sub	eax, 1022
	mov	dword ptr [USP], eax
	ret

	align	4

DEF_C_LAB(-> _pf_expof)

	;;; Load high part of the argument to EAX, new exponent to ECX

	mov	esi, dword ptr [USP]
	mov	eax, dword ptr [esi+4]
	mov	ecx, dword ptr [USP+4]
	add	USP, 4

	;;; Bias the exponent by adding 1022: check it's in the 11-bit
	;;; range 0 - 2047 and return <false> if not.
	;;; Shift it up to the correct place in the word

	add	ecx, 1022
	cmp	ecx, 2047
	ja	L$1$7
	shl	ecx, 20

	;;; Mask out the exponent from EAX and OR in the new one;
	;;; store it back to the argument and return <true>

	and	eax, not D_EXP
	or	eax, ecx
	mov	dword ptr [esi+4], eax
	mov	dword ptr [USP], C_LAB(true)
	ret

L$1$7:	;;; New exponent out of range: return <false>

	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4


;;; === PREDICATES ON DOUBLE FLOATS ===================================

;;; _PFZERO:
;;;	Test a machine double float for zero (including -0.0).

;;; Call:
;;;	_pfzero(_DFLOAT_ADDR) -> BOOL

DEF_C_LAB(_pfzero)

	;;; Get the dfloat address in ESI

	mov	esi, dword ptr [USP]

	;;; Test all but the sign bit of the high word for zero

	test	dword ptr [esi+4], 07fffffffh
	jnz	L$1$8

	;;; Test the low word for zero

	cmp	dword ptr [esi], 0
	je	return_true
L$1$8:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PFNEG:
;;;	Test a machine double float for genuine negative (not -0.0).

;;; Call:
;;;	_pfneg(_DFLOAT_ADDR) -> BOOL

DEF_C_LAB(_pfneg)

	;;; Get the dfloat address in ESI and the high word in EAX

	mov	esi, dword ptr [USP]
	mov	eax, dword ptr [esi+4]

	;;; Test the sign bit: return <false> if not set

	test	eax, eax
	jns	L$1$9

	;;; Otherwise test for -0.0

	test	eax, 07fffffffh
	jnz	return_true
	cmp	dword ptr [esi], 0
	jne	return_true
L$1$9:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PFEQ:
;;;	Test two double floats for identity.

;;; Call:
;;;	_pfeq(_DFLOAT_ADDR_1, _DFLOAT_ADDR_2) -> BOOL

DEF_C_LAB(_pfeq)

	;;; Load addresses to ESI/EDI

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	add	USP, 4

	;;; Compare high words

	mov	eax, dword ptr [esi+4]
	cmp	dword ptr [edi+4], eax
	jne	L$1$10

	;;; Compare low words

	mov	eax, dword ptr [esi]
	cmp	dword ptr [edi], eax
	je	return_true
L$1$10:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PFSGR:
;;; _PFSGREQ:
;;;	Test for double float greater-than/greater-than-or-equal.

;;; Call:
;;;	_pfsgr(_DFLOAT_ADDR_1, _DFLOAT_ADDR_2) -> BOOL
;;;	[means: _DFLOAT_1 > _DFLOAT_2]

;;; Register usage:
;;;	ESI	address of dfloat1
;;;	EDI	address of dfloat2
;;;	AX	387 status word, for checking flags
;;;	ST(0)	dfloat2
;;;	ST(1)	dfloat1

DEF_C_LAB(_pfsgreq)

	;;; Condition ST(1) >= ST(0) will set either bit 8 or bit
	;;; 14 in the 387 status word: put an appropriate mask in CX and
	;;; jump to the comparison

	mov	cx, 04100h
	jmp	pfcmp

	align	4

DEF_C_LAB(_pfsgr)

	;;; Condition ST(1) > ST(0) sets bit 8 in the 387 status word:
	;;; put an appropriate mask in CX and fall through to the comparison

	mov	cx, 0100h

pfcmp:

	;;; Load DFLOAT1 into ST(1) and DFLOAT2 into ST(0).

	mov	esi, dword ptr [USP+4]
	fld	qword ptr [esi]
	mov	esi, dword ptr [USP]
	fld	qword ptr [esi]
	add	USP, 4

	;;; Compare and pop ST(0) & ST(1). Transfer the flags to AX.

	fcompp
	fstsw	ax

	;;; Mask the flags with the condition bits set earlier in CX

	test	ax, cx
	jnz	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

return_true:

	mov	dword ptr [USP], C_LAB(true)
	ret

	align	4


;;; === FLOATING POINT ARITHMETIC =====================================

;;; _PFABS:
;;;	Absolute value of a double float.

;;; Call:
;;;	_pfabs(_DFLOAT_ADDR);

DEF_C_LAB(_pfabs)

	mov	esi, dword ptr [USP]
	add	USP, 4

	;;; Clear the sign bit in the high word of the argument

	and	dword ptr [esi+4], 07fffffffh
	ret

	align	4

;;; _PFNEGATE:
;;;	Negate a double float.

;;; Call:
;;;	_pfnegate(_DFLOAT_ADDR);

DEF_C_LAB(_pfnegate)

	mov	esi, dword ptr [USP]
	add	USP, 4

	;;; Complement the sign bit in the high word of the argument

	btc	dword ptr [esi+4], 31
	ret

	align	4

;;; _PFADD:
;;; _PFSUB:
;;; _PFMULT:
;;; _PFDIV:
;;;	Double float dyadic maths operations. Return a boolean flag to
;;;	indicate whether or not the operation overflowed; the numeric
;;;	result is written back to the first argument.

;;; Example call:
;;;	_pfsub(_DFLOAT_ADDR_1, _DFLOAT_ADDR_2) -> BOOL
;;;	[means: DFLOAT1 := DFLOAT1 - DFLOAT2]

;;; Register usage:
;;;	EDI	_DFLOAT_ADDR_1 (which is also the destination address)
;;;	ESI	_DFLOAT_ADDR_2
;;;	EAX	work (used for overflow checking)
;;;	ST(0)	_DFLOAT_1

DEF_C_LAB(_pfadd)

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	fld	qword ptr [edi]
	fadd	qword ptr [esi]
	jmp	overflow_check

	align	4

DEF_C_LAB(_pfsub)

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	fld	qword ptr [edi]
	fsub	qword ptr [esi]
	jmp	overflow_check

	align	4

DEF_C_LAB(_pfmult)

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	fld	qword ptr [edi]
	fmul	qword ptr [esi]
	jmp	overflow_check

	align	4

DEF_C_LAB(_pfdiv)

	mov	esi, dword ptr [USP]
	mov	edi, dword ptr [USP+4]
	fld	qword ptr [edi]
	fdiv	qword ptr [esi]

overflow_check:

	;;; Pop result from ST(0) back to DFLOAT1 and pop the user stack

	fstp	qword ptr [edi]
	add	USP, 4
	wait

	;;; Load high word of result and check for exponent all 1's
	;;; (implies infinity/NaN). If OK, return <true>.

	mov	eax, dword ptr [edi+4]
	and	eax, D_EXP
	cmp	eax, D_EXP
	je	L$1$11
	mov	dword ptr [USP], C_LAB(true)
	ret

L$1$11:	;;; Overflow: return <false>

	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PFQREM:
;;;	Divide two double floats and return quotient and remainder.
;;;	Just uses POP-11 procedure -Float_qrem-.

DEF_C_LAB(_pfqrem)

	jmp	XC_LAB(Sys$-Float_qrem)

	align	4


/***************** end labels for wrapping structures *****************/

	.code
L$text_end:
L$text_size	equ	L$text_end-L$text_start
	.data
	assume	cs:nothing
L$data_end:
L$data_size	equ	L$data_end-L$data_start

/**********************************************************************/

@CurSeg	ends
	extern	C_LAB(Sys$-objmod_pad_key):near
	extern	C_LAB(false):near
	extern	C_LAB(true):near
	extern	XC_LAB(Sys$-Float_qrem):near
	end



/* --- Revision History ---------------------------------------------------
--- John Gibson, Feb 25 1995
	Removed _m*ath1/2 subroutines (library math functions now called
	via _extern)
 */
