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

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


#_<

#_INCLUDE 'declare.ph'

vars
	_call_stack_lim, _plog_trail_sp, _plog_trail_lim
	;

section $-Sys;

constant
	procedure (Call_overflow, User_overflow, Callstack_reset,
	Conspair, Plog$-Area_overflow, Async_raise_signal)
	;

endsection;

lconstant macro (

	USP			= "ebx",
	PB			= "ebp",
	CHAIN_REG		= "edx",

	_KEY			= @@KEY,
	_K_APPLY		= @@K_APPLY,
	_PD_EXECUTE		= @@PD_EXECUTE,
	_PD_EXIT		= @@PD_EXIT,
	_PD_FRAME_LEN		= @@PD_FRAME_LEN,
	_PD_UPDATER		= @@PD_UPDATER,
	_P_BACK			= @@P_BACK,
	_P_FRONT		= @@P_FRONT,
	_RF_CONT		= @@RF_CONT,
	_SF_OWNER		= @@SF_OWNER,
	_V_BYTES		= @@V_BYTES,

);

>_#

	.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

;;; === APPLYING A POP PROCEDURE ======================================

;;; _POPENTER:
;;;	Standard checking entry to a pop procedure.

;;; Arguments:
;;;	EAX	object to be applied

;;; Results:
;;;	none, but EAX will always be left containing the address of the
;;;	procedure entered to allow for initialisation of the procedure base
;;;	register

DEF_C_LAB(_popenter)

	;;; Test object for simple or compound

	test	eax, 1
	jnz	L$1$1

	;;; Object is compound: compare key with procedure key

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

	;;; Applying a procedure: jump to its execute address

	jmp	dword ptr [eax+_PD_EXECUTE]

L$1$1:	;;; Applying a (simple) number:
	;;; push the number and run the appropriate key apply procedure
	;;; (integer or decimal)

	sub	USP, 4
	mov	dword ptr [USP], eax
	test	eax, 2
	jz	L$2$1

	;;; Applying an integer

	mov	eax, dword ptr C_LAB(integer_key)+_K_APPLY
	mov	eax, dword ptr [eax+_RF_CONT]
	jmp	dword ptr [eax+_PD_EXECUTE]

L$2$1:	;;; Applying a decimal

	mov	eax, dword ptr C_LAB(weakref decimal_key)+_K_APPLY
	mov	eax, dword ptr [eax+_RF_CONT]
	jmp	dword ptr [eax+_PD_EXECUTE]

L$3$1:	;;; Applying a structure:
	;;; push the object and run the key apply procedure

	sub	USP, 4
	mov	dword ptr [USP], eax
	mov	eax, dword ptr [eax+_KEY]
	mov	eax, dword ptr [eax+_K_APPLY]
	mov	eax, dword ptr [eax+_RF_CONT]
	jmp	dword ptr [eax+_PD_EXECUTE]

	align	4


;;; _POPUENTER:
;;; _POPUNCENTER:
;;;	Apply the updater of a pop object. _POPUENTER is the standard entry
;;;	point which deals with all objects; _POPUNCENTER assumes the object
;;;	is a procedure and just checks that its updater exists.

;;; Arguments:
;;;	EAX	object to be updated

;;; Results:
;;;	none, but the address of the procedure finally applied will be left
;;;	in EAX to allow for initialisation of the procedure base register.

;;; Other registers used:
;;;	EAX	various addresses; ultimately the updater procedure address
;;;	ECX	a copy of the original object (because EAX gets overwritten)

DEF_C_LAB(_popuenter)

	;;; Test object for simple or compound

	test	eax, 1
	jnz	L$1$2

	;;; Object is compound: compare key with procedure key

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

	;;; Applying the updater of a procedure: fall through to the
	;;; non-checking entry

DEF_C_LAB(_popuncenter)

	;;; Object in EAX is known to be a procedure:
	;;; copy it to ECX for possible use as an argument to the error
	;;; routine, then get its updater

	mov	ecx, eax
	mov	eax, dword ptr [eax+_PD_UPDATER]

	;;; If the updater is <false> (non-existent) jump to the error case

	cmp	eax, C_LAB(false)
	je	no_updater

	;;; Otherwise go to the updater's execute address

	jmp	dword ptr [eax+_PD_EXECUTE]

L$1$2:	;;; Applying the updater of a number:
	;;; copy the number to ECX (to be pushed as an argument later)
	;;; then get the appropriate key apply procedure (integer or decimal)
	;;; in EAX. Jump to check (and apply) its updater

	mov	ecx, eax
	test	eax, 2
	jz	L$2$2

	;;; Integer key

	mov	eax, dword ptr C_LAB(integer_key)+_K_APPLY
	jmp	L$4$1

L$2$2:	;;; Decimal key

	mov	eax, dword ptr C_LAB(weakref decimal_key)+_K_APPLY
	jmp	L$4$1

L$3$2:	;;; Applying the updater of a structure:
	;;; copy the object to ECX (to be pushed as an argument later)
	;;; then get its key apply procedure in EAX

	mov	ecx, eax
	mov	eax, dword ptr [eax+_KEY]
	mov	eax, dword ptr [eax+_K_APPLY]

L$4$1:	;;; Check the updater of the key apply procedure in EAX

	mov	eax, dword ptr [eax+_RF_CONT]
	mov	eax, dword ptr [eax+_PD_UPDATER]
	cmp	eax, C_LAB(false)
	je	no_updater

	;;; Updater OK -- push the original object (now in ECX) as an
	;;; argument to it, and jump to its execute address

	sub	USP, 4
	mov	dword ptr [USP], ecx
	jmp	dword ptr [eax+_PD_EXECUTE]

no_updater:

	;;; Object in ECX has no updater -- raise an error

	sub	USP, 4
	mov	dword ptr [USP], ecx
	jmp	XC_LAB(-> Sys$-Exec_nonpd)

	align	4


;;; === CALLSTACK MANIPULATION ========================================

;;; _ERASE_SP_1:
;;;	Erases the longword below the return address on the callstack,
;;;	then chains -Callstack_reset-. Used by -Callstack_reset- in
;;;	cleaning up

DEF_C_LAB(_erase_sp_1)

	pop	eax
	mov	dword ptr [esp], eax
	jmp	XC_LAB(Sys$-Callstack_reset)

	align	4


;;; _NEXTFRAME:
;;;	Takes a pointer to a stack frame and returns a pointer to the next

;;; Call:
;;;	_nextframe(_FRAME_POINTER) -> _NEXT_FRAME_POINTER

DEF_C_LAB(_nextframe)

	;;; Load frame pointer to EAX

	mov	eax, dword ptr [USP]

	;;; Owner address in ECX

	mov	ecx, dword ptr [eax+_SF_OWNER]

	;;; Find the length of the frame (in longwords) from the owner's
	;;; procedure header

	movzx	ecx, byte ptr [ecx+_PD_FRAME_LEN]

	;;; Add the frame length in bytes (ECX * 4) to the given frame
	;;; pointer to get the next frame pointer.

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

	align	4


;;; _UNWIND_FRAME:
;;;	Unwinds the previous stack frame by jumping into its owner's exit
;;;	code. This subroutine will be called immediately after executing an
;;;	M_UNWIND operation, so that the (unwanted) return address into the
;;;	procedure being unwound will be all that remains of the current stack
;;;	frame, i.e. :

;;;	    previous frame starts here --->  |_______|
;;;	     return address from caller -->  |_______|
;;;	       return address from here -->  |_______|  <-- ESP

;;;	The procedure's exit code will finish with a RET into its caller; we
;;;	replace that return address with the return from here (to return
;;;	control to our caller), but save it in CHAIN_REG from where it can
;;;	be restored with an M_CALL_WITH_RETURN operation.

;;;	The M_UNWIND operation should have restored the procedure base
;;;	register (PB) to contain the address of the owner of the previous
;;;	frame.

DEF_C_LAB(_unwind_frame)

	;;; Extract the length of the previous stack frame (in longwords)
	;;; from its owner procedure, whose address should be in PB

	movzx	eax, byte ptr [PB+_PD_FRAME_LEN]

	;;; The last word in that frame will be the return address:
	;;; copy that to CHAIN_REG, then replace it with our return

	lea	eax, dword ptr [esp+eax*4+4]
	mov	CHAIN_REG, dword ptr [eax]
	pop	dword ptr [eax]

	;;; Clear the unwanted return address from the stack and go into
	;;; the procedure's exit code

	add	esp, 4
	jmp	dword ptr [PB+_PD_EXIT]

	align	4

;;; === CHAINING A POP PROCEDURE ======================================

;;; _SYSCHAIN:
;;; _SYSCHAIN_CALLER:
;;; _SYSNCCHAIN:
;;; _SYSNCCHAIN_CALLER:
;;;	Chain a pop procedure, either directly or out of the current caller.
;;;	These are executed as a result of replacing the return address in a
;;;	stack frame with one of their addresses and then (after some
;;;	arbitrary exit code) doing an RET. In the case of _SYS(NC)CHAIN,
;;;	the displaced return address is saved in CHAIN_REG, as that has to
;;;	become the return address of the chained procedure;
;;;	_SYS(NC)CHAIN_CALLER sets CHAIN_REG to be the return address from
;;;	the previous frame, as a result of calling _UNWIND_FRAME.
;;;	All the subroutines expect the procedure to be chained on the
;;;	user stack.

DEF_C_LAB(_syschain_caller)

	;;; Set up a dummy return address for _UNWIND_FRAME and call it;
	;;; this will leave the caller's return address in CHAIN_REG

	push	0
	call	C_LAB(_unwind_frame)

	;;; Fall through to direct chain

DEF_C_LAB(_syschain)

	;;; Reinstate the return address from CHAIN_REG

	push	CHAIN_REG

	;;; Get the object to chain from the stack and run it

	mov	eax, dword ptr [USP]
	add	USP, 4
	jmp	C_LAB(_popenter)

	align	4

DEF_C_LAB(_sysncchain_caller)

	;;; Set up a dummy return address for _UNWIND_FRAME and call it;
	;;; this will leave the caller's return address in CHAIN_REG

	push	0
	call	C_LAB(_unwind_frame)

	;;; Fall through to direct chain

DEF_C_LAB(_sysncchain)

	;;; Reinstate the return address from CHAIN_REG

	push	CHAIN_REG

	;;; Get the procedure to chain from the stack and go to its execute
	;;; address

	mov	eax, dword ptr [USP]
	add	USP, 4
	jmp	dword ptr [eax+_PD_EXECUTE]

	align	4


;;; === PREDICATES ON POP OBJECTS =====================================

;;; _ISCOMPOUND:
;;; _ISSIMPLE:
;;; _ISINTEGER:
;;; _NEG:
;;; _ZERO:
;;; _NOT:
;;;	Unary predicates: expect one argument on the user stack, and
;;;	overwrite it with true or false.
;;;	RETURN_TRUE provides a common exit point for the success case

DEF_C_LAB(_iscompound)

	;;; Object is a pop pointer -- bottom bit clear

	test	dword ptr [USP], 1
	jz	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB(_issimple)

	;;; Object is not a pop pointer -- bottom bit set

	test	dword ptr [USP], 1
	jnz	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB(_isinteger)

	;;; Object is a pop integer -- second bit set

	test	dword ptr [USP], 2
	jnz	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB(_neg)

	;;; Object is negative

	cmp	dword ptr [USP], 0
	jl	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB(_zero)

	;;; Object is (machine) zero

	cmp	dword ptr [USP], 0
	je	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB(_not)

	;;; Object is false

	cmp	dword ptr [USP], C_LAB(false)
	je	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _EQ:
;;; _NEQ:
;;; _GR:
;;; _GREQ:
;;; _LT:
;;; _LTEQ:
;;; _SGR:
;;; _SGREQ:
;;; _SLT:
;;; _SLTEQ:
;;;	Binary comparisons. Expect two arguments on the user stack and return
;;;	true or false.

DEF_C_LAB 7 (_eq)

	;;; Identity (pop ==)

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	je	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 7 (_neq)

	;;; Non-identity (pop /==)

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jne	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_gr)

	;;; Unsigned greater than

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	ja	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_greq)

	;;; Unsigned greater than or equal

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jae	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_lt)

	;;; Unsigned less than

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jb	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_lteq)

	;;; Unsigned less than or equal

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jbe	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_sgr)

	;;; Signed greater than

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jg	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_sgreq)

	;;; Signed greater than or equal

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jge	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_slt)

	;;; Signed less than

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jl	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

DEF_C_LAB 6 (_slteq)

	;;; Signed less than or equal

	mov	eax, dword ptr [USP]
	add	USP, 4
	cmp	dword ptr [USP], eax
	jle	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _BITST:
;;;	Logical AND two items and test for non-zero (pop &&/=_0)

DEF_C_LAB 4 (_bitst)

	mov	eax, dword ptr [USP]
	add	USP, 4
	test	dword ptr [USP], eax
	jnz	return_true
	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4

;;; _HASKEY:
;;;	tests whether the first item on stack is the key of the second item.
;;;	It's assumed that the key is always that of a compound item, so that
;;;	if the object tested is not compound, the result must be <false>
;;;	immediately.

;;; Call:
;;;	_haskey(ITEM, KEY) -> BOOL

;;; Register usage:
;;;	EAX	the object
;;;	ECX	the key

DEF_C_LAB(_haskey)

	;;; Load key to ECX

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

	;;; Load item to EAX and test for compound:
	;;; return <false> if not

	mov	eax, dword ptr [USP]
	test	eax, 1
	jnz	L$1$3

	;;; Compare keys

	cmp	dword ptr [eax+_KEY], ecx
	je	return_true
L$1$3:	mov	dword ptr [USP], C_LAB(false)
	ret

	align	4


return_true:

	mov	dword ptr [USP], C_LAB(true)
	ret

	align	4


;;; === OPTIMISED DATA ROUTINES =======================================

;;; _CONSPAIR:
;;;	Optimised -conspair-.

;;; Call:
;;;	_conspair(FRONT, BACK) -> PAIR

DEF_C_LAB(_conspair)

	;;; Get the free pair list

	mov	eax, dword ptr I_LAB(Sys$- _free_pairs)

	;;; If its simple, there's nothing left -- chain the storage
	;;; allocater

	test	eax, 1
	jnz	XC_LAB(Sys$-Conspair)

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

	;;; Return the pair

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

	align	4


;;; _DATAKEY:
;;;	Optimised -datakey-: returns the key of any pop object.

;;; Call:
;;;	_datakey(ITEM) -> KEY

DEF_C_LAB(_datakey)

	;;; Load item to EAX and test for compound

	mov	eax, dword ptr [USP]
	test	eax, 1
	jnz	L$1$5

	;;; Object is compound: extract key and return

	mov	eax, dword ptr [eax+_KEY]
	mov	dword ptr [USP], eax
	ret

L$1$5:	;;; Object is a (simple) number:
	;;; return integer or decimal key as appropriate

	test	eax, 2
	jz	L$2$3

	;;; Object is an integer

	mov	dword ptr [USP], C_LAB(integer_key)
	ret

L$2$3:	;;; Object is a decimal

	mov	dword ptr [USP], C_LAB(weakref decimal_key)
	ret

	align	4


;;; === STRING HANDLING ===============================================

;;; _SUBSS:
;;;	Fast pop string subscript (implements -fast_subscrs-).

;;; Call:
;;; 	_subss(INT, STRING) -> INT

;;; Register usage:
;;;	ESI	string address
;;;	ECX	index as popint
;;;	EAX	the indexed byte

DEF_C_LAB(_subss)

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

	;;; Convert index to a machine integer and load the indexed byte
	;;; (zero extended) into EAX

	sar	ecx, 2
	movzx	eax, byte ptr [esi+ecx+_V_BYTES-1]

	;;; Return character as a popint

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

	align	4

;;; _U_SUBSS:
;;;	Fast pop string update (implements updaterof -fast_subscrs-).

;;; Call:
;;;	INT -> _u_subss(INT, STRING)

;;; Register usage:
;;;	EDI	string address
;;;	ECX	index as popint
;;;	EAX	the new character as a popint

DEF_C_LAB(-> _subss)
DEF_C_LAB(_u_subss)

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

	;;; Convert character and index to machine integers;
	;;; insert the new byte and return

	sar	eax, 2
	sar	ecx, 2
	mov	byte ptr [edi+ecx+_V_BYTES-1], al
	ret

	align	4


;;; _LOCC:
;;;	Search a byte string for a given character. Return an offset to
;;;	the matching byte or -1 if not found.

;;; Call:
;;;	_locc(_SRCADDR, _BYTE_COUNT, _BYTE) -> _OFFSET
;;;	_locc(_SRCADDR, _BYTE_COUNT, _BYTE) -> _-1


;;; Register usage:
;;;	ESI	source address + 1 (for computing the offset)
;;;	EDI	source pointer during scan
;;;	EAX	byte to search for
;;;	ECX	length of scan in bytes

DEF_C_LAB(_locc)

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

	;;; Test the byte-count in ECX for zero:
	;;; if so, nothing to search, so return -1 immediately

	cmp	ecx, 0
	je	L$1$6

	;;; Load the string address into EDI, and copy into ESI offset by 1

	mov	edi, dword ptr [USP]
	lea	esi, dword ptr [edi+1]

	;;; Clear the direction flag to increment EDI during the scan

	cld

	;;; Scan for byte AL in EDI for maximum length ECX

	repnz	scasb

	;;; If the last byte comparison was non-zero, it was never found:
	;;; return -1

	jnz	L$1$6

	;;; Otherwise, EDI points one beyond the matching byte:
	;;; compute offset by subtracting ESI (already adjusted by 1)

	sub	edi, esi
	mov	dword ptr [USP], edi
	ret

L$1$6:	;;; Search failed -- return -1

	mov	dword ptr [USP], -1
	ret

	align	4


;;; _SKPC:
;;;	Search a byte string for the first byte not matching a given byte
;;;	(i.e skip over matching bytes). Return an offset to the first
;;;	different byte in the string, or -1 if none found.

;;; Call:
;;;	_skpc(_SRCADDR, _BYTE_COUNT, _BYTE) -> _OFFSET
;;;	_skpc(_SRCADDR, _BYTE_COUNT, _BYTE) -> _-1

;;; Register usage:
;;;	ESI	source address + 1 (for computing the offset)
;;;	EDI	source pointer during the scan
;;;	EAX	byte to skip
;;;	ECX	length of region in bytes

DEF_C_LAB(_skpc)

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

	;;; Test the byte-count in ECX for zero:
	;;; if so, nothing to search, so return -1 immediately

	cmp	ecx, 0
	je	L$1$7

	;;; Load the string address into EDI and copy to ESI offset by 1

	mov	edi, dword ptr [USP]
	lea	esi, dword ptr [edi+1]

	;;; Clear the direction flag to increment EDI during the scan

	cld

	;;; Scan for byte not matching AL in EDI for maximum length ECX

	repz	scasb

	;;; If the last byte comparison was zero, everything matched AL:
	;;; return -1

	jz	L$1$7

	;;; Otherwise, EDI points one beyond the matching byte:
	;;; compute offset by subtracting ESI (already adjusted by 1)

	sub	edi, esi
	mov	dword ptr [USP], edi
	ret

L$1$7:	;;; Search failed -- return -1

	mov	dword ptr [USP], -1
	ret


	align	4


;;; === PROCEDURE ENTRY CHECKS ========================================

;;; _CHECKPLOGALL:
;;;	Prolog procedure entry: check the Prolog stacks, then do normal
;;;	_CHECKALL

DEF_C_LAB(_checkplogall)

	mov	eax, C_LAB(_special_var_block)
	mov	ecx, dword ptr [eax+_SVB_OFFS(_plog_trail_sp)]
	cmp	dword ptr [eax+_SVB_OFFS(_plog_trail_lim)], ecx
	ja	checkall
	jmp	XC_LAB(weakref[prologvar_key] Sys$-Plog$-Area_overflow)

	align	4

;;; _CHECKALL:
;;;	Check normal stacks on procedure entry.

DEF_C_LAB(_checkall)

	mov	eax, C_LAB(_special_var_block)

checkall:

	;;; Check for callstack overflow

	cmp	dword ptr [eax+_SVB_OFFS(_call_stack_lim)], esp
	ja	L$1$10

	;;; Check for userstack overflow

	cmp	dword ptr [eax+_SVB_OFFS(_userlim)], USP
	ja	L$2$6

L$0$1:	;;; Check interrupt trap bit

	test	dword ptr [eax+_SVB_OFFS(_trap)], 1
	jnz	L$3$5

	;;; Everything OK

	ret

L$1$10:	;;; Callstack overflow: if not disabled, jump to repair, otherwise
	;;; go back to test for interrupts

	test	dword ptr I_LAB(_disable), 2
	jnz	L$0$1
	jmp	XC_LAB(Sys$-Call_overflow)

L$2$6:	;;; Userstack overflow: if not disabled, jump to repair, otherwise
	;;; go back to test for interrupts

	test	dword ptr I_LAB(_disable), 2
	jnz	L$0$1
	jmp	XC_LAB(Sys$-User_overflow)

L$3$5:	;;; Interrupt: if not disabled, jump to handler, otherwise return

	test	dword ptr I_LAB(_disable), 1
	jz	XC_LAB(Sys$-Async_raise_signal)
	ret


	align	4


;;; _CHECKINTERRUPT:
;;;	Check for intterupt flag set; if so, branch to _CHECKALL to handle it

DEF_C_LAB(_checkinterrupt)

	test	dword ptr I_LAB(_trap), 1
	jnz	C_LAB(_checkall)
	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(_special_var_block):near
	extern	C_LAB(false):near
	extern	C_LAB(integer_key):near
	extern	C_LAB(procedure_key):near
	extern	C_LAB(true):near
	extern	C_LAB(weakref decimal_key):near
	extern	I_LAB(Sys$- _free_pairs):near
	extern	I_LAB(_disable):near
	extern	I_LAB(_trap):near
	extern	XC_LAB(-> Sys$-Exec_nonpd):near
	extern	XC_LAB(Sys$-Async_raise_signal):near
	extern	XC_LAB(Sys$-Call_overflow):near
	extern	XC_LAB(Sys$-Callstack_reset):near
	extern	XC_LAB(Sys$-Conspair):near
	extern	XC_LAB(Sys$-User_overflow):near
	extern	XC_LAB(weakref[prologvar_key] Sys$-Plog$-Area_overflow):near
	end


/* --- Revision History ---------------------------------------------------
--- John Gibson, Feb 10 1997
	Removed _mt*chc subroutine
--- John Gibson, Oct 18 1994
	free*pairs -> _free_pairs
 */
