/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 * File:	C.hppa/src/aprolog.s
 * Purpose:	Assembler support for Prolog for HP PA-RISC 1.1
 * Author:	Julian Clinton, January 1993 (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 'asm_macros.h'

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

	.code
	.word	Lcode_end-Lcode_start, C_LAB(Sys$-objmod_pad_key)
Lcode_start
	.data
	.word	Ldata_end-Ldata_start, C_LAB(Sys$-objmod_pad_key)
Ldata_start

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


	.code


;;; === 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) call stack limit
;;;	%t3 	(1) next variable pointer
;;;		(2) continuation top
;;;		(3) user stack limit
;;;	%t4	(1) (trail stack) - (trail barrier)
;;;		(2) interrupt flag

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

DEF_C_LAB (_prolog_save_check)

	ldw		_SVB_OFFS(_plog_trail_sp)(%svb), %t1
	ldw		_SVB_OFFS(_plog_trail_barrier)(%svb), %t2
	ldw		_SVB_OFFS(_plog_next_var)(%svb), %t3

	;;; Save trail stack pointer (t1), relative to trail barrier (t2)
	sub		%t1, %t2, %t4
	stw		%t4, - _SF_PLGSV_TRAIL_SP - 4(%sp)

	;;; Save next variable pointer
	stw		%t3, - _SF_PLGSV_NEXT_VAR - 4(%sp)

	;;; Save continuation stack top and pointer
	ldw		_SVB_OFFS(_plog_contn_sp)(%svb), %t2
	ldw		_SVB_OFFS(_plog_contn_top)(%svb), %t3
	stw		%t2, _SVB_OFFS(_plog_save_contn_sp)(%svb)
	stw		%t3, - _SF_PLGSV_CONTN_TOP - 4(%sp)

	;;; Do stack overflow and interrupt checks:
	ldw		_SVB_OFFS(_plog_trail_lim)(%svb), %t4
	ldw		_SVB_OFFS(_call_stack_lim)(%svb), %t2
	ldw		_SVB_OFFS(_userlim)(%svb), %t3
	comb,>>=,n	%t1, %t4, L$1		;;; trail sp >= trail lim

	;;; Load _trap now %t4 is available
	ldw		_SVB_OFFS(_trap)(%svb), %t4

	;;; and continue with checks
	comb,>>=,n	%sp, %t2, L$1		;;; sp >= call stack lim
	comb,<<,n	%usp, %t3, L$1		;;; usp < userlim
	bb,<,n		%t4, 31, L$1		;;; interrupt

	;;; OK
	RETE
	nop

L$1	;;; Redo checks
	CHAINSYS	C_LAB(_checkplogall)
	nop


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


	;;; Restore continuation stack top, continuation stack pointer
	;;; and next variable pointer
	ldw		_SVB_OFFS(_plog_save_contn_sp)(%svb), %t1
	ldw		- _SF_PLGSV_CONTN_TOP - 4(%sp), %t2
	ldw		- _SF_PLGSV_NEXT_VAR - 4(%sp), %t3
	stw		%t1, _SVB_OFFS(_plog_contn_sp)(%svb)
	stw		%t2, _SVB_OFFS(_plog_contn_top)(%svb)
	stw		%t3, _SVB_OFFS(_plog_next_var)(%svb)


	;;; Load saved trail end pointer to %t1, current trail end to %t2
	;;; and next variable pointer to %t3
	ldw		- _SF_PLGSV_TRAIL_SP - 4(%sp), %t1
	ldw		_SVB_OFFS(_plog_trail_barrier)(%svb), %t3
	ldw		_SVB_OFFS(_plog_trail_sp)(%svb), %t2

	;;; Make saved trail end pointer (saved relative to trail barrier)
	;;; absolute by adding to current barrier and compare with current
	;;; trail end pointer
	add		%t1, %t3, %t3
	comb,=,n	%t2, %t3, L$3

	;;; Saved trail end pointer differs from current trail end pointer:
	;;; restore trail end pointer...
	stw		%t3, _SVB_OFFS(_plog_trail_sp)(%svb)

	;;; ...and uninstantiate the variables on it
	ldwm		4(%t3), %t4

L$2	;;; Repeat

	;;; load prologvar to %t4, step on trail address and
	;;; assign var to its own PGV_CONT
	stw		%t4, _PGV_CONT(%t4)

	;;; Until %t3 = %t2
	comb,<>,n	%t3, %t2, L$2
	ldwm		4(%t3), %t4		;;; branch delay slot

L$3	;;; Exit
	RETE
	nop



;;; === 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:
;;;	%arg0	(arg_reg_0) the argument
;;;	%arg1	(arg_reg_1) the atom

;;; Results:
;;;	%ret0	zero indicates success, non-zero failure

;;; Other registers used:
;;;	%t1	address of prologvar_key
;;;	%t2	key of argument
;;;	%t3	_plog_trail_sp
;;;	%t4	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)

	LDA32		C_LAB(prologvar_key), %t1

	;;; if item is simple, then exit
	bb,<,n		%arg0, 31, L$12

L$11	;;; Start of dereferencing loop

	;;; Item is compound: break out unless item is a prologvar.
	;;; Also update prologvar link
	ldw		_KEY(%arg0), %t2
	comb,<>		%t2, %t1, L$12
	copy		%arg0, %t4

	;;; Argument is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)
	ldw		_PGV_CONT(%arg0), %arg0
	comb,<>,n	%arg0, %t4, L$11

	;;; in delay slot, branch to exit if item is simple
	bb,<,n		%arg0, 31, L$12

	;;; Argument is an uninstantiated plogvar:
	;;; assign the atom in %arg1 to it and push it on the trail
	ldw		_SVB_OFFS(_plog_trail_sp)(%svb), %t3
	stw		%arg1, _PGV_CONT(%arg0)
	stwm		%arg0, 4(%t3)
	stw		%t3, _SVB_OFFS(_plog_trail_sp)(%svb)

	;;; Return zero to indicate success
	RETE
	copy		0, %ret0		;;; branch delay slot

L$12	;;; Item in %arg0 is non-var: compare with atom in %arg1 and return
	RETE
	sub		%arg0, %arg1, %ret0	;;; branch delay slot


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

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

;;; Arguments:
;;;	%arg0	(arg_reg_0) the argument for testing

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

;;; Other registers used:
;;;	%t1	(1) address of prologvar_key
;;;		(2) address of pair key
;;;	%t2	key of argument
;;;	%t3	bit 0 of argument
;;;	%t4	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 %ret0.

DEF_C_LAB (_prolog_pair_switch)

	LDA32		C_LAB(prologvar_key), %t1

	;;; if item is simple, then exit
	bb,<,n		%arg0, 31, L$23

L$21	;;; Start of dereferencing loop

	;;; Item is compound: break out unless item is a prologvar.
	;;; Also update prologvar link
	ldw		_KEY(%arg0), %t2
	comb,<>		%t2, %t1, L$22
	copy		%arg0, %t4

	;;; Argument is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)
	ldw		_PGV_CONT(%arg0), %arg0
	comb,<>,n	%arg0, %t4, L$21

	;;; in delay slot, branch to exit if item is simple
	bb,<,n		%arg0, 31, L$23

	;;; Uninstantiated prologvar: push on user stack and return +1
	stwm		%arg0, -4(%usp)
	RETE
	ldi		1, %ret0		;;; branch delay slot

L$22	;;; Argument is compound:
	;;; test for a pair and return zero if so
	LDA32		C_LAB(pair_key), %t1
	comb,<>,n	%t1, %t2, L$23
	RETE
	ldi		0, %ret0		;;; branch delay slot

L$23	;;; Argument is neither pair nor prologvar:
	;;; return -1
	RETE
	ldi		-1, %ret0		;;; branch delay slot


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

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

;;; Arguments:
;;;	%arg0	(arg_reg_0) the argument for testing
;;;	%arg1	(arg_reg_1) the functor of the term
;;;	%arg2	(arg_reg_2) the length of the term (arity+1) as a pop integer

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

;;; Other registers used:
;;;	%t1	(1) address of prologvar_key
;;;		(2) address of pair key
;;;	%t2	key of argument
;;;	%t3	(1) bit 0 of argument
;;;		(2) functor of argument
;;;	%t4	(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 %ret0.

DEF_C_LAB (_prolog_term_switch)

	LDA32		C_LAB(prologvar_key), %t1

	;;; if item is simple, then exit
	bb,<,n		%arg0, 31, L$33

L$31	;;; Start of dereferencing loop

	;;; Item is compound: break out unless item is a prologvar.
	;;; Also update prologvar link
	ldw		_KEY(%arg0), %t2
	comb,<>		%t2, %t1, L$32
	copy		%arg0, %t4

	;;; Argument is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)
	ldw		_PGV_CONT(%arg0), %arg0
	comb,<>,n	%arg0, %t4, L$31

	;;; in delay slot, branch to exit if item is simple
	bb,<,n		%arg0, 31, L$33

	;;; Uninstantiated prologvar: push on user stack and return +1
	stwm		%arg0, -4(%usp)
	RETE
	ldi		1, %ret0		;;; branch delay slot

L$32	;;; Argument is compound:
	;;; test for prologterm with same functor and arity, and return
	;;; zero if so
	LDA32		C_LAB(prologterm_key), %t1
	comb,<>,n	%t1, %t2, L$33			;;; prolog term?
	ldw		_PGT_FUNCTOR(%arg0), %t3
	ldw		_PGT_LENGTH(%arg0), %t4
	comb,<>,n	%arg1, %t3, L$33		;;; right functor?
	extrs		%arg2, 29, 30, %arg2            ;;; length to sysint
	comb,<>,n	%arg2, %t4, L$33		;;; right arity?

	RETE
	ldi		0, %ret0		;;; branch delay slot


L$33	;;; Argument doesn't match:
	;;; return -1
	RETE
	ldi		-1, %ret0		;;; branch delay slot


;;; === 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:
;;;	%t1 	PROLOGVAR
;;;	%t2 	ITEM
;;;	%t3	trail pointer

DEF_C_LAB (_prolog_assign)

	ldwm		4(%usp), %t2		;;; ITEM
	ldwm		4(%usp), %t1		;;; PROLOGVAR

	;;; Load trail pointer to %t3
	ldw		_SVB_OFFS(_plog_trail_sp)(%svb), %t3

	;;; Assign item to var!PGV_CONT
	stw		%t2, _PGV_CONT(%t1)

	;;; Push var on the trail
	stwm		%t1, 4(%t3)
	RETE
	stw		%t3, _SVB_OFFS(_plog_trail_sp)(%svb)


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

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

;;; Register usage:
;;;	%arg0 	the prologvar
;;;	%arg1	front
;;;	%arg2	back
;;;	%t1 	free pair list
;;;	%t2	first pair from the free list
;;;	%t3 	trail pointer

DEF_C_LAB (_prolog_assign_pair)

	;;; Load free pair list to %t1.
	;;; If simple, there are no free pairs left so chain
	;;; -Prolog_assign_pair- to allocate more store
	LDV32		I_LAB(Sys$- _free_pairs), %t1
	bb,>=,n		%t1, 31, L$35		;;; branch if compound
	CHAINSYS	XC_LAB(Sys$-Plog$-Assign_pair)
	nop

L$35	;;; Otherwise, load arguments from user stack
	ldwm		4(%usp), %arg2		;;; BACK
	ldwm		4(%usp), %arg1		;;; FRONT
	ldwm		4(%usp), %arg0		;;; PROLOGVAR

	;;; Load back of free list to %t2, and trail pointer to %t3
	ldw		_P_BACK(%t1), %t2
	ldw		_SVB_OFFS(_plog_trail_sp)(%svb), %t3

	;;; Assign the back of the free list to the free list
	STV32		%t2, I_LAB(Sys$- _free_pairs)

	;;; Initialise the new pair with the values from the stack
	stw		%arg1, _P_FRONT(%t1)
	stw		%arg2, _P_BACK(%t1)

	;;; Assign the new pair to the prologvar
	stw		%t1, _PGV_CONT(%arg0)

	;;; and push the var on the trail
	stwm		%arg0, 4(%t3)
	RETE
	stw		%t3, _SVB_OFFS(_plog_trail_sp)(%svb)


;;; === 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:
;;;	%arg0	the item
;;;	%t1	address of prologvar_key
;;;	%t2	key of item
;;;	%t4	current prologvar link

DEF_C_LAB (_prolog_deref)

	ldwm		4(%usp), %arg0
	LDA32		C_LAB(prologvar_key), %t1

	;;; if item is simple, then exit
	bb,<,n		%arg0, 31, L$42

L$41	;;; Start of dereferencing loop

	;;; Item is compound: break out unless item is a prologvar.
	;;; Also update prologvar link
	ldw		_KEY(%arg0), %t2
	comb,<>		%t2, %t1, L$42
	copy		%arg0, %t4

	;;; Item is a prologvar:
	;;; dereference one link, and loop unless (var!PGV_CONT) == var
	;;; (i.e. until end of prologvar chain)
	ldw		_PGV_CONT(%arg0), %arg0
	comb,<>,n	%arg0, %t4, L$41

	;;; in delay slot, branch to exit if item is simple
	bb,<,n		%arg0, 31, L$42
	nop

L$42	;;; Finished -- return the dereferenced item
	RETE
	stwm		%arg0, -4(%usp)		;;; branch delay slot


;;; _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:
;;;	%t1	next var in the free block
;;;	%t2	key of next var
;;;	%t3	ref key

DEF_C_LAB (_prolog_newvar)

	;;; Load the next var in the block to %t1
	ldw		_SVB_OFFS(_plog_next_var)(%svb), %t1

	;;; If it's the end-of-block ref, go to the storage allocator
	ldw		_KEY(%t1), %t2
	LDA32		C_LAB(ref_key), %t3
	comb,<>,n	%t2, %t3, L$45
	CHAINSYS	XC_LAB(Sys$-Plog$-New_var)
	nop

L$45	;;; Otherwise it's a new variable:
	;;; make it undef, and push it on the stack
	stw		%t1, _PGV_CONT(%t1)
	stwm		%t1, -4(%usp)

	;;; Increment the -next_var- pointer and return (assumes _PGV_SIZE
	;;; is < 2048 (maximum 11 bits for immediate add).
	addi		_PGV_SIZE, %t1, %t1
	RETE
	stw		%t1, _SVB_OFFS(_plog_next_var)(%svb)	;;; delay slot


	.code
	.import		C_LAB(Sys$-objmod_pad_key), data
	.import		C_LAB(prologterm_key), data
	.import		C_LAB(prologvar_key), data
	.import		C_LAB(pair_key), data
	.import		C_LAB(ref_key), data
	.import		C_LAB(_checkplogall), data
	.import		I_LAB(Sys$- _free_pairs), data
	.import		XC_LAB(Sys$-Plog$-New_var), data
	.import		XC_LAB(Sys$-Plog$-Assign_pair), data


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

	.code
	.align  8
Lcode_end
	.data
	.align  8
Ldata_end

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

/* --- Revision History ---------------------------------------------------
--- John Gibson, Oct 18 1994
	free*pairs -> _free_pairs
 */
