/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 * File:        C.mips/src/aprolog.s
 * Purpose:     Assembler support for Prolog on MIPS R2000/R3000
 * Author:      Robert Duncan and Simon Nichols, Feb 7 1990 (see revisions)
 */


#_<

#_INCLUDE 'declare.ph'

constant
	procedure (Sys$-Plog$-Assign_pair, Sys$-Plog$-New_var),
	_checkplogall
	;

vars
	_plog_trail_sp, _plog_next_var, _plog_contn_sp, _plog_contn_top,
	_plog_save_contn_sp, _plog_trail_barrier, _plog_trail_lim,
	_call_stack_lim
	;

lconstant macro	(

	;;; Structure offsets

	_KEY			= @@KEY,
	_PGT_FUNCTOR		= @@PGT_FUNCTOR,
	_PGT_LENGTH		= @@PGT_LENGTH,
	_PGV_CONT		= @@PGV_CONT,
	_PGV_SIZE		= @@(struct PLOGVAR)++,
	_P_BACK			= @@P_BACK,
	_P_FRONT		= @@P_FRONT,
	_SF_PLGSV_CONTN_TOP	= @@SF_PLGSV_CONTN_TOP,
	_SF_PLGSV_NEXT_VAR	= @@SF_PLGSV_NEXT_VAR,
	_SF_PLGSV_TRAIL_SP	= @@SF_PLGSV_TRAIL_SP,

);

>_#

#_INCLUDE 'pop_regdef.h'


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

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

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


	.text

;;; === SAVING AND RESTORING THE PROLOG STATE =========================

;;; _PROLOG_SAVE_CHECK:
;;;	Saves the prolog continuation stack, trail and next_free_var pointers
;;;	in their corresponding saved locations, then does stack overflow and
;;;	interrupt checks.

;;; Call:
;;;	_prolog_save_check();

;;; Register usage:
;;;	t1 	trail sp
;;;	t2	(1) trail barrier
;;;		(2) continuation sp
;;;		(3) trail limit
;;;	t3 	(1) next variable pointer
;;;		(2) continuation top
;;;		(3) call stack limit
;;;	t4	user stack limit
;;;	t5	interrupt flag
;;;	t6	work

;;; Usage:
;;;	does procedure entry checking for procedures using PLOG_SAVE and
;;;	PLOG_RESTORE

DEF_C_LAB (_prolog_save_check)

	.ent	$prolog_save_check
$prolog_save_check:
	.set	noreorder

	lw	t1, _SVB_OFFS(_plog_trail_sp)(svb)
	lw	t2, _SVB_OFFS(_plog_trail_barrier)(svb)
	lw	t3, _SVB_OFFS(_plog_next_var)(svb)

	;;; Save trail stack pointer (t1), relative to trail barrier (t2)

	subu	t6, t1, t2
	sw	t6, _SF_PLGSV_TRAIL_SP(sp)

	;;; Save next variable pointer

	sw	t3, _SF_PLGSV_NEXT_VAR(sp)

	;;; Save continuation stack top and pointer

	lw	t2, _SVB_OFFS(_plog_contn_sp)(svb)
	lw	t3, _SVB_OFFS(_plog_contn_top)(svb)
	sw	t2, _SVB_OFFS(_plog_save_contn_sp)(svb)
	sw	t3, _SF_PLGSV_CONTN_TOP(sp)

	;;; Do stack overflow and interrupt checks:

	lw	t2, _SVB_OFFS(_plog_trail_lim)(svb)
	lw	t3, _SVB_OFFS(_call_stack_lim)(svb)
	lw	t4, _SVB_OFFS(_userlim)(svb)
	lw	t5, _SVB_OFFS(_trap)(svb)

	sltu	t6, t1, t2	;;; trail sp >= trail lim
	beqz	t6, 1f
	sltu	t6, sp, t3	;;; sp < call stack lim
	bnez	t6, 1f
	sltu	t6, usp, t4	;;; usp < userlim
	bnez	t6, 1f
	and	t6, t5, 1	;;; interrupt
	bnez	t6, 1f
	nop

	j	ra		;;; OK
	nop

1:	;;; Redo checks

	addu	t9, 104		;;; t9 = $prolog_save_check + 26*4
	CPLOAD	t9              ;;; t9 now points here

	.set	reorder

	la	t9, C_LAB(_checkplogall)
	j	t9

	.end	$prolog_save_check


;;; _PROLOG_RESTORE:
;;;	Restores prolog continuation stack, trail and next_free_var pointer
;;;	from the values saved by the last -plog_save_check-, and unwinds
;;;	the trail back to the restored position, resetting vars to undef.

;;; Call:
;;;	_prolog_restore();

;;; Register usage:
;;;	t1	(1) saved continuation stack pointer
;;;		(2) saved trail end pointer
;;;	t2	(1) saved continuation stack top
;;;		(2) current trail end pointer
;;;	t3	(1) saved next variable pointer
;;;		(2) trail barrier
;;;	t4	prologvar

;;; Usage:
;;;	does procedure entry checking for procedures using PLOG_SAVE and
;;;	PLOG_RESTORE

DEF_C_LAB (_prolog_restore)

	.ent	$prolog_restore
$prolog_restore:
	.set	noreorder

	;;; Restore continuation stack top, continuation stack pointer and
	;;; next variable pointer

	lw	t1, _SVB_OFFS(_plog_save_contn_sp)(svb)
	lw	t2, _SF_PLGSV_CONTN_TOP(sp)
	lw	t3, _SF_PLGSV_NEXT_VAR(sp)
	sw	t1, _SVB_OFFS(_plog_contn_sp)(svb)
	sw	t2, _SVB_OFFS(_plog_contn_top)(svb)
	sw	t3, _SVB_OFFS(_plog_next_var)(svb)

	;;; Load saved trail end pointer to t1, current trail end pointer to
	;;; t2 and trail barrier to t3

	lw	t1, _SF_PLGSV_TRAIL_SP(sp)
	lw	t3, _SVB_OFFS(_plog_trail_barrier)(svb)
	lw	t2, _SVB_OFFS(_plog_trail_sp)(svb)

	;;; Make saved trail end pointer (saved relative to trail barrier)
	;;; absolute by adding to current barrier, and compare to current
	;;; trail end pointer

	addu	t3, t1
	beq	t3, t2, 2f

	;;; Saved trail end pointer differs from current trail end pointer:
	;;; restore trail end pointer ...

	sw	t3, _SVB_OFFS(_plog_trail_sp)(svb)

	;;; ... and uninstantiate the variables on it

1:	;;; Repeat

	lw	t4, (t3)		;;; load prologvar to t4
	addu	t3, 4			;;; step on trail address
	sw	t4, _PGV_CONT(t4)	;;; assign var to its own PGV_CONT

	;;; Until t3 = t2

	bne	t3, t2, 1b
	nop

2:	j	ra
	nop

	.set	reorder
	.end	$prolog_restore


;;; === HEAD MATCHING =================================================

;;; _PROLOG_UNIFY_ATOM:
;;;	unifies an argument against an atom.
;;;	Sets flags to EQ if unification succeeds and NEQ if it fails.

;;; Call:
;;;	_prolog_unify_atom();

;;; Arguments:
;;;	a0	(arg_reg_0) the argument
;;;	a1	(arg_reg_1) the atom

;;; Results:
;;;	v0	zero indicates success, non-zero failure

;;; Other registers used:
;;;	t0	address of prologvar_key
;;;	t1	key of argument
;;;	t2	_plog_trail_sp
;;;	t3	current prologvar link

;;; Usage:
;;;	from -sysPLOG_IFNOT_ATOM-: the subroutine call will be followed by
;;;	an I_PLOG_IFNOT_ATOM to jump on the status flags.

DEF_C_LAB (_prolog_unify_atom)

	.ent	$prolog_unify_atom
$prolog_unify_atom:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	la	t0, C_LAB(prologvar_key)

1:	;;; Start of dereferencing loop:
	;;; break out if item is simple

	and	v0, a0, 1
	bnez	v0, 2f

	;;; Item is compound:
	;;; break out unless item is a prologvar

	lw	t1, _KEY(a0)
	move	t3, a0				;;; fill delay slot
	bne	t1, t0, 2f

	;;; Argument is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)

	lw	a0, _PGV_CONT(a0)
	bne	a0, t3, 1b

	;;; Argument is an uninstantiated plogvar:
	;;; assign the atom in a1 to it and push it on the trail

	lw	t2, _SVB_OFFS(_plog_trail_sp)(svb)
	sw	a1, _PGV_CONT(a0)
	sw	a0, (t2)
	addu	t2, 4
	sw	t2, _SVB_OFFS(_plog_trail_sp)(svb)

	;;; Return zero (already in v0) to indicate success

	j	ra

2:	;;; Item in a0 is non-var: compare with atom in a1 and return

	subu	v0, a0, a1
	j	ra

	.end	$prolog_unify_atom


;;; _PROLOG_PAIR_SWITCH:
;;;	tests if an argument can be unified with a pair

;;; Call:
;;;	_prolog_pair_switch();

;;; Arguments:
;;;	a0	(arg_reg_0) the argument for testing

;;; Results:
;;;	v0	> 0	argument is an uninstantiated prologvar
;;;		= 0	argument is a pair: success
;;;		< 0	argument is anything else: failure
;;;	a0	Dereferenced argument
;;;	If argument is an uninstantiated prologvar, the dereferenced var is
;;;	left on the userstack.

;;; Other registers used:
;;;	t0	(1) address of prologvar_key
;;;		(2) address of pair key
;;;	t1	key of argument
;;;	t2	bit 0 of argument
;;;	t3	current prologvar link

;;; Usage:
;;;	from sysPLOG_TERM_SWITCH, where the term in question is a pair. The
;;;	subroutine call will be followed by an I_PLOG_TERM_SWITCH to jump on
;;;	the value in v0.

DEF_C_LAB (_prolog_pair_switch)

	.ent	$prolog_pair_switch
$prolog_pair_switch:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	la	t0, C_LAB(prologvar_key)

1:	;;; Start of dereferencing loop:
	;;; break out if argument is simple (and go straight to failure)

	and	t2, a0, 1
	bnez	t2, 3f

	;;; Argument is compound:
	;;; break out unless argument is a prologvar

	lw	t1, _KEY(a0)
	move	t3, a0				;;; fill delay slot
	bne	t1, t0, 2f

	;;; Argument is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)

	lw	a0, _PGV_CONT(a0)
	bne	a0, t3, 1b

	;;; Uninstantiated prologvar: push on user stack and return +1

	subu	usp, 4
	sw	a0, (usp)
	li	v0, 1
	j	ra

2:	;;; Argument is compound:
	;;; test for a pair and return zero if so

	la	t0, C_LAB(pair_key)
	bne	t1, t0, 3f
	move	v0, zero
	j	ra

3:	;;; Argument is neither pair nor prologvar:
	;;; return -1

	li	v0, -1
	j	ra

	.end	$prolog_pair_switch


;;; _PROLOG_TERM_SWITCH:
;;;	tests if an argument can be unified with a term of particular functor
;;;	and arity

;;; Call:
;;;	_prolog_term_switch();

;;; Arguments:
;;;	a0	(arg_reg_0) the argument for testing
;;;	a1	(arg_reg_1) the functor of the term
;;;	a2	(arg_reg_2) the length of the term (arity+1) as a pop integer

;;; Results:
;;;	v0	> 0	argument is an uninstantiated prologvar
;;;		= 0	argument is a pair: success
;;;		< 0	argument is anything else: failure
;;;	a0	Dereferenced argument
;;;	If argument is an uninstantiated prologvar, the dereferenced var is
;;;	left on the userstack.

;;; Other registers used:
;;;	t0	(1) address of prologvar_key
;;;		(2) address of pair key
;;;	t1	key of argument
;;;	t2	(1) bit 0 of argument
;;;		(2) functor of argument
;;;	t3	(1) current prologvar link
;;;		(2) length (arity) of argument

;;; Usage:
;;;	from sysPLOG_TERM_SWITCH, where the term in question is a prologterm.
;;;	The subroutine call will be followed by an I_PLOG_TERM_SWITCH to
;;;	jump on the value in v0.

DEF_C_LAB (_prolog_term_switch)

	.ent	$prolog_term_switch
$prolog_term_switch:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	la	t0, C_LAB(prologvar_key)

1:	;;; Start of dereferencing loop:
	;;; break out if argument is simple (and go straight to failure)

	and	t2, a0, 1
	bnez	t2, 3f

	;;; Argument is compound:
	;;; break out unless argument is a prologvar

	lw	t1, _KEY(a0)
	move	t3, a0				;;; fill delay slot
	bne	t1, t0, 2f

	;;; Argument is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)

	lw	a0, _PGV_CONT(a0)
	bne	a0, t3, 1b

	;;; Uninstantiated prologvar: push on user stack and return +1

	subu	usp, 4
	sw	a0, (usp)
	li	v0, 1
	j	ra

2:	;;; Argument is compound:
	;;; test for prologterm with same functor and arity, and return
	;;; zero if so

	la	t0, C_LAB(prologterm_key)
	bne	t1, t0, 3f			;;; return unless prologterm
	lw	t2, _PGT_FUNCTOR(a0)		;;; get functor
	lw	t3, _PGT_LENGTH(a0)		;;; get length
	bne	a1, t2, 3f			;;; right functor?
	srl	a2, 2				;;; convert length to sysint
	bne	a2, t3, 3f			;;; right arity?
	move	v0, zero			;;; return 0
	j	ra

3:	;;; Argument doesn't match:
	;;; return -1

	li	v0, -1
	j	ra

	.end	$prolog_term_switch


;;; === ASSIGNING TO PROLOG VARIABLES =================================

;;; _PROLOG_ASSIGN:
;;;	assign to a prolog variable and push the variable on the trail.

;;; Call:
;;;	_prolog_assign(PROLOGVAR, ITEM);

;;; Register usage:
;;;	t0 	PROLOGVAR
;;;	t1 	ITEM
;;;	t2	trail pointer

DEF_C_LAB (_prolog_assign)

	.ent	$prolog_assign
$prolog_assign:

	lw	t0, 4(usp)
	lw	t1, (usp)
	addu	usp, 8

	;;; Load trail pointer to t2

	lw	t2, _SVB_OFFS(_plog_trail_sp)(svb)

	;;; Assign item to var!PGV_CONT

	sw	t1, _PGV_CONT(t0)

	;;; Push var on the trail

	sw	t0, (t2)
	addu	t2, 4
	sw	t2, _SVB_OFFS(_plog_trail_sp)(svb)

	j	ra

	.end	$prolog_assign


;;; _PROLOG_ASSIGN_PAIR:
;;;	optimised version of _prolog_assign(conspair())

;;; Call:
;;;	_prolog_assign_pair(PROLOGVAR, FRONT, BACK);

;;; Register usage:
;;;	t0 	the prologvar
;;;	t1	front
;;;	t2	back
;;;	t3 	free pair list
;;;	t4	(1) bit 0 of free pair list
;;;		(2) first pair from the free list
;;;	t5 	trail pointer

DEF_C_LAB (_prolog_assign_pair)

	.ent	$prolog_assign_pair
$prolog_assign_pair:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	;;; Load free pair list to t3.
	;;; If simple, there are no free pairs left so chain
	;;; -Prolog_assign_pair- to allocate more store
	;;; (Also load first argument to t0 to fill delay slot)

	lw	t3, I_LAB(Sys$- _free_pairs)
	lw	t0, 8(usp)			;;; load first argument
	and	t4, t3, 1
	beqz	t4, 1f
	la	t9, XC_LAB(Sys$-Plog$-Assign_pair)
	j	t9

1:	;;; Otherwise, load remaining arguments from user stack to t1 and t2

	lw	t1, 4(usp)
	lw	t2, (usp)
	addu	usp, 12

	;;; Load back of free list to t4, and trail pointer to t5

	lw	t4, _P_BACK(t3)
	lw	t5, _SVB_OFFS(_plog_trail_sp)(svb)

	;;; Assign the back of the free list to the free list

	sw	t4, I_LAB(Sys$- _free_pairs)

	;;; Initialise the new pair with the values from the stack

	sw	t1, _P_FRONT(t3)
	sw	t2, _P_BACK(t3)

	;;; Assign the new pair to the prologvar

	sw	t3, _PGV_CONT(t0)

	;;; and push the var on the trail

	sw	t0, (t5)
	addu	t5, 4
	sw	t5, _SVB_OFFS(_plog_trail_sp)(svb)
	j	ra

	.end	$prolog_assign_pair


;;; === OPTIONAL OPTIMISATIONS ========================================
;;; (Replacing definitions from "plogcore.p" and "plogterms.p")

;;; _PROLOG_DEREF:
;;;	dereference a chain of prolog variables

;;; Call:
;;;	_prolog_deref(ITEM) -> DEREF'ED_ITEM

;;; Register usage:
;;;	a0	the item
;;;	t0	address of prologvar_key
;;;	t1	key of item
;;;	t2	bit 0 of item
;;;	t3	current prologvar link

DEF_C_LAB (_prolog_deref)

	.ent	$prolog_deref
$prolog_deref:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	lw	a0, (usp)
	la	t0, C_LAB(prologvar_key)

1:	;;; Start of dereferencing loop:
	;;; break out if item is simple

	and	t2, a0, 1
	bnez	t2, 2f

	;;; Item is compound:
	;;; break out unless item is a prologvar

	lw	t1, _KEY(a0)
	move	t3, a0				;;; fill delay slot
	bne	t1, t0, 2f

	;;; Item is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)

	lw	a0, _PGV_CONT(a0)
	bne	a0, t3, 1b

2:	;;; Finished -- return the dereferenced item

	sw	a0, (usp)
	j	ra

	.end	$prolog_deref


;;; _PROLOG_NEWVAR:
;;;	returns a new prologvar from the free block. If there are none left,
;;;	chains to pop New_var which allocates more store.

;;; Call:
;;;	_prolog_newvar() -> PROLOGVAR

;;; Register usage:
;;;	t0	next var in the free block
;;;	t1	key of next var
;;;	t2	ref key

DEF_C_LAB (_prolog_newvar)

	.ent	$prolog_newvar
$prolog_newvar:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	;;; Load the next var in the block to t0

	lw	t0, _SVB_OFFS(_plog_next_var)(svb)

	;;; If it's the end-of-block ref, go to the storage allocator

	lw	t1, _KEY(t0)
	la	t2, C_LAB(ref_key)
	bne	t1, t2, 1f
	la	t9, XC_LAB(Sys$-Plog$-New_var)
	j	t9

1:	;;; Otherwise it's a new variable:
	;;; make it undef, and push it on the stack

	sw	t0, _PGV_CONT(t0)
	subu	usp, 4
	sw	t0, (usp)

	;;; Increment the -next_var- pointer and return

	addu	t0, _PGV_SIZE
	sw	t0, _SVB_OFFS(_plog_next_var)(svb)
	j	ra

	.end	$prolog_newvar


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

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

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

/* --- Revision History ---------------------------------------------------
--- John Gibson, Oct 18 1994
	free*pairs -> _free_pairs
--- Robert John Duncan, Aug 30 1994
	Fixed adjustment to $t9 in prolog_save_check (new value must point
	to CPLOAD)
--- Robert John Duncan, Mar 22 1994
	Removed procedure assignments to a0 (again).
	Changed external jumps to go off t9.
--- 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 10 1994
	Made position independent. Changed to use special var block rather
	than the global pointer.
--- Robert John Duncan, Mar  8 1994
	Added .ent/.end directives
--- Robert John Duncan, Jul  4 1990
	Added extern declarations for special vars and changed
	prolog_save_check/prolog_restore not to use special_var_block
 */
