/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 * File:        C.mips/src/aarith.s
 * Purpose:     Arithmetic routines for MIPS R2000/R3000
 * Author:      Robert Duncan and Simon Nichols, Feb 1 1990 (see revisions)
 */


#_<

#_INCLUDE 'declare.ph'

constant
	procedure Sys$-Array$-Sub_error
	;

lconstant macro (
	_PD_EXECUTE  		= @@PD_EXECUTE,
	_PD_ARRAY_TABLE		= @@PD_ARRAY_TABLE,
	_PD_ARRAY_VECTOR	= @@PD_ARRAY_VECTOR,
	_PD_ARRAY_SUBSCR_PDR	= @@PD_ARRAY_SUBSCR_PDR,

	;;; offset of true from false on the assumption that poplink
	;;; generates booleans in the order: false, true
	_TRUE_OFFS		= @@(struct BOOLEAN)++,
);

>_#

#_INCLUDE 'pop_regdef.h'


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

	.data
	.word	Ldata_size
	.word	C_LAB(Sys$-objmod_pad_key)
Ldata_start:

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


	.text

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

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

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

DEF_C_LAB 4 (_biset)

	.ent	$biset
$biset:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	or	v0, a0, a1
	sw	v0, (usp)
	j	ra

	.end	$biset

DEF_C_LAB 4 (_biclear)

	.ent	$biclear
$biclear:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	not	a1
	and	v0, a0, a1
	sw	v0, (usp)
	j	ra

	.end	$biclear

DEF_C_LAB 4 (_bimask)

	.ent	$bimask
$bimask:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	and	v0, a0, a1
	sw	v0, (usp)
	j	ra

	.end	$bimask

DEF_C_LAB 4 (_bixor)

	.ent	$bixor
$bixor:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	xor	v0, a0, a1
	sw	v0, (usp)
	j	ra

	.end	$bixor


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

;;; _MULT
;;;	Signed multiplication

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

DEF_C_LAB 4 (_mult)

	.ent	$mult
$mult:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	mult	a0, a1
	mflo	v0
	sw	v0, (usp)
	j	ra

	.end	$mult

;;; _DIV
;;;	Signed division

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

DEF_C_LAB 4 (_div)

	.ent	$div
$div:

	lw	a0, 4(usp)
	lw	a1, (usp)

	div	v0, a0, a1

	;;; Move remainder from HI to a1

	mfhi	v1

	;;; Stack quotient and remainder (with quotient on top)

	sw	v0, (usp)
	sw	v1, 4(usp)
	j	ra

	.end	$div

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

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

DEF_C_LAB 2 (_divq)

	.ent	$divq
$divq:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	div	v0, a0, a1
	sw	v0, (usp)
	j	ra

	.end	$divq

;;; _SHIFT
;;; 	Shift a machine integer by a signed quantity

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

DEF_C_LAB (_shift)

	.ent	$shift
$shift:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4

	;;; Test the sign of the shift

	bltz	a1, 1f

	;;; Sign is positive: shift left and return

	sll	v0, a0, a1
	sw	v0, (usp)
	j	ra

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

	neg	a1
	sra	v0, a0, a1
	sw	v0, (usp)
	j	ra

	.end	$shift


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

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

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

DEF_C_LAB 4 (_pmult)

	.ent	$pmult
$pmult:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4

	;;; Clear popint bits from first operand and convert second operand
	;;; to a system integer

	subu	a0, 3
	sra	a1, 2

	;;; Multiply a0 by a1 and stack the result with popint bits restored

	mult	a0, a1
	mflo	v0
	add	v0, 3
	sw	v0, (usp)
	j	ra

	.end	$pmult

;;; _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)

	.ent	$pmult_testovf
$pmult_testovf:

	lw	a0, 4(usp)
	lw	a1, (usp)

	;;; Clear popint bits from first operand and convert second operand
	;;; to a system integer

	subu	a0, 3
	sra	a1, 2

	;;; Multiply a0 by a1 and check for overflow

	mult	a0, a1
	mflo	v0
	mfhi	v1
	sra	t0, v0, 31
	bne	t0, v1, 1f

	;;; Stack the result with popint bits restored and return <true>

	add	v0, 3
	sw	v0, 4(usp)
	la	v1, _TRUE_OFFS(false)
	sw	v1, (usp)
	j	ra

1:	;;; Overflow -- return <false>

	sw	false, (usp)
	j	ra

	.end	$pmult_testovf

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

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

DEF_C_LAB 4 (_pdiv)

	.ent	$pdiv
$pdiv:

	lw	a0, 4(usp)
	lw	a1, (usp)

	;;; Convert operands to system integers

	sra	a0, 2
	sra	a1, 2

	;;; Divide a0 by a1

	div	v0, a0, a1
	mfhi	v1

	;;; Convert quotient and remainder back to popints and return
	;;; (with quotient on top)

	sll	v0, 2
	addu	v0, 3
	sw	v0, (usp)
	sll	v1, 2
	addu	v1, 3
	sw	v1, 4(usp)
	j	ra

	.end	$pdiv

;;; _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)

	.ent	$pint_testovf
$pint_testovf:

	lw	a0, (usp)

	;;; Shift a0 left by 2 and add 3.
	;;; Check for overflow as a result of the shift left, by shifting
	;;; right by 2 and comparing the result with the original value

	sll	v0, a0, 2
	sra	t0, v0, 2
	addu	v0, 3
	bne	t0, a0, 1f

	;;; No overflow -- return both the integer and <true>

	sw	v0, (usp)
	subu	usp, 4
	la	v1, _TRUE_OFFS(false)
	sw	v1, (usp)
	j	ra

1:	;;; Overflow -- return <false>

	sw	false, (usp)
	j	ra

	.end	$pint_testovf

;;; _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)

	.ent	$pshift_testovf
$pshift_testovf:

	lw	a0, 4(usp)
	lw	a1, (usp)

	;;; Clear popint bits from a0; if it's zero, there's no change

	subu	a0, 3
	beqz	a0, 1f

	;;; Otherwise, if the shift amount is > 30, the shift will
	;;; definitely overflow, so quit

	bgtu	a1, 30, 2f

	;;; Shift left, checking for overflow by shifting right by the same
	;;; amount and comparing the result with the original value

	sll	v0, a0, a1
	sra	t0, v0, a1
	bne	t0, a0, 2f

	;;; No overflow -- set the popint bits in v0, then return it and
	;;; <true>

	addu	v0, 3
	sw	v0, 4(usp)
1:	la	v1, _TRUE_OFFS(false)
	sw	v1, (usp)
	j	ra

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

	addu	usp, 4
	sw	false, (usp)
	j	ra

	.end	$pshift_testovf


;;; === 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)

	.ent	$emul
$emul:

	lw	a0, 4(usp)
	lw	a1, (usp)

	;;; a0 * a1 -> v1:v0

	mult	a0, a1
	mflo	v0
	mfhi	v1

	;;; Move the top bit of v0 into the bottom bit of v1

	sll	v1, 1
	bgez	v0, 1f
	or	v1, 1
	and	v0, 0x7FFFFFFF

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

	sw	v0, 4(usp)
	sw	v1, (usp)
	j	ra

	.end	$emul


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

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

;;; Register usage:
;;;	a0	high word of dividend
;;;	a1	low word of dividend
;;;	a2	divisor
;;;	cr	saved return address

;;; Uses:
;;;	ediv (defined below)

DEF_C_LAB (_ediv)

	.ent	$ediv
$ediv:

	;;; Save return address

	move	cr, ra

	;;; Load argument registers and call -ediv-

	lw	a0, 8(usp)
	lw	a1, 4(usp)
	lw	a2, (usp)
	addu	usp, 4
	bal	ediv

	;;; Quotient returned in v0 and remainder in v1

	sw	v0, (usp)
	sw	v1, 4(usp)
	j	cr

	.end	$ediv


;;; _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:
;;;	a0	multiplier
;;;	a1	source address
;;;	a2	source limit
;;;	a3	destination address
;;;	t0	carry slice
;;;	t1	(1) current slice
;;;		(2) low word result of multiplication
;;;	t2	high word result of multiplication
;;;	t3	(1) carry resulting from addition of previous carry slice
;;;		(2) sign of previous carry slice

DEF_C_LAB (_bgi_mult)

	.ent	$bgi_mult
$bgi_mult:

	lw	a0, 12(usp)
	lw	a1, 8(usp)
	lw	a2, 4(usp)
	lw	a3, (usp)
	addu	usp, 8

	;;; Initialise the carry slice (t0) to zero

	move	t0, zero

1:	;;; Repeat

	;;; load next slice into t1 and increment source address

	lw	t1, (a1)
	addu	a1, 4

	;;; Multiply slice by multiplier (a0) and move high half of double
	;;; length result to t2

	mult	t1, a0
	mflo	t1
	mfhi	t2

	;;; Add the previous carry slice to the result

	addu	t1, t0		;;; add to the low half
	sltu	t3, t1, t0	;;; carry out of addition to t3
	addu	t2, t3		;;; and add it to high half
	sra	t3, t0, 31	;;; get sign of previous carry slice
	addu	t2, t3		;;; and add it to high half

	;;; High half of result (t2) becomes next carry.
	;;; Shift top bit of low half of result (t1) into the bottom bit of
	;;; carry, and clear top bit in t1

	sll	t0, t2, 1
	bgez	t1, 2f
	or	t0, 1
	and	t1, 0x7FFFFFFF

2:	;;; Store low half of result at next destination address and
	;;; increment destination address

	sw	t1, (a3)
	addu	a3, 4

	;;; Until a1 = a2

	bne	a1, a2, 1b

	;;; Return carry slice and next destination pointer

	sw	t0, 4(usp)
	sw	a3, (usp)
	j	ra

	.end	$bgi_mult


;;; _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:
;;;	a0	multiplier
;;;	a1	source address
;;;	a2	source limit
;;;	a3	destination address
;;;	t0	(1) carry slice
;;;		(2) destination slice
;;;	t1	(1) current slice
;;;		(2) low word result of multiplication
;;;	t2	high word result of multiplication
;;;	t3	(1) carry resulting from addition of previous carry slice
;;;		(2) sign of previous carry slice

DEF_C_LAB (_bgi_mult_add)

	.ent	$bgi_mult_add
$bgi_mult_add:

	lw	a0, 12(usp)
	lw	a1, 8(usp)
	lw	a2, 4(usp)
	lw	a3, (usp)
	addu	usp, 8

	;;; Initialise the carry slice (t0) to zero

	move	t0, zero

1:	;;; Repeat

	;;; load next slice into t1 and increment source address

	lw	t1, (a1)
	addu	a1, 4

	;;; Multiply slice by multiplier (a0) and move high half of double
	;;; length result to t2

	mult	t1, a0
	mflo	t1
	mfhi	t2

	;;; Add the previous carry slice to the result

	addu	t1, t0		;;; add to the low half
	sltu	t3, t1, t0	;;; carry out of addition to t3
	addu	t2, t3		;;; and add it to high half
	sra	t3, t0, 31	;;; get sign of previous carry slice
	addu	t2, t3		;;; and add it to high half

	;;; Load the next destination slice into t0 and add it to result
	;;; (just like the carry slice)

	lw	t0, (a3)	;;; load destination slice
	addu	t1, t0		;;; add to the low half
	sltu	t3, t1, t0	;;; carry out of addition to t3
	addu	t2, t3		;;; and add it to high half
	sra	t3, t0, 31	;;; get sign of previous carry slice
	addu	t2, t3		;;; and add it to high half

	;;; High half of result (t2) becomes next carry.
	;;; Shift top bit of low half of result (t1) into the bottom bit of
	;;; carry, and clear top bit in t1

	sll	t0, t2, 1
	bgez	t1, 2f
	or	t0, 1
	and	t1, 0x7FFFFFFF

2:	;;; Store low half of result at next destination address and
	;;; increment destination address

	sw	t1, (a3)
	addu	a3, 4

	;;; Until a1 = a2

	bne	a1, a2, 1b

	;;; Return carry slice and next destination pointer

	sw	t0, 4(usp)
	sw	a3, (usp)
	j	ra

	.end	$bgi_mult_add


;;; _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:
;;;	a2	divisor
;;;	t0	used by -ediv-
;;;	t1	used by -ediv-
;;;	t2	used by -ediv-
;;;	t3	used by -ediv-
;;;	t4	source start address
;;;	t5	(1) source limit address
;;;		(2) source pointer
;;;	t6	(1) destination limit address
;;;		(2) destination pointer
;;;	cr	saved return address

;;; Uses:
;;;	ediv

DEF_C_LAB (_bgi_div)

	.ent	$bgi_div
$bgi_div:

	;;; Save return address in cr

	move	cr, ra

	;;; Load divisor to a2, for calls to -ediv-

	lw	a2, 12(usp)

	;;; Load remaining arguments to temporary registers

	lw	t4, 8(usp)
	lw	t5, 4(usp)
	lw	t6, (usp)
	addu	usp, 12

	;;; Load first slice to a1 and divide using DIV instruction,
	;;; leaving quotient in v0 and remainder in v1

	lw	a1, -4(t5)
	div	v0, a1, a2
	mfhi	v1

	b	2f

	;;; Loop to divide remaining slices, using -ediv- routine.

1:	;;; Repeat

	;;; Move remainder to a0, load next slice to a1 and call -ediv-

	move	a0, v1
	lw	a1, -4(t5)
	bal	ediv

2:	;;; Store quotient at destination

	sw	v0, -4(t6)

	;;; Decrement source and destination pointers

	subu	t5, 4
	subu	t6, 4

	;;; Until t4 = t5

	bne	t4, t5, 1b

	;;; Return last remainder

	sw	v1, (usp)
	j	cr

	.end	$bgi_div


;;; EDIV:
;;;	Divide a double-word (64-bit) signed integer by a single-word
;;;	signed integer.

;;; Arguments:
;;;	a0	high word of dividend
;;;	a1	low word of dividend
;;;	a2	divisor

;;; Results:
;;;	v0	quotient
;;;	v1	remainder

;;; Other registers used:
;;;	t0	sign of dividend
;;;	t1	sign of divisor
;;;	t2	loop counter
;;;	t3	sign of low word of dividend after shifting, in loop

	.ent	ediv
ediv:

	;;; Set t0 and t1 according to the signs of the dividend and divisor

	slt	t0, a0, zero
	slt	t1, a2, zero

	;;; If the dividend is negative, make it positive

	beqz	t0, 1f
	negu	a1
	not	a0
	bltz	a1, 1f
	addu	a0, 1

1:	;;; If the divisor is negative, make it positive

	beqz	t1, 2f
	negu	a2

	;;; If result is still negative, the negation has overflowed due to
	;;; divisor being the largest -ve number. In this case the quotient
	;;; is the high word of dividend and the remainder is the low word
	;;; (with high bit cleared)

	bgez	a2, 2f
	move	v0, a0
	and	a1, 0x7fffffff
	b	3f

2:	;;; Compute quotient and remainder

	;;; Initialise quotient (v0) to zero

	move	v0, zero
#_<
lvars i;
for i from 1 to 31 do

	;;; Shift dividend left by one

'	sll	a1, 1				\n',
'	slt	t3, a1, zero			\n',
'	sll	a0, 1				\n',
'	or	a0, t3				\n',

	;;; Reduce dividend by divisor

'	bgtu	a2, a0, 3f			\n',
'	subu	a0, a2				\n',
'	or	v0, 1 << (31 - ' >< i <> ')	\n',
'3:						\n'

endfor
>_#
	;;; If dividend was negative, negate remainder

	beqz	t0, 4f
	negu	a0

4:	;;; If dividend and divisor have different signs, negate quotient

	beq	t0, t1, 5f
	negu	v0

5:	;;; Return quotient in v0, remainder in v1

	move	v1, a0
	j	ra

	.end	ediv


;;; === 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:
;;;	t0 	accumulates the total subscript
;;;	t1 	(1) pointer into procedure table
;;; 		(2) array vector
;;;	t2 	(1) dimension
;;; 		(2) array subscript procedure
;;; 	t3	lower bound
;;;	t4	scaling factor
;;;	t5 	index
;;; 	t6	bit 1 of index (test for popint)

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

DEF_C_LAB (_array_sub)

	.ent	$array_sub
$array_sub:

	;;; Initialise t1 to point at the array parameters

	la	t1, _PD_ARRAY_TABLE(pb)

	;;; Initialise t0 with subscript offset

	lw	t0, (t1)
	addu	t1, 4

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

	lw	t2, (t1)
	beqz	t2, 3f

1:	;;; Repeat

	;;; Get remaining parameters for this dimension

	lw	t3, 4(t1)	;;; lower bound
	lw	t4, 8(t1)	;;; scaling factor
	lw	t5, (usp)	;;; index
	addu	usp, 4

	;;; Check the index is a pop integer

	and	t6, t5, 2
	beqz	t6, array_sub_error

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

	subu	t5, t3
	bgeu	t5, t2, array_sub_error

	;;; Load next dimension to t2

	addu	t1, 12
	lw	t2, (t1)

	;;; Scale the index and add to the running total (NB: 0 means 1,
	;;; so don't multiply!)

	beqz	t4, 2f
	multu	t5, t4
	mflo	t5
2:	addu	t0, t5

	;;; Until t2 = 0

	bnez	t2, 1b

3:	;;; Finished -- push total subscript to stack, push array vector
	;;; to stack, and then chain subscripting procedure

	subu	usp, 8
	sw	t0, 4(usp)
	lw	t1, _PD_ARRAY_VECTOR(pb)
	sw	t1, (usp)
	lw	t2, _PD_ARRAY_SUBSCR_PDR(pb)
	lw	t9, _PD_EXECUTE(t2)
	j	t9

	.end	$array_sub

	.ent	array_sub_error
array_sub_error:

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

	subu	usp, 4			;;; reveal the last index again

	;;; access to the Sub_error procedure address needs the context
	;;; pointer set, but that in turn needs the current instruction
	;;; pointer: we can get that with a local branch and link

	.set	noreorder
	bal	1f
	nop
1:	CPLOAD	ra
	.set	reorder
	jal	XC_LAB(weakref Sys$-Array$-Sub_error)

	;;; in case that error returns (will it ever?)

	.set	noreorder
	bal	2f
	nop
2:	CPLOAD	ra
	.set	reorder
	jal	XC_LAB(setpop)

	.end	array_sub_error


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

	.data
Ldata_end:
Ldata_size = 0 ##PATCH## Ldata_size Ldata_end Ldata_start

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


/* --- Revision History ---------------------------------------------------
--- Robert John Duncan, Aug 31 1994
	Changes to _array_sub
--- Robert John Duncan, Mar 22 1994
	Removed procedure assignments to a0 (again)
--- Robert John Duncan, Mar 15 1994
	Removed the wrapping structure from the text section
--- Robert John Duncan, Mar 15 1994
	Pop calls must now set a0 to the procedure address
--- Robert John Duncan, Mar  9 1994
	Added directives for position-independent code. Changed not to use
	register t8, now reassigned to the special var block.
--- Robert John Duncan, Mar  8 1994
	Added .ent/.end directives
--- Robert John Duncan, Mar  7 1994
	Changed not to use register t9
 */
