/* --- Copyright University of Sussex 1997. All rights reserved. ----------
 * File:        C.mips/src/amisc.s
 * Purpose:     Main assembler routines for MIPS R2000/R3000
 * Author:      Robert Duncan and Simon Nichols, Jan 10 1990 (see revisions)
 */


#_<

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

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

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

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

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

;;; Arguments:
;;;	a0	object to be applied

;;; Results:
;;;     none, but t9 is set to be the execute address of the called
;;;     procedure to allow for initialisation of the procedure base
;;;     register

;;; Register Usage:
;;;	t0	various addresses; ultimately the key apply procedure address
;;;	t1	key of compound object

DEF_C_LAB (_popenter)

	.ent	$popenter
$popenter:
	.set	noreorder
	CPLOAD	t9
	.set	reorder
	.aent	$popenter_1
$popenter_1:

	;;; Test object for simple or compound

	and	t0, a0, 1
	bnez	t0, 1f

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

	la	t0, C_LAB(procedure_key)
	lw	t1, _KEY(a0)
	bne	t0, t1, 3f

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

	lw	t9, _PD_EXECUTE(a0)
	j	t9

1:	;;; Applying a (simple) number:
	;;; load the appropriate key apply procedure (integer or decimal)

	and	t0, a0, 2
	beqz	t0, 2f

	;;; Applying an integer

	lw	t0, C_LAB(integer_key) + _K_APPLY
	b	4f

2:	;;; Applying a decimal

	lw	t0, C_LAB(weakref decimal_key) + _K_APPLY
	b	4f

3:	;;; Applying a structure:
	;;; load the key apply procedure into t0

	lw	t0, _K_APPLY(t1)

4:	;;; Push the object and run the key apply procedure

	sw	a0, -4(usp)
	lw	a0, _RF_CONT(t0)
	subu	usp, 4
	lw	t9, _PD_EXECUTE(a0)
	j	t9

	.end	$popenter


;;; _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:
;;;	a0	object to be updated

;;; Results:
;;;     none, but t9 is set to be the execute address of the called
;;;     procedure to allow for initialisation of the procedure base
;;;     register

;;; Register Usage:
;;;	t0	various addresses; ultimately the updater procedure address
;;;	t1	key of compound object

DEF_C_LAB (_popuenter)

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

	;;; Test object for simple or compound

	and	t0, a0, 1
	bnez	t0, 1f

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

	la	t0, C_LAB(procedure_key)
	lw	t1, _KEY(a0)
	bne	t0, t1, 3f

	;;; Object is a procedure: get its updater

	lw	t0, _PD_UPDATER(a0)

	;;; If the updater is <false> (non-existent) raise an error

	beq	t0, false, 5f

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

	lw	t9, _PD_EXECUTE(t0)
	j	t9

DEF_C_LAB (_popuncenter)

	.aent	$popuncenter
$popuncenter:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	;;; Object in a0 is known to be a procedure: get its updater

	lw	t0, _PD_UPDATER(a0)

	;;; If the updater is <false> (non-existent) raise an error

	beq	t0, false, 5f

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

	lw	t9, _PD_EXECUTE(t0)
	j	t9

1:	;;; Applying the updater of a (simple) number:
	;;; get the appropriate key apply procedure (integer or decimal)
	;;; in t0

	and	t0, a0, 2
	beqz	t0, 2f

	;;; Integer key

	lw	t0, C_LAB(integer_key) + _K_APPLY
	b	4f

2:	;;; Decimal key

	lw	t0, C_LAB(weakref decimal_key) + _K_APPLY
	b	4f

3:	;;; Applying the updater of a structure:
	;;; get its key apply procedure in t0

	lw	t0, _K_APPLY(t1)

4:	;;; Push the object and check the updater of the key apply procedure
	;;; in t0

	sw	a0, -4(usp)
	lw	t0, _RF_CONT(t0)
	subu	usp, 4
	lw	t0, _PD_UPDATER(t0)
	beq	t0, false, 6f

	;;; Updater OK -- jump to its execute address

	lw	t9, _PD_EXECUTE(t0)
	j	t9

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

5:	;;; Push the object (still in a0)

	subu	usp, 4
	sw	a0, (usp)

6:	;;; Jump to the error routine

	la	t9, XC_LAB(-> Sys$-Exec_nonpd)
	j	t9

	.end	$popuenter


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

;;; _ERASE_SP_1:
;;;	Erases one word from the callstack, then chains -Callstack_reset-.
;;;	Used by -Callstack_reset- in cleaning up.

DEF_C_LAB (_erase_sp_1)

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

	addu	sp, 4
	la	t9, XC_LAB(Sys$-Callstack_reset)
	j	t9

	.end	$erase_sp_1


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

	.ent	$nextframe
$nextframe:

	;;; Load frame pointer to t0

	lw	t0, (usp)

	;;; Owner address in t1

	lw	t1, _SF_OWNER(t0)

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

	lbu	t1, _PD_FRAME_LEN(t1)

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


	sll	t1, 2
	addu	t0, t1
	sw	t0, (usp)
	j	ra

	.end	$nextframe


;;; _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, which will have placed its return address in ra.

;;;	The procedure's exit code will finish with a return (j ra) 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 (cr) from
;;;	where it can be restored with an M_CALL_WITH_RETURN operation.

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

DEF_C_LAB (_unwind_frame)

	.ent	$unwind_frame
$unwind_frame:

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

	lbu	t0, _PD_FRAME_LEN(pb)

	;;; Frame length in bytes

	sll	t0, 2

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

	addu	t0, sp
	lw	cr, -4(t0)
	sw	ra, -4(t0)

#_IF DEF PIC
	;;; The next word in the frame should be the saved context
	;;; pointer: if this is not restored, the exit code will be
	;;; invalid
	lw	gp, -8(t0)
#_ENDIF

	;;; Jump to the procedure's exit code

	lw	t1, _PD_EXIT(pb)
	j	t1

	.end	$unwind_frame


;;; === 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) executing a return (j ra). In the case of
;;;	_SYS(NC)CHAIN, the displaced return address is saved in CHAIN_REG (cr),
;;;	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)

	.ent	$syschain_caller
$syschain_caller:

	;;; Call _UNWIND_FRAME, which will leave the caller's return address
	;;; in CHAIN_REG

	bal	$unwind_frame

	.end	$syschain_caller

	;;; Fall through to direct chain

DEF_C_LAB (_syschain)

	.ent	$syschain
$syschain:

	;;; Get the object to chain from the stack

	lw	a0, (usp)
	addu	usp, 4

#_IF DEF PIC
	;;; By now we've lost any notion of where we are, so must set
	;;; the context pointer explicitly using a local branch-and-link
	bal	1f
1:	.set	noreorder
	CPLOAD	ra
	.set	reorder
#_ENDIF

	;;; Apply the object, with a return address reinstated from
	;;; CHAIN_REG. Use the alternative entry point for _popenter
	;;; because the context pointer is already set

	move	ra, cr
	b	$popenter_1

	.end	$syschain

DEF_C_LAB (_sysncchain_caller)

	.ent	$sysncchain_caller
$sysncchain_caller:

	;;; Call _UNWIND_FRAME, which will leave the caller's return address
	;;; in CHAIN_REG

	bal	$unwind_frame

	.end	$sysncchain_caller

	;;; Fall through to direct chain

DEF_C_LAB (_sysncchain)

	.ent	$sysncchain
$sysncchain:

	;;; Get the procedure to chain from the stack

	lw	a0, (usp)
	addu	usp, 4

	;;; Call it, with a return address reinstated from CHAIN_REG

	move	ra, cr
	lw	t9, _PD_EXECUTE(a0)
	j	t9

	.end	$sysncchain


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

	.ent	$iscompound
$iscompound:

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

	lw	t0, (usp)
	and	t0, 1
	beqz	t0, return_true
	sw	false, (usp)
	j	ra

	.end	$iscompound

DEF_C_LAB (_issimple)

	.ent	$issimple
$issimple:

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

	lw	t0, (usp)
	and	t0, 1
	bnez	t0, return_true
	sw	false, (usp)
	j	ra

	.end	$issimple

DEF_C_LAB (_isinteger)

	.ent	$isinteger
$isinteger:

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

	lw	t0, (usp)
	and	t0, 2
	bnez	t0, return_true
	sw	false, (usp)
	j	ra

	.end	$isinteger

DEF_C_LAB (_neg)

	.ent	$neg
$neg:

	;;; Object is negative

	lw	t0, (usp)
	bltz	t0, return_true
	sw	false, (usp)
	j	ra

	.end	$neg

DEF_C_LAB (_zero)

	.ent	$zero
$zero:

	;;; Object is (machine) zero

	lw	t0, (usp)
	beqz	t0, return_true
	sw	false, (usp)
	j	ra

	.end	$zero


DEF_C_LAB (_not)

	.ent	$not
$not:

	;;; Object is false

	lw	t0, (usp)
	beq	t0, false, return_true
	sw	false, (usp)
	j	ra

	.end	$not


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

	.ent	$eq
$eq:

	;;; Identity (pop ==)

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	beq	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$eq

DEF_C_LAB 7 (_neq)

	.ent	$neq
$neq:

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

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bne	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$neq

DEF_C_LAB 6 (_gr)

	.ent	$gr
$gr:

	;;; Unsigned greater than

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bgtu	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$gr

DEF_C_LAB 6 (_greq)

	.ent	$greq
$greq:

	;;; Unsigned greater than or equal

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bgeu	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$greq

DEF_C_LAB 6 (_lt)

	.ent	$lt
$lt:

	;;; Unsigned less than

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bltu	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$lt

DEF_C_LAB 6 (_lteq)

	.ent	$lteq
$lteq:

	;;; Unsigned less than or equal

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bleu	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$lteq

DEF_C_LAB 6 (_sgr)

	.ent	$sgr
$sgr:

	;;; Signed greater than

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bgt	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$sgr

DEF_C_LAB 6 (_sgreq)

	.ent	$sgreq
$sgreq:

	;;; Signed greater than or equal

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	bge	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$sgreq

DEF_C_LAB 6 (_slt)

	.ent	$slt
$slt:

	;;; Signed less than

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	blt	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$slt

DEF_C_LAB 6 (_slteq)

	.ent	$slteq
$slteq:

	;;; Signed less than or equal

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	ble	a0, a1, return_true
	sw	false, (usp)
	j	ra

	.end	$slteq


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

DEF_C_LAB 4 (_bitst)

	.ent	$bitst
$bitst:

	lw	a0, 4(usp)
	lw	a1, (usp)
	addu	usp, 4
	and	a0, a1
	bnez	a0, return_true
	sw	false, (usp)
	j	ra

	.end	$bitst


;;; _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:
;;;	a0	the object
;;;	a1	the key
;;;	t0	result of comparison

DEF_C_LAB (_haskey)

	.ent	$haskey
$haskey:

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

	;;; Test whether object is compound:
	;;; return <false> if not

	and	t0, a0, 1
	bnez	t0, 1f

	;;; Compare keys

	lw	a0, _KEY(a0)
	beq	a0, a1, return_true

1:	sw	false, (usp)
	j	ra

	.end	$haskey

	.ent	return_true
return_true:

	la	t0, _TRUE_OFFS(false)
	sw	t0, (usp)
	j	ra

	.end	return_true


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

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

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

DEF_C_LAB (_conspair)

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

	;;; Get the free pair list

	lw	t0, I_LAB(Sys$- _free_pairs)

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

	and	t1, t0, 1
	beqz	t1, 1f
	la	t9, XC_LAB(Sys$-Conspair)
	j	t9

1:	;;; Otherwise, get the first pair from the free list in t1

	lw	t1, _P_BACK(t0)

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

	lw	a0, 4(usp)
	sw	a0, _P_FRONT(t0)
	lw	a1, (usp)
	sw	a1, _P_BACK(t0)

	;;; Update the free list to be the back of the free list

	sw	t1, I_LAB(Sys$- _free_pairs)

	;;; Return the pair

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

	.end	$conspair


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

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

DEF_C_LAB (_datakey)

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

	;;; Load item to t0 and test for compound

	lw	t0, (usp)
	and	t1, t0, 1
	bnez	t1, 1f

	;;; Object is compound: extract key and return

	lw	t0, _KEY(t0)
	sw	t0, (usp)
	j	ra

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

	and	t1, t0, 2
	beqz	t1, 2f

	;;; Object is an integer

	la	t0, C_LAB(integer_key)
	sw	t0, (usp)
	j	ra

2:	;;; Object is a decimal

	la	t0, C_LAB(weakref decimal_key)
	sw	t0, (usp)
	j	ra

	.end	$datakey


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

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

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

;;; Register usage:
;;;	t0	index
;;;	t1	string address
;;;	t2	the indexed byte

DEF_C_LAB (_subss)

	.ent	$subss
$subss:

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

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

	srl	t0, 2
	addu	t1, t0
	lbu	t2, _V_BYTES-1(t1)

	;;; Return character as a popint

	sll	t2, 2
	addu	t2, 3
	sw	t2, (usp)
	j	ra

	.end	$subss


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

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

;;; Register usage:
;;;	t0	index
;;;	t1	string address
;;;	t2	the new character as a popint

DEF_C_LAB (-> _subss)
DEF_C_LAB (_u_subss)

	.ent	$u_subss
$u_subss:

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

	;;; Convert character and index to machine integers

	srl	t0, 2
	srl	t2, 2

	;;; Insert the new byte and return

	addu	t1, t0
	sb	t2, _V_BYTES-1(t1)
	j	ra

	.end	$u_subss


;;; _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:
;;;	a0	source address (saved for computing the offset)
;;;	a1	byte count
;;;	a2	byte to search for
;;; 	v0	the result
;;;	t0	source pointer during search
;;;	t1	current byte

DEF_C_LAB (_locc)

	.ent	$locc
$locc:

	;;; Load the byte count to a1 and the byte to search for to a2

	lw	a1, 4(usp)
	lw	a2, (usp)
	addu	usp, 8

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

	beqz	a1, 2f

	;;; Load the string address to a0 and copy into t0

	lw	a0, (usp)
	move	t0, a0

1:	;;; Loop

	;;; Load the byte pointed to by t0 to t1; if it's the one we're
	;;; looking for, return the offset

	lbu	t1, (t0)
	beq	t1, a2, 3f

	;;; Otherwise decrement the count and increment the source pointer

	subu	a1, 1
	addu	t0, 1

	;;; If the count is non-zero, jump back to the start of the loop

	bnez	a1, 1b

2:	;;; Failure: return -1

	li	v0, -1
	sw	v0, (usp)
	j	ra

3:	;;; Success -- calculate offset by subtracting source address (in a0)
	;;; from current value of source pointer (in t0) and return it

	subu	v0, t0, a0
	sw	v0, (usp)
	j	ra

	.end	$locc


;;; _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:
;;;	a0	source address (saved for computing the offset)
;;;	a1	byte count
;;;	a2	byte to search for
;;; 	v0	the result
;;;	t0	source pointer during search
;;;	t1	current byte

DEF_C_LAB (_skpc)

	.ent	$skpc
$skpc:

	;;; Load the byte count to a1 and the byte to search for to a2

	lw	a1, 4(usp)
	lw	a2, (usp)
	addu	usp, 8

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

	beqz	a1, 2f

	;;; Load the string address to a0 and copy into t0

	lw	a0, (usp)
	move	t0, a0

1:	;;; Loop

	;;; Load the byte pointed to by t0 to t1; if it's different to the
	;;; given byte, return the offset

	lbu	t1, (t0)
	bne	t1, a2, 3f

	;;; Otherwise decrement the count and increment the source pointer

	subu	a1, 1
	addu	t0, 1

	;;; If the count is non-zero, jump back to the start of the loop

	bnez	a1, 1b

2:	;;; Failure: return -1

	li	v0, -1
	sw	v0, (usp)
	j	ra

3:	;;; Success -- calculate offset by subtracting source address (in a0)
	;;; from current value of source pointer (in t0) and return it

	subu	v0, t0, a0
	sw	v0, (usp)
	j	ra

	.end	$skpc


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

;;; _CHECKPLOGALL:
;;; _CHECKALL:
;;; _CHECKINTERRUPT:
;;;	Procedure entry checks, etc. These need to be fast, so we avoid
;;; 	the overhead of setting the context pointer unless some check
;;; 	fails.

;;; Registers used:
;;;	a0	interrupt flag
;;;	a1	callstack limit
;;;	a2	userstack limit

DEF_C_LAB (_checkplogall)

	.ent	$checkplogall
$checkplogall:
	.set	noreorder

	lw	t0, _SVB_OFFS(_plog_trail_lim)(svb)
	lw	t1, _SVB_OFFS(_plog_trail_sp)(svb)
	lw	a0, _SVB_OFFS(_trap)(svb)
	lw	a1, _SVB_OFFS(_userlim)(svb)

	sltu	v0, t1, t0		;;; check trail
	beqz	v0, 1f
	lw	a2, _SVB_OFFS(_call_stack_lim)(svb)

	bnez	a0, 1f			;;; check interrupt
	sltu	t0, usp, a1		;;; check user stack
	bnez	t0, 1f
	sltu	t0, sp, a2		;;; check call stack
	bnez	t0, 1f
	nop

	j	ra			;;; OK
	nop

1:	;;; Something needs fixing

	addu	t9, 64			;;; t9 = $checkplogall + 16*4
	CPLOAD	t9
	bnez	v0, $fixup

	;;; Trail overflow

	la	t9, XC_LAB(weakref[prologvar_key] Sys$-Plog$-Area_overflow)
	j	t9
	nop

	.set	reorder
	.end	$checkplogall

DEF_C_LAB (_checkall)

	.ent	$checkall
$checkall:
	.set	noreorder

	lw	a0, _SVB_OFFS(_trap)(svb)
	lw	a1, _SVB_OFFS(_userlim)(svb)
	bnez	a0, 1f			;;; check interrupt
	lw	a2, _SVB_OFFS(_call_stack_lim)(svb)
	sltu	t0, usp, a1		;;; check user stack
	bnez	t0, 1f
	sltu	t0, sp, a2		;;; check call stack
	bnez	t0, 1f
	nop

	j	ra			;;; OK
	nop

1:	;;; Something needs fixing

	addu	t9, 48			;;; t9 = $checkall + 12*4
	CPLOAD	t9
	b	$fixup
	nop

	.set	reorder
	.end	$checkall

DEF_C_LAB (_checkinterrupt)

	.ent	$checkinterrupt
$checkinterrupt:
	.set	noreorder

	lw	a0, _SVB_OFFS(_trap)(svb)
	lw	a1, _SVB_OFFS(_userlim)(svb)
	bnez	a0, 1f			;;; check interrupt
	lw	a2, _SVB_OFFS(_call_stack_lim)(svb)

	j	ra			;;; OK
	nop

1:	;;; Signal(s) pending: call $fixup

	addu	t9, 28			;;; t9 = $checkinterrupt + 7*4
	CPLOAD	t9
	b	$fixup
	nop

	.set	reorder
	.end	$checkinterrupt

	.ent	$fixup
$fixup:

	lw	v0, I_LAB(_disable)

	sltu	t0, sp, a2		;;; check call stack
	and	t1, v0, 2		;;; disabled?
	beqz	t0, 1f
	bnez	t1, 2f
	la	t9, XC_LAB(Sys$-Call_overflow)
	j	t9

1:	sltu	t0, usp, a1		;;; check user stack
	and	t1, v0, 2		;;; disabled?
	beqz	t0, 2f
	bnez	t1, 2f
	la	t9, XC_LAB(Sys$-User_overflow)
	j	t9

2:					;;; check interrupt
	and	t1, v0, 1		;;; disabled?
	beqz	a0, 3f
	bnez	t1, 3f
	la	t9, XC_LAB(Sys$-Async_raise_signal)
	j	t9

3:	j	ra

	.end	$fixup


;;; === SETUP POPLOG REGISTERS ========================================

;;; _RESET_POP_REG_ENVIRON:
;;;	Set register values for POP environment

;;; Used by:
;;;	main (in "amain.s")
;;;	reset_pop_environ (in "asignals.s")

	.globl	reset_pop_reg_environ
	.ent	reset_pop_reg_environ
reset_pop_reg_environ:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	;;; Set fixed registers

	la	false, C_LAB(false)
	la	svb, C_LAB(_special_var_block)

	;;; Set pop lvar registers to safe value

	move	p0, false
	move	p1, false

	j	ra

	.end	reset_pop_reg_environ


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

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

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



/* --- Revision History ---------------------------------------------------
--- John Gibson, Feb 10 1997
	Removed _mt*chc subroutine
--- John Gibson, Oct 18 1994
	free*pairs -> _free_pairs
--- Robert John Duncan, Mar 22 1994
	Removed procedure assignments to a0 (again).
	Changed external jumps to go off t9.
	Fixed setting of context pointer in check routines.
--- Robert John Duncan, Mar 15 1994
	Removed the wrapping structure from the text section
--- Robert John Duncan, Mar 15 1994
	Restored the calling convention that the procedure address is
	passed in a0 __as ____well __as the execute address going in t9.
--- Robert John Duncan, Mar 10 1994
	Made position-independent.
--- Robert John Duncan, Mar  8 1994
	Added .ent/.end directives
--- Robert John Duncan, Mar  7 1994
	Change for new pop calling convention: instead of the procedure
	address being passed in $a0, the execute address is passed in $t9.
	Also, all indirect subroutine calls now go through $t9.
--- Simon Nichols, Nov 10 1993
	Renamed amisc.s and moved the main routine to amain.s
--- John Gibson, Oct  2 1992
	Got rid of _c*mpc_order
--- Robert John Duncan, Jul 10 1990
	Added initialisation of _gp variable for use in "ass.p"
--- Robert John Duncan, Jul  4 1990
	Added extern declarations for special vars and changed
	checkall/checkplogall not to use special_var_block
 */
