/* --- Copyright University of Sussex 1995. All rights reserved. ----------
 * File:		S.pcwnt/src/aarith.s
 * Purpose:		Arithmetic for Intel 80x86 (Microsoft assembler)
 * Author:		Robert John Duncan, Apr 15 1994 (see revisions)
 * Documentation:
 * Related Files:	S.pcunix/src/aarith.s
 */

/*************************************************************************
		THIS FILE WAS GENERATED AUTOMATICALLY FROM
		 /rsuna/pop/master/S.pcunix/src/aarith.s
		     ON Fri Apr 15 10:37:29 BST 1994
	  AND SUBSEQUENTLY EDITED ON Fri Apr 15 10:46:03 BST 1994
*************************************************************************/

#_<

#_INCLUDE 'declare.ph'

constant
	procedure Sys$-Array$-Sub_error
	;

lconstant macro	(

	USP			= "ebx",
	PB			= "ebp",

	_PD_EXECUTE  		= @@PD_EXECUTE,
	_PD_ARRAY_TABLE		= @@PD_ARRAY_TABLE,
	_PD_ARRAY_VECTOR	= @@PD_ARRAY_VECTOR,
	_PD_ARRAY_SUBSCR_PDR	= @@PD_ARRAY_SUBSCR_PDR,

);

>_#

	.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:

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


	.code

;;; === LOGICAL BIT ROUTINES ==========================================

;;; _BISET
;;; _BICLEAR
;;; _BIMASK
;;; _BIXOR
;;; 	Bit operations on machine integers

;;; Call:
;;;	_I _bitop _J -> _K

DEF_C_LAB 4 (_biset)

	mov	eax, dword ptr [USP]
	add	USP, 4
	or	dword ptr [USP], eax
	ret

	align	4

DEF_C_LAB 4 (_biclear)

	mov	eax, dword ptr [USP]
	add	USP, 4
	not	eax
	and	dword ptr [USP], eax
	ret

	align	4

DEF_C_LAB 4 (_bimask)

	mov	eax, dword ptr [USP]
	add	USP, 4
	and	dword ptr [USP], eax
	ret

	align	4

DEF_C_LAB 4 (_bixor)

	mov	eax, dword ptr [USP]
	add	USP, 4
	xor	dword ptr [USP], eax
	ret

	align	4


;;; === MACHINE INTEGER ARITHMETIC ====================================

;;; _MULT
;;;	Signed multiplication

;;; Call:
;;;	_I _mult _J -> _K

DEF_C_LAB 4 (_mult)

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

	;;; Multiply EAX by (%USP); result goes to EDX:EAX

	imul	dword ptr [USP]

	;;; Return low half of result

	mov	dword ptr [USP], eax
	ret

	align	4

;;; _DIV
;;;	Signed division

;;; Call:
;;;	_I _div _J -> _QUOT -> _REM

DEF_C_LAB 4 (_div)

	;;; Move the dividend into EAX and sign-extend into EDX:EAX

	mov	eax, dword ptr [USP+4]
	cdq

	;;; Divide EDX:EAX by the divisor, (%USP),
	;;; leaving the quotient in EAX and remainder in EDX

	idiv	dword ptr [USP]

	;;; Stack the remainder, then the quotient

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

	align	4

;;; _DIVQ
;;;	Signed division, quotient only

;;; Call:
;;;	_I _divq _J -> _QUOT

DEF_C_LAB 2 (_divq)

	;;; Move the dividend into EAX and sign-extend into EDX:EAX

	mov	eax, dword ptr [USP+4]
	cdq

	;;; Divide EDX:EAX by the divisor, (%USP),
	;;; leaving the quotient in EAX and remainder in EDX

	idiv	dword ptr [USP]

	;;; Stack the quotient
	mov	dword ptr [USP+4], eax
	add	USP, 4
	ret

	align	4

;;; _M_ASH
;;; 	Shift a machine integer by a signed quantity.
;;; 	This implements the M_ASH M-code instruction for a non-immediate
;;; 	shift. It can't be called generally from POP because it expects
;;; 	its arguments in registers rather than on the user stack.
;;; 	(cf. -C_LAB(_shift)- below)

;;; Arguments:
;;;	EAX	integer to be shifted
;;;	ECX	amount of the shift -- positive means left shift,
;;;		negative means right shift
;;; Results:
;;;	EAX	the shifted word

DEF_C_LAB(_m_ash)

	;;; Test the sign of the shift

	test	ecx, ecx
	js	L$1$1

	;;; Sign is positive: shift left and return

	sal	eax, cl
	ret

L$1$1:	;;; Sign is negative: shift right by the absolute amount and return

	neg	ecx
	sar	eax, cl
	ret

	align	4

;;; _SHIFT
;;; 	POP interface to _M_ASH: arguments and results go via the user stack

;;; Call:
;;;	_shift(_I, _J) -> _K

DEF_C_LAB(_shift)

	mov	ecx, dword ptr [USP]
	add	USP, 4
	mov	eax, dword ptr [USP]
	call	C_LAB(_m_ash)
	mov	dword ptr [USP], eax
	ret

	align	4


;;; === POP INTEGER ARITHMETIC ========================================

;;; _PMULT
;;;	POP integer multiply, with no overflow check (implements fi_*)

;;; Call:
;;;	I _pmult J -> K

DEF_C_LAB 4 (_pmult)

	;;; Pop the first popint into EAX, and make it a machine integer

	mov	eax, dword ptr [USP]
	add	USP, 4
	sar	eax, 2

	;;; Copy the second operand into EDX and clear the popint bits

	mov	edx, dword ptr [USP]
	sub	edx, 3

	;;; Multiply EAX by EDX; result goes to EDX:EAX

	imul	edx

	;;; Return lower half of result (EAX) with popint bits restored

	add	eax, 3
	mov	dword ptr [USP], eax
	ret

	align	4

;;; _PMULT_TESTOVF
;;;	Multiply two simple pop integers with a test for overflow.
;;;	Returns a result, plus <true> if OK or <false> if overflow.

;;; Call:
;;;	_pmult_testovf(I, J) -> BOOL -> K

DEF_C_LAB(_pmult_testovf)

	;;; Copy the first popint into EAX, and make it a machine integer

	mov	eax, dword ptr [USP]
	sar	eax, 2

	;;; Copy the second operand into EDX and clear the popint bits

	mov	edx, dword ptr [USP+4]
	sub	edx, 3

	;;; Multiply EAX by EDX; result goes to EDX:EAX
	;;; Overflow flag will be set if EDX:EAX is not a sign-extension
	;;; of EAX

	imul	edx

	;;; Reset the popint bits in the lower half of the result (EAX)
	;;; and put on the stack; LEAL and MOVL won't change the flags

	lea	eax, dword ptr [eax+3]
	mov	dword ptr [USP+4], eax

	;;; Return <true> for OK, <false> for overflow

	jo	L$1$2
	mov	dword ptr [USP], C_LAB(true)
	ret
L$1$2:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PDIV:
;;;	Divide two simple pop integers with no checking (implements fi_//)

;;; Call:
;;;	I _pdiv J -> QUOT -> REM

DEF_C_LAB 4 (_pdiv)

	;;; Copy the dividend into EAX, convert it to a machine integer
	;;; and sign-extend through EDX:EAX

	mov	eax, dword ptr [USP+4]
	sar	eax, 2
	cdq

	;;; Copy the divisor to ECX and convert to a machine integer

	mov	ecx, dword ptr [USP]
	sar	ecx, 2

	;;; Divide EDX:EAX by ECX, leaving the quotient in EAX and
	;;; remainder in EDX

	idiv	ecx

	;;; Convert quotient and remainder back to popints and return

	lea	edx, dword ptr [edx*4+3]
	mov	dword ptr [USP+4], edx
	lea	eax, dword ptr [eax*4+3]
	mov	dword ptr [USP], eax
	ret

	align	4

;;; _PINT_TESTOVF:
;;;	Convert machine integer to pop integer, checking for overflow.
;;;	Returns a popint plus <true> if OK, or just <false> if overflow.

;;; Call:
;;;	_pint_testovf(_I) -> <true> -> I
;;;	_pint_testovf(_I) -> <false>

DEF_C_LAB(_pint_testovf)

	;;; The conversion is just (_I << 2 + 3), but the shift has to be
	;;; done in two 1-bit steps to allow the test

	mov	eax, dword ptr [USP]
	sal	eax, 1
	jo	L$1$3
	sal	eax, 1
	jo	L$1$3
	add	eax, 3
	mov	dword ptr [USP], eax
	sub	USP, 4
	mov	dword ptr [USP], C_LAB(true)
	ret
L$1$3:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _PSHIFT_TESTOVF:
;;;	Left-shift a simple popint by a positive machine integer amount,
;;;	and test for overflow. Returns a popint result plus <true> if OK,
;;;	or just <false> for overflow.

;;; Call:
;;;	_pshift_testovf(I, _N) -> <true> -> J
;;;	_pshift_testovf(I, _N) -> <false>

DEF_C_LAB(_pshift_testovf)

	;;; Copy the popint (I) to EAX and clear the popint bits.
	;;; If it's zero, there's no need to shift.

	mov	eax, dword ptr [USP+4]
	sub	eax, 3
	je	L$1$4

	;;; Copy the shift amount (_N) to ECX. If it's > 30, then the shift
	;;; will definitely overflow, so jump out.

	mov	ecx, dword ptr [USP]
	cmp	ecx, 30
	jg	L$2$1

	;;; The left shift (SALL) only sets the overflow flag for a shift
	;;; of 1 bit, so to do the test we have to make a copy of the
	;;; original number in ESI, do the shift, then do a right shift by
	;;; the same amount and compare the result with the copied original.
	;;; If they're not the same, the left shift must have overflowed.

	mov	esi, eax
	sal	eax, cl
	mov	edx, eax
	sar	edx, cl
	cmp	esi, edx
	jne	L$2$1

	;;; No overflow -- reset the popint bits in EAX, then return it
	;;; with <true>

	add	eax, 3
	mov	dword ptr [USP+4], eax
L$1$4:	mov	dword ptr [USP], C_LAB(true)
	ret

L$2$1:	;;; Overflow -- pop the stack and return <false>

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

	align	4

;;; === BIGINTEGER ARITHMETIC =========================================

;;; _EMUL:
;;; _POSWORD_EMUL:
;;;	Multiply two biginteger slices to get a double length result.
;;;	A "slice" is a full word, but only the lower 31 bits are used;
;;;	the top bit is always 0.

;;; Call:
;;;	_emul(_MULTIPLICAND, _MULTIPLIER) -> _HIPART -> _LOPART

DEF_C_LAB(_emul)
DEF_C_LAB(_posword_emul)

	;;; Copy argument slices to EAX, EDX

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

	;;; Multiply EAX by EDX, leaving double length result in EDX:EAX

	imul	edx

	;;; Shift the top bit of the low half (EAX) into the bottom bit of
	;;; the high half (EDX), then clear the top bit in EAX

	shld	edx, eax, 1
	and	eax, 07FFFFFFFh

	;;; Return the low part, then the high part

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

	align	4

;;; _EDIV:
;;;	Divide a two-slice dividend by a single divisor.

;;; Call:
;;;	_ediv(_HIPART, _LOPART, _DIVISOR) -> _QUOT -> _REM

DEF_C_LAB(_ediv)

	;;; Pop divisor into ECX, then move lopart/hipart into EAX/EDX

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

	;;; Combine the two slices by shifting EDX right 1, and transferring
	;;; its bottom bit into the top bit of EAX.

	sal	eax, 1
	shrd	eax, edx, 1
	sar	edx, 1

	;;; Divide EDX:EAX by ECX

	idiv	ecx

	;;; Return the remainder, then the quotient

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

	align	4

;;; _BGI_MULT:
;;;	Multiply a biginteger by a signed machine integer and store the
;;;	result in a destination bigint. Return a pointer to the next free
;;;	slice in the destination and the last carry slice.

;;; Call:
;;; 	_bgi_mult(_MULTIPLIER, _SRCADDR, _SRCLIM, _DSTADDR) -> _NEXT_DSTADDR
;;;							    -> _CARRY

;;; Register usage:
;;;	ESI	source pointer
;;;	EDI	destination pointer
;;;	EAX	working slice; the low half of multiplications
;;;	EDX	the high half of multiplications
;;;	ECX	the carry slice

;;; Memory usage:
;;;	4(%USP)	the multiplier, left on the user stack
;;;	SRCLIM	the source limit -- points one beyond the end of the source

DEF_C_LAB(_bgi_mult)

	;;; Load arguments to registers

	mov	edi, dword ptr [USP]	;;; destination start
	mov	eax, dword ptr [USP+4]	;;; source limit
	mov	esi, dword ptr [USP+8]	;;; source start
	add	USP, 8

	;;; Save the source limit

	mov	dword ptr SRCLIM, eax

	;;; Initialise the carry slice to zero

	mov	ecx, 0

	;;; Clear the direction flag: ESI/EDI are to be incremented after
	;;; each slice is loaded/stored

	cld

L$1$5:	;;; Top of loop:
	;;; load the next slice into EAX and multiply into EDX:EAX

	lodsd
	imul	dword ptr [USP+4]

	;;; Add the previous carry slice to the double-length result.

	add	eax, ecx	;;; Add to the low half
	adc	edx, 0	;;; and carry into the high half.
	sar	ecx, 31	;;; Shift the sign of the carry into ECX
	add	edx, ecx	;;; and add it into the high half

	;;; Shift the top bit of EAX into the bottom bit of EDX and zero
	;;; the top bit of EAX

	shld	edx, eax, 1
	and	eax, 07FFFFFFFh

	;;; Store EAX into the next destination slice, and make EDX the
	;;; next carry slice

	stosd
	mov	ecx, edx

	;;; Compare the source pointer (ESI) with the source limit;
	;;; loop if ESI < SRCLIM.

	cmp	dword ptr SRCLIM, esi
	ja	L$1$5

	;;; Finished -- return the carry slice, then the next destination
	;;; pointer

	mov	dword ptr [USP+4], ecx
	mov	dword ptr [USP], edi
	ret

	align	4

;;; _BGI_MULT_ADD:
;;;	Multiply a biginteger by a signed machine integer and add it into
;;;	a destination bigint. Returns pointer to the next free slice in the
;;;	destination, and the last carry slice.

;;; Call:
;;; 	_bgi_mult_add(_MULTIPLIER, _SRCADDR, _SRCLIM, _DSTADDR)
;;;						-> _NEXT_DSTADDR -> _CARRY

;;; Register usage:
;;;	ESI	source pointer
;;;	EDI	destination pointer
;;;	EAX	working slice; the low half of multiplications
;;;	EDX	the high half of multiplications
;;;	ECX	the carry slice and the destination slice for the addition

;;; Memory usage:
;;;	4(%USP)	the multiplier, left on the user stack
;;;	SRCLIM	the source limit -- points one beyond the end of the source
;;;		(declared above)

DEF_C_LAB(_bgi_mult_add)

	;;; Load arguments to registers

	mov	edi, dword ptr [USP]	;;; destination start
	mov	eax, dword ptr [USP+4]	;;; source limit
	mov	esi, dword ptr [USP+8]	;;; source start
	add	USP, 8

	;;; Save the source limit

	mov	dword ptr SRCLIM, eax

	;;; Set the initial carry slice to zero

	mov	ecx, 0

	;;; Clear the direction flag: ESI/EDI are to be incremented after
	;;; each slice is loaded/stored

	cld

L$1$6:	;;; Top of loop:
	;;; load the next slice into EAX and multiply into EDX:EAX

	lodsd
	imul	dword ptr [USP+4]

	;;; Add the previous carry slice to the double-length result.

	add	eax, ecx
	adc	edx, 0
	sar	ecx, 31
	add	edx, ecx

	;;; Load the next destination slice into ECX and add it into
	;;; EDX:EAX (just like the carry slice)

	mov	ecx, dword ptr [edi]
	add	eax, ecx
	adc	edx, 0
	sar	ecx, 31
	add	edx, ecx

	;;; Shift the top bit of EAX into the bottom bit of EDX and zero
	;;; the top bit of EAX

	shld	edx, eax, 1
	and	eax, 07FFFFFFFh

	;;; Store EAX into the next destination slice, and make EDX the
	;;; next carry slice

	stosd
	mov	ecx, edx

	;;; Compare the source pointer (ESI) with the source limit;
	;;; loop if ESI < SRCLIM

	cmp	dword ptr SRCLIM, esi
	ja	L$1$6

	;;; Finished -- return carry slice, then the next destination
	;;; pointer

	mov	dword ptr [USP+4], ecx
	mov	dword ptr [USP], edi
	ret

	align	4

;;; _BGI_DIV:
;;;	Divide a biginteger by a signed machine integer into a destination
;;; 	bigint and return the last remainder.

;;; Call:
;;;	_bgi_div(_DIVISOR, _SRCADDR, _SRCLIM, _DSTLIM) -> _REM

;;; Register usage:
;;;	ESI	source pointer
;;;	EDI	destination pointer
;;;	EAX	working slice; low half of the dividend; quotient
;;;	EDX	high half of the dividend; remainder
;;;	ECX	start of the source bigint

;;; Memory usage:
;;;	(%USP)	the divisor, left on the user stack

DEF_C_LAB(_bgi_div)

	;;; Load arguments to registers

	mov	edi, dword ptr [USP]	;;; destination end
	mov	esi, dword ptr [USP+4]	;;; source end
	mov	ecx, dword ptr [USP+8]	;;; source start
	add	USP, 12

	;;; Set the direction flag:
	;;; division works from the last slice back to the first slice,
	;;; so ESI/EDI must be decremented after each load/store.

	std

	;;; ESI and EDI point one beyond the last source and destination
	;;; slices, so do an initial adjustment

	sub	esi, 4
	sub	edi, 4

	;;; Load the top source slice (which carries the sign bit) into EAX;
	;;; sign-extend into EDX:EAX then branch to do the first division

	lodsd
	cdq
	jmp	L$2$2

L$1$7:	;;; Top of loop: load the next source slice into EAX

	lodsd

	;;; Combine it with the remainder from the previous division
	;;; (i.e. shift the bottom bit of EDX into the top of EAX)

	sal	eax, 1
	shrd	eax, edx, 1
	sar	edx, 1

L$2$2:	;;; Divide EDX:EAX by (%USP); remainder goes to EDX, quotient to EAX

	idiv	dword ptr [USP]

	;;; Store the quotient at the destination

	stosd

	;;; Compare the source pointer (ESI) with the source start (ECX);
	;;; loop if ESI >= ECX

	cmp	ecx, esi
	jbe	L$1$7

	;;; Finished -- return the last remainder

	mov	dword ptr [USP], edx
	ret

	align	4


;;; === COMPUTE ARRAY SUBSCRIPTS ======================================

;;; _ARRAY_SUB:
;;;	computes the total subscript for a multi-dimensional array.

;;; Call:
;;;	_array_sub(/* INDEXES */) -> _SUBSCRIPT;

;;; Arguments:
;;;     A set of indexes on the stack, one for each dimension. The array
;;;     procedure table contains additional parameters arranged as
;;;     follows:

;;; 	    offset			;;; popint
;;;	    dimension-1			;;; sysint, base 0
;;;	    lower_bound-1		;;; popint
;;;	    scale_factor-1		;;; sysint
;;;		...
;;;	    dimension-n
;;;	    lower_bound-n
;;;	    scale_factor-n
;;;	    0				;;; marks the end

;;; Register usage:
;;;	ECX	accumulates the total subscript
;;;	ESI	pointer into procedure table
;;;	EAX	dimension; scale factor; scale factor * index
;;;	EDX	index

;;; Usage:
;;;	called from Cons_array; parameters set up by Array$-Get

DEF_C_LAB(_array_sub)

	;;; Initialise ESI to point at array parameters

	lea	esi, dword ptr [PB+_PD_ARRAY_TABLE]
	cld

	;;; Initialise ECX with subscript offset

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

	;;; Load first dimension to EAX: may be zero already for a
	;;; 0-dimensional array

	lodsd
	test	eax, eax
	jz	L$1$10

L$1$8:	;;; Start of loop:
	;;; get the next index from the stack into EDX and check it's
	;;; a pop integer

	mov	edx, dword ptr [USP]
	add	USP, 4
	test	edx, 2
	jz	array_sub_error

	;;; Subtract the next lower bound from the index and check it for
	;;; range against the dimension in EAX.
	;;; Both index and lower bound are popints; the subtraction clears
	;;; the bottom two bits.

	sub	edx, dword ptr [esi]
	add	esi, 4			;;; bump up the arg pointer
	cmp	edx, eax
	jae	array_sub_error

	;;; Get the dimension scaling factor in EAX and use it to scale
	;;; the index (NB: 0 means 1, so don't multiply!)

	lodsd
	test	eax, eax
	jz	L$1$9
	imul	edx, eax

L$1$9:	;;; Add to the running total

	add	ecx, edx

	;;; Get the next dimension in EAX and loop if non-zero

	lodsd
	test	eax, eax
	jnz	L$1$8

L$1$10:	;;; Finished -- push total subscript to stack, push array vector
	;;; to stack, and then chain subscripting procedure

	sub	USP, 8
	mov	dword ptr [USP+4], ecx
	mov	eax, dword ptr [PB+_PD_ARRAY_VECTOR]
	mov	dword ptr [USP], eax
	mov	eax, dword ptr [PB+_PD_ARRAY_SUBSCR_PDR]
	jmp	dword ptr [eax+_PD_EXECUTE]

array_sub_error:

	;;; Index on top of stack is invalid (either not a popint, or
	;;; out of range)

	sub	USP, 4		;;; reveal the last index again
	call	XC_LAB(weakref Sys$-Array$-Sub_error)
	call	XC_LAB(setpop)	;;; in case the error returns

	align	4

	.data
	assume	cs:nothing
SRCLIM:
	dword	0

/***************** 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(setpop):near
	extern	XC_LAB(weakref Sys$-Array$-Sub_error):near
	end


/* --- Revision History ---------------------------------------------------
--- Robert John Duncan, Sep 13 1995
	Added missing declarations
--- Robert John Duncan, Jan 11 1995
	Fixed bug in _array_sub for case where scale factor = 0 (copied
	from S.pcunix version)
--- Robert John Duncan, Sep  1 1994
	Changes to _array_sub (new version generated automatically from
	S.pcunix/src/aarith.s)
 */
