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

/*************************************************************************
		THIS FILE WAS GENERATED AUTOMATICALLY FROM
		 /rsuna/pop/master/S.pcunix/src/aprolog.s
		     ON Fri Apr 15 10:37:44 BST 1994
	  AND SUBSEQUENTLY EDITED ON Fri Apr 15 13:13:36 BST 1994
*************************************************************************/

#_<

#_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	(

	;;; User stack pointer

	USP			= "ebx",

	;;; 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,

);

>_#

	.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

;;; === 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:
;;;	ESI	pointer to "special var block"
;;;	EAX	work
;;;	ECX	trail pointer

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

DEF_C_LAB(_prolog_save_check)

	mov	esi, C_LAB(_special_var_block)

	;;; Save next_free_var pointer

	mov	eax, dword ptr [esi+_SVB_OFFS(_plog_next_var)]
	mov	dword ptr [esp+_SF_PLGSV_NEXT_VAR+4], eax

	;;; Save trail end pointer, relative to trail barrier

	mov	eax, dword ptr [esi+_SVB_OFFS(_plog_trail_sp)]
	mov	ecx, eax	;;; wanted later
	sub	eax, dword ptr [esi+_SVB_OFFS(_plog_trail_barrier)]
	mov	dword ptr [esp+_SF_PLGSV_TRAIL_SP+4], eax

	;;; Save continuation stack top and pointer

	mov	eax, dword ptr [esi+_SVB_OFFS(_plog_contn_sp)]
	mov	dword ptr [esi+_SVB_OFFS(_plog_save_contn_sp)], eax
	mov	eax, dword ptr [esi+_SVB_OFFS(_plog_contn_top)]
	mov	dword ptr [esp+_SF_PLGSV_CONTN_TOP+4], eax

	;;; Check for trail overflow

	cmp	dword ptr [esi+_SVB_OFFS(_plog_trail_lim)], ecx
	jbe	C_LAB(_checkplogall)

	;;; Check system stack overflow

	cmp	dword ptr [esi+_SVB_OFFS(_call_stack_lim)], esp
	ja	C_LAB(_checkplogall)

	;;; Check userstack overflow

	cmp	dword ptr [esi+_SVB_OFFS(_userlim)], USP
	ja	C_LAB(_checkplogall)

	;;; Test interrupt bit

	test	dword ptr [esi+_SVB_OFFS(_trap)], 1
	jnz	C_LAB(_checkplogall)
	ret

	align	4

;;; _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:
;;;	EDI	pointer to "special var block"
;;;	EAX	work
;;;	ECX/ESI	trail pointers

DEF_C_LAB(_prolog_restore)

	mov	edi, C_LAB(_special_var_block)

	;;; Restore next_free_var pointer

	mov	eax, dword ptr [esp+_SF_PLGSV_NEXT_VAR+4]
	mov	dword ptr [edi+_SVB_OFFS(_plog_next_var)], eax

	;;; Restore continuation stack top and pointer

	mov	eax, dword ptr [edi+_SVB_OFFS(_plog_save_contn_sp)]
	mov	dword ptr [edi+_SVB_OFFS(_plog_contn_sp)], eax
	mov	eax, dword ptr [esp+_SF_PLGSV_CONTN_TOP+4]
	mov	dword ptr [edi+_SVB_OFFS(_plog_contn_top)], eax

	;;; Compare current trail end pointer with the saved value
	;;; (saved relative to trail barrier)

	mov	esi, dword ptr [esp+_SF_PLGSV_TRAIL_SP+4]
	add	esi, dword ptr [edi+_SVB_OFFS(_plog_trail_barrier)]
	mov	ecx, dword ptr [edi+_SVB_OFFS(_plog_trail_sp)]
	cmp	esi, ecx
	je	L$2$1

	;;; Restore the trail end pointer ...

	mov	dword ptr [edi+_SVB_OFFS(_plog_trail_sp)], esi

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

	cld
L$1$3:	lodsd	;;; plogvar in EAX
	mov	dword ptr [eax+_PGV_CONT], eax	;;; assigned to its own PGV_CONT
	cmp	esi, ecx
	jne	L$1$3

L$2$1:	ret

	align	4


;;; === 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:
;;;	EAX	(arg_reg_0) the argument
;;;	ECX	(arg_reg_1) the atom

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

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

	test	eax, 1
	jnz	L$2$2

	;;; Item is compound:
	;;; break out unless item is plogvar

	cmp	dword ptr [eax+_KEY], C_LAB(prologvar_key)
	jne	L$2$2

	;;; Dereference one link of plogvar:
	;;; loop unless (var!PGV_CONT) == var

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

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

	mov	dword ptr [eax+_PGV_CONT], ecx
	mov	edi, dword ptr I_LAB(_plog_trail_sp)
	mov	dword ptr [edi], eax
	add	edi, 4
	mov	dword ptr I_LAB(_plog_trail_sp), edi

	;;; Set flags to equal to indicate success and return

	cmp	eax, eax
	ret

L$2$2:	;;; Item in EAX is non-var: compare with atom in ECX and return

	cmp	ecx, eax
	ret

	align	4

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

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

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

;;; Results:
;;;	if argument is an uninstantaited prologvar, then the dereferenced
;;;	var is left on the stack. Otherwise none.

;;; Flags:
;;;	A	(UGT) if argument is an uninstantiated prologvar
;;;	E	(EQ)  if argument is a pair
;;;	B	(ULT) if argument is anything else

;;; 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 flag setting.

DEF_C_LAB(_prolog_pair_switch)

L$1$5:	;;; Dereferencing loop:
	;;; break out if argument is simple (and go straight to failure)

	test	eax, 1
	jnz	L$3$1

	;;; Argument is compound:
	;;; break out if not a prologvar

	cmp	dword ptr [eax+_KEY], C_LAB(prologvar_key)
	jne	L$2$3

	;;; Argument is a prologvar:
	;;; dereference one link, then test for the end of the chain
	;;; (var!PGV_CONT == var); loop if not

	mov	esi, eax
	mov	eax, dword ptr [eax+_PGV_CONT]
	cmp	esi, eax
	jne	L$1$5

	;;; Uninstantiated prologvar: push it on the stack

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

	;;; Set flags to UGT and return

	test	eax, eax	;;; address of prologvar must be > 0
	ret

L$2$3:	;;; Argument is compound: test for a pair and return with flags
	;;; set to EQ if so

	cmp	dword ptr [eax+_KEY], C_LAB(pair_key)
	jne	L$3$1
	ret

L$3$1:	;;; Argument is neither pair nor prologvar:
	;;; set flags to ULT (i.e. set the carry flag) and return

	stc
	ret

	align	4

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

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

;;; Arguments:
;;;	EAX	(arg_reg_0) the argument for testing
;;;	ECX	(arg_reg_1) the functor of the term
;;;	EDX	(arg_reg_2) the length of the term (arity+1) as a pop integer

;;; Results:
;;;	if argument is an uninstantiated prologvar, then the dereferenced
;;;	var is left on the stack. Otherwise none.

;;; Flags:
;;;	A	(UGT) if argument is an uninstantiated prologvar
;;;	E	(EQ)  if argument is a matching term
;;;	B	(ULT) if argument is anything else

;;; 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 flag setting.

DEF_C_LAB(_prolog_term_switch)

L$1$6:	;;; Dereferencing loop:
	;;; break out if argument is simple (and go straight to failure)

	test	eax, 1
	jnz	L$3$2

	;;; Argument is compound:
	;;; break out if not a prologvar

	cmp	dword ptr [eax+_KEY], C_LAB(prologvar_key)
	jne	L$2$4

	;;; Argument is a prologvar:
	;;; dereference one link, then test for the end of the chain
	;;; (var!PGV_CONT == var); loop if not

	mov	esi, eax
	mov	eax, dword ptr [eax+_PGV_CONT]
	cmp	esi, eax
	jne	L$1$6

	;;; Uninstantiated prologvar: push it on the stack

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

	;;; Set flags to UGT and return

	test	eax, eax	;;; address of prologvar must be > 0
	ret

L$2$4:	;;; Argument is compound:
	;;; test for prologterm with same functor and arity, and return
	;;; with flags set to EQ if so

	cmp	dword ptr [eax+_KEY], C_LAB(prologterm_key)
	jne	L$3$2
	cmp	dword ptr [eax+_PGT_FUNCTOR], ecx
	jne	L$3$2
	sar	edx, 2	;;; convert length to sysint
	cmp	dword ptr [eax+_PGT_LENGTH], edx
	jne	L$3$2
	ret

L$3$2:	;;; Argument doesn't match: set carry flag (i.e. ULT) and return

	stc
	ret

	align	4


;;; === 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:
;;;	EAX	ITEM
;;;	ECX	PROLOGVAR
;;;	EDI	trail pointer

DEF_C_LAB(_prolog_assign)

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

	;;; Assign item to var!PGV_CONT

	mov	dword ptr [ecx+_PGV_CONT], eax

	;;; Push var on the trail

	mov	edi, dword ptr I_LAB(_plog_trail_sp)
	mov	dword ptr [edi], ecx
	add	edi, 4
	mov	dword ptr I_LAB(_plog_trail_sp), edi
	ret

	align	4

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

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

;;; Register usage:
;;;	EAX	the free pair list, then a new pair taken from it
;;;	ECX	the prologvar
;;;	EDI	trail pointer

DEF_C_LAB(_prolog_assign_pair)

	;;; Load free pair list to EAX
	;;; If simple, there are no free pairs left so chain
	;;; -Assign_pair- to allocate more store

	mov	eax, dword ptr I_LAB(Sys$- _free_pairs)
	test	eax, 1
	jnz	XC_LAB(Sys$-Plog$-Assign_pair)

	;;; Otherwise, take the first pair from the free list

	mov	ecx, dword ptr [eax+_P_BACK]
	mov	dword ptr I_LAB(Sys$- _free_pairs), ecx

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

	mov	ecx, dword ptr [USP]
	mov	dword ptr [eax+_P_BACK], ecx
	mov	ecx, dword ptr [USP+4]
	mov	dword ptr [eax+_P_FRONT], ecx

	;;; Assign the new pair to the prologvar

	mov	ecx, dword ptr [USP+8]
	add	USP, 12
	mov	dword ptr [ecx+_PGV_CONT], eax

	;;; and push the var on the trail

	mov	edi, dword ptr I_LAB(_plog_trail_sp)
	mov	dword ptr [edi], ecx
	add	edi, 4
	mov	dword ptr I_LAB(_plog_trail_sp), edi
	ret

	align	4


;;; === 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:
;;;	EAX	the item
;;;	ECX	work (for comparing a variable with its contents)

DEF_C_LAB(_prolog_deref)

	;;; Load item to EAX

	mov	eax, dword ptr [USP]

L$1$9:	;;; Start of dereferencing loop: quit if item is simple

	test	eax, 1
	jnz	L$2$5

	;;; Item is compound: quit if not prologvar

	cmp	dword ptr [eax+_KEY], C_LAB(prologvar_key)
	jne	L$2$5

	;;; Item is prologvar:
	;;; dereference one link, then test for end of chain
	;;; (var!PGV_CONT == var)

	mov	ecx, eax
	mov	eax, dword ptr [eax+_PGV_CONT]
	cmp	ecx, eax
	jne	L$1$9

L$2$5:	;;; Finished -- return the dereferenced item

	mov	dword ptr [USP], eax
	ret

	align	4

;;; _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:
;;;	EAX	next var in the free block

DEF_C_LAB(_prolog_newvar)

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

	mov	eax, dword ptr I_LAB(_plog_next_var)

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

	cmp	dword ptr [eax+_KEY], C_LAB(ref_key)
	je	XC_LAB(Sys$-Plog$-New_var)

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

	mov	dword ptr [eax+_PGV_CONT], eax
	sub	USP, 4
	mov	dword ptr [USP], eax

	;;; Increment the -next_var- pointer and return

	add	eax, _PGV_SIZE	;;;  == @@(struct PLOGVAR)[_1]
	mov	dword ptr I_LAB(_plog_next_var), eax
	ret

	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(_checkplogall):near
	extern	C_LAB(_special_var_block):near
	extern	C_LAB(pair_key):near
	extern	C_LAB(prologterm_key):near
	extern	C_LAB(prologvar_key):near
	extern	C_LAB(ref_key):near
	extern	I_LAB(Sys$- _free_pairs):near
	extern	I_LAB(_plog_next_var):near
	extern	I_LAB(_plog_trail_sp):near
	extern	XC_LAB(Sys$-Plog$-Assign_pair):near
	extern	XC_LAB(Sys$-Plog$-New_var):near
	end

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