/* --- Copyright University of Sussex 1997. All rights reserved. ----------
 * File:	C.hppa/src/amisc.s
 * Purpose:	Miscellaneous assembler routines for HP PA-RISC 1.1
 * Author:	Julian Clinton, November 1993 (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, Exec_closure)
	;

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,
	_V_BYTES	= @@V_BYTES,

	;;; This next needs -1 adjustment for the inverted callstack
	_SF_OWNER	= @@SF_OWNER[_-1],

);

>_#


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

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

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

;;; Arguments:
;;;	%arg0	object to be applied

;;; Register Usage:
;;;	%t1	key of compound object
;;;	%t2	procedure key

DEF_C_LAB (_popenter)

	;;; Test LSB to see if the object is simple or compound:
	bb,<,n		%arg0, 31, L$1		;;; branch if simple

	;;; The object is compound: load its key to %t1.
	ldw		_KEY(%arg0), %t1

	;;; Load the procedure_key to %t2 and see if object is a procedure
	LDA32		C_LAB(procedure_key), %t2
	comb,<>,n       %t1, %t2, L$2

	;;; If the branch is not taken, the object is a procedure:
	;;; to call it, we need its execute address.
	ldw		_PD_EXECUTE(%arg0), %t1

	;;; The load may take time to complete: we want to fill the time
	;;; with useful work.

	;;; Because the target procedure may be either a system
	;;; procedure in code space or a user procedure in data space,
	;;; we have to play safe and use an external (inter-space)
	;;; branch to reach it. That requires nominating an explicit
	;;; space ID. Which one to use can be determined from the two
	;;; high-order bits of the target: the instruction LDSID (load
	;;; space identifier) does this job, but it puts the appropriate
	;;; space ID in a general register. The instruction MTSP (move
	;;; to space register) then copies it back to the scratch space
	;;; register %sr0.

	;;; Although the space ID to use should be that corresponding to
	;;; the procedure's execute address, it's always the case that
	;;; the procedure code is contiguous with the procedure record,
	;;; so we can use the procedure address itself to compute the
	;;; space ID while the execute address is still loading.
	ldsid		(%arg0), %t2
	mtsp		%t2, %sr0

	;;; Make the call: no need for a return address because the
	;;; callee will inherit the return address of our caller (i.e.
	;;; this is a chain). The branch has a no-op in the delay slot
	;;; because we've run out of useful things to do.

	;;; Assuming no extra load delays, the time between entry and
	;;; exit of this routine is 10 cycles, which is identical to
	;;; that on a SPARC and better than that on a MIPS (at 12
	;;; cycles) despite the external branch.
	be		(%sr0, %t1)
	nop


	;;; From this point, we're applying a non-procedure object using
	;;; the rule:
	;;;
	;;;     x() ==> class_apply(datakey(x))(x)
	;;;
	;;; We want the object's key in %t1.

L$1     ;;; The object is simple: the key must be integer_key or
	;;; decimal_key depending on the 2nd low-order bit (bit 30).
	bb,<		%arg0, 30, L$11

	;;; If the branch is not taken, the object is a decimal:
	;;; loading the high-order part of the decimal_key is safe
	;;; regardless of the object's type, so it can go in this delay
	;;; slot
	ldil		L%C_LAB(weakref decimal_key), %t1
	b		L$2
	ldo		R%C_LAB(weakref decimal_key)(%t1), %t1	;;; branch delay slot

L$11    ;;; The object is integer
	LDA32		C_LAB(integer_key), %t1

L$2     ;;; The object's key is now in %t1: load the K_APPLY field
	ldw		_K_APPLY(%t1), %t1

	;;; While the load completes, push the object back on the user
	;;; stack as an additional argument to the call.
	stwm		%arg0, -4(%usp)

	;;; The K_APPLY field actually contains a reference (because it's
	;;; updatable) so there's another level of indirection to go through
	;;; before we get to the class_apply procedure.
	ldw		_RF_CONT(%t1), %arg0

	;;; The object just loaded must be a procedure (the updater of
	;;; class_apply will check it) so we can go straight to it using
	;;; the same code sequence as before. The initial reference to
	;;; %arg0 will probably cause a stall while the load completes,
	;;; but there's nothing else to do.
	ldw		_PD_EXECUTE(%arg0), %t1
	ldsid		(%arg0), %t2
	mtsp		%t2, %sr0
	be		(%sr0, %t1)
	nop


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

;;; Register Usage:
;;;	%t1	object key; updater procedure
;;;	%t2	procedure key

DEF_C_LAB (_popuenter)

	;;; Test object for simple or compound
	bb,<,n  	%arg0, 31, L$21

	;;; Object is compound: compare key with procedure key
	ldw		_KEY(%arg0), %t1
	LDA32		C_LAB(procedure_key), %t2
	comb,<>,n	%t1, %t2, L$23	;;; branch if not pdr

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

DEF_C_LAB (_popuncenter)

	;;; Object in %arg0 is known to be a procedure: load its updater
	;;; to %t1 If the updater is <false> (non-existent) raise an error
	ldw		_PD_UPDATER(%arg0), %t1
	comb,=,n	%t1, %false, L$24

	;;; Otherwise go to the updater's execute address
	CHAIN		%t1
	nop

L$21	;;; Applying the updater of a (simple) number:
	;;; get the appropriate key (integer or decimal) to %t1
	bb,<,n		%arg0, 30, L$22		;;; bit 30 set => integer

	;;; Decimal key
	ldil    	L%C_LAB(weakref decimal_key), %t1
	b       	L$23
	ldo	  	R%C_LAB(weakref decimal_key)(%t1), %t1

L$22	;;; Integer key
	LDA32		C_LAB(integer_key), %t1

L$23	;;; Applying the updater of a structure:
	;;; get its key apply procedure in %t1
	ldw		_K_APPLY(%t1), %t1

	;;; Push the object and check the updater of the key apply procedure
	;;; in %t1
	stwm		%arg0, -4(%usp)
	ldw		_RF_CONT(%t1), %t1
	ldw		_PD_UPDATER(%t1), %t1
	comb,=,n	%t1, %false, L$24

	;;; Updater OK -- jump to its execute address
	CHAIN		%t1
	nop

L$24	;;; Object has no updater -- raise an error
	CHAINSYS	XC_LAB(-> Sys$-Exec_nonpd)
	stwm		%arg0, -4(%usp)


;;; _EXEC_CLOS_CODE_TEMPLATE:
;;;	template for calling Sys$-Exec_closure (copied by Cons_closure
;;;	in "closure_cons.p").

DEF_C_LAB (Sys$- _exec_clos_code_template)

	ldil		L'XC_LAB(Sys$-Exec_closure), %r1
	be		R'XC_LAB(Sys$-Exec_closure)(%sr4, %r1)
	nop


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

	CHAINSYS	XC_LAB(Sys$-Callstack_reset)
	addi		-4, %sp, %sp


;;; _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 %t1
	ldwm		4(%usp), %t1

	;;; Owner address in %t2
	ldw		_SF_OWNER(%t1), %t2

	;;; Find the length of the frame (in longwords) from the owner's
	;;; procedure header
	ldb		_PD_FRAME_LEN(%t2), %t2

	;;; Subtract the frame length in bytes (%t2 * 4) from the given
	;;; frame pointer to get the next frame pointer.
	sh2add		%t2, 0, %t2		;;; length in bytes
	sub		%t1, %t2, %t1
	RETE
	stwm		%t1, -4(%usp)		;;; branch delay slot


;;; _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 %r31.

;;;	The procedure's exit code will finish with a return 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 (%chain) 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)

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

	;;; Frame length in bytes
	sh2add		%t1, 0, %t1

	;;; The last word in that frame will be the return address:
	;;; copy that to CHAIN_REG, then replace it with our return
	sub		%sp, %t1, %t1
	ldw		(%t1), %chain

	;;; Jump to the procedure's exit code
	ldw		_PD_EXIT(%pb), %t2
	ldsid		(%pb), %t3
	mtsp		%t3, %sr0
	be		(%sr0, %t2)
	stw		%r31, (%t1)


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

	;;; Call _UNWIND_FRAME, which will leave the caller's return address
	;;; in CHAIN_REG
	bl		C_LAB(_unwind_frame), %r31
	nop

	;;; Fall through to direct chain

DEF_C_LAB (_syschain)

	;;; Reinstate the return address from CHAIN_REG
	copy		%chain, %r31

	;;; Get the object to chain from the stack and run it
	b		C_LAB(_popenter)
	ldwm		4(%usp), %arg0		;;; branch delay slot

DEF_C_LAB (_sysncchain_caller)

	;;; Call _UNWIND_FRAME, which will leave the caller's return address
	;;; in CHAIN_REG
	bl		C_LAB(_unwind_frame), %r31
	nop

	;;; Fall through to direct chain

DEF_C_LAB (_sysncchain)

	;;; Reinstate the return address from CHAIN_REG
	copy		%chain, %r31

	;;; Chain the procedure from the stack
	ldwm		4(%usp), %arg0
	CHAIN		%arg0
	nop


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

;;; _ISCOMPOUND:
;;; _ISSIMPLE:
;;; _ISINTEGER:
;;; _NEG:
;;; _ZERO:
;;; _NOT:
;;;	Unary predicates: expect one argument on the user stack, and
;;;	pop either true or false
;;;	PUSH_TRUE provides a common exit point for the success case

;;; Register usage:
;;;	%t1	item being tested

DEF_C_LAB (_iscompound)

	;;; Object is a pop pointer -- bottom bit clear
	ldwm		4(%usp), %t1
	bb,>=,n 	%t1, 31, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB (_issimple)

	;;; Object is not a pop pointer -- bottom bit set
	ldwm		4(%usp), %t1
	bb,<,n 		%t1, 31, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB (_isinteger)

	;;; Object is a pop integer -- second bit set
	ldwm		4(%usp), %t1
	bb,<,n 		%t1, 30, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB (_neg)

	;;; Object is negative (bit0 set)
	ldwm		4(%usp), %t1
	bb,<,n 		%t1, 0, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB (_zero)

	;;; Object is (machine) zero
	ldwm		4(%usp), %t1
	comb,=,n 	%t1, 0, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB (_not)

	;;; Object is false
	ldwm		4(%usp), %t1
	comb,=,n 	%t1, %false, push_true
	RETE
	stwm		%false, -4(%usp)


;;; _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 ==)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,=,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 7 (_neq)

	;;; Non-identity (pop /==)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,<>,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_gr)

	;;; Unsigned greater than (%t1 > %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,>>,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_greq)

	;;; Unsigned greater than or equal (%t1 >= %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,>>=,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_lt)

	;;; Unsigned less than (%t1 < %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,<<,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_lteq)

	;;; Unsigned less than or equal (%t1 <= %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,<<=,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_sgr)

	;;; Signed greater than (%t1 > %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,>,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_sgreq)

	;;; Signed greater than or equal (%t1 >= %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,>=,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_slt)

	;;; Signed less than (%t1 < %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,<,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


DEF_C_LAB 6 (_slteq)

	;;; Signed less than or equal (%t1 <= %t2)
	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	comb,<=,n	%t1, %t2, push_true
	RETE
	stwm		%false, -4(%usp)


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

DEF_C_LAB 4 (_bitst)

	ldwm		4(%usp), %t2
	ldwm		4(%usp), %t1
	and,=		%t1, %t2, %t1		;;; <false> if all bits are 0
	b,n		push_true		;;; otherwise return <true>
	RETE
	stwm		%false, -4(%usp)


;;; _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:
;;;	%arg0	the object on stack
;;;	%arg1	the key on the stack
;;;	%t1	the key of the object on the stack

DEF_C_LAB (_haskey)

	;;; Load key to %arg1 and object to %arg0
	ldwm		4(%usp), %arg1
	ldwm		4(%usp), %arg0

	;;; Test whether object is compound: return <false> if not
	bb,<,n 		%arg0, 31, L$30		;;; false if bit31 is 1

	;;; Compare keys
	ldw		_KEY(%arg0), %t1
	comb,=,n	%t1, %arg1, push_true

L$30    RETE
	stwm		%false, -4(%usp)


push_true
	;;; common exit point for success

	LDA32		C_LAB(true), %t1
	RETE
	stwm		%t1, -4(%usp)



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

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

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

DEF_C_LAB (_conspair)

	;;; Get the free pair list
	LDV32		I_LAB(Sys$- _free_pairs), %t1

	;;; If its simple, there's nothing left -- chain the storage
	;;; allocator
	bb,>=,n		%t1, 31, L$35		;;; branch if compound
	CHAINSYS	XC_LAB(Sys$-Conspair)
	nop

L$35 	;;; Otherwise, get the first pair from the free list in %t2
	ldw		_P_BACK(%t1), %t2

	;;; Initialise the new pair with the values from the stack
	ldwm		4(%usp), %t3
	ldwm		4(%usp), %t4
	stw		%t3, _P_BACK(%t1)
	stw		%t4, _P_FRONT(%t1)

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

	;;; Return the pair
	RETE
	stwm		%t1, -4(%usp)		;;; branch delay slot


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

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

;;; Register usage:
;;;	%t1	ITEM and then its key

DEF_C_LAB (_datakey)

	;;; Load item to %t1 and test for compound
	ldwm		4(%usp), %t1
	bb,<,n  	%t1, 31, L$41		;;; branch if simple

	;;; Object is compound: extract key and return
	ldw		_KEY(%t1), %t1
	RETE
	stwm		%t1, -4(%usp)

L$41 	;;; Object is a (simple) number:
	;;; return integer or decimal key as appropriate
	bb,>=,n  	%t1, 30, L$42		;;; branch if decimal

	;;; Object is an integer
	LDA32		C_LAB(integer_key), %t1
	RETE
	stwm		%t1, -4(%usp)

L$42 	;;; Object is a decimal
	LDA32		C_LAB(weakref decimal_key), %t1
	RETE
	stwm		%t1, -4(%usp)


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

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

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

;;; Register usage:
;;;	%arg0	index
;;;	%arg1	string address
;;;	%t1	the indexed byte

DEF_C_LAB (_subss)

	ldwm		4(%usp), %arg1
	ldwm		4(%usp), %arg0

	;;; Convert index to a machine integer and load the indexed byte
	;;; (zero extended) into %arg0
	extrs		%arg0, 29, 30, %arg0
	add		%arg0, %arg1, %arg1
	ldb		_V_BYTES-1(%arg1), %t1

	;;; Return character as a popint
	sh2add		%t1, %pzero, %t1
	RETE
	stwm		%t1, -4(%usp)


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

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

;;; Register usage:
;;;	%arg0	index
;;;	%arg1	string address
;;;	%t1	the new character as a popint

DEF_C_LAB (-> _subss)
DEF_C_LAB (_u_subss)

	ldwm		4(%usp), %arg1		;;; string address
	ldwm		4(%usp), %arg0		;;; index
	ldwm		4(%usp), %t1		;;; character

	;;; Convert character and index to machine integers
	extrs		%arg0, 29, 30, %arg0
	extrs		%t1, 29, 30, %t1

	;;; Insert the new byte and return
	add		%arg1, %arg0, %arg1
	RETE
	stb		%t1, _V_BYTES-1(%arg1)


;;; _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:
;;;	%arg0	source address (saved for computing the offset)
;;;	%arg1	byte count
;;;	%arg2	byte to search for
;;;	%t1	source pointer during search
;;;	%t2	current byte

DEF_C_LAB (_locc)

	;;; Load the byte count to %arg1 and the byte to search for to %arg2
	ldwm		4(%usp), %arg2
	ldwm		4(%usp), %arg1

	;;; Test the byte-count in %arg1 for zero:
	;;; if so, nothing to search, so return -1 immediately
	comb,=,n	%arg1, 0, L$52

	;;; Load the string address to %arg0 and copy into %t1
	ldw		(%usp), %arg0	;;; leave %usp pointing at _SRCADDR
	copy		%arg0, %t1

	;;; Load the byte pointed to by %t1 to %t2 (first time through loop)
	ldb		(%t1), %t2

L$51	;;; Loop

	;;; If the byte is one we're looking for, return the offset
	comb,=,n	%t2, %arg2, L$53

	;;; Otherwise decrement the count. If the count is non-zero,
	;;; increment pointer, load byte and jump back to the start of the loop
	addib,<>,n	-1, %arg1, L$51
	ldbs,mb		1(%t1), %t2	;;; branch delay slot

L$52	;;; Failure: return -1
	ldi		-1, %arg0
	RETE
	stw		%arg0, (%usp)	;;; overwrite _SRCADDR

L$53	;;; Success -- calculate offset by subtracting source address (in %arg0)
	;;; from current value of source pointer (in %t1) and return it
	sub		%t1, %arg0, %t1
	RETE
	stw		%t1, (%usp)	;;; overwrite _SRCADDR


;;; _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:
;;;	%arg0	source address (saved for computing the offset)
;;;	%arg1	byte count
;;;	%arg2	byte to search for
;;;	%t1	source pointer during search
;;;	%t2	current byte

DEF_C_LAB (_skpc)

	;;; Load the byte count to %arg1 and the byte to search for to %arg2
	ldwm		4(%usp), %arg2
	ldwm		4(%usp), %arg1

	;;; Test the byte-count in %arg1 for zero:
	;;; if so, nothing to search, so return -1 immediately
	comb,=,n	%arg1, 0, L$62

	;;; Load the string address to %arg0 and copy into %t1
	ldw		(%usp), %arg0	;;; leave %usp pointing at _SRCADDR
	copy		%arg0, %t1

	;;; Load the byte pointed to by %t1 to %t2 (first time through loop)
	ldb		(%t1), %t2

L$61	;;; Loop

	;;; If the byte is not the one we're looking for, return the offset
	comb,<>,n	%t2, %arg2, L$63

	;;; Otherwise decrement the count. If the count is non-zero,
	;;; increment pointer, load byte and jump back to the start of the loop
	addib,<>,n	-1, %arg1, L$61
	ldbs,mb		1(%t1), %t2	;;; branch delay slot

L$62	;;; Failure: return -1
	ldi		-1, %arg0
	RETE
	stw		%arg0, (%usp)	;;; overwrite _SRCADDR

L$63	;;; Success -- calculate offset by subtracting source address (in %arg0)
	;;; from current value of source pointer (in %t1) and return it
	sub		%t1, %arg0, %t1
	RETE
	stw		%t1, (%usp)	;;; overwrite _SRCADDR


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

;;; _CHECKINTERRUPT:
;;;	Check interrupt flag and call CHECKALL if set

DEF_C_LAB (_checkinterrupt)

	ldw		_SVB_OFFS(_trap)(%svb), %t1
	comb,<>,n	%t1, 0, C_LAB(_checkall)
	RETE
	nop


;;; _CHECKPLOGALL:
;;; _CHECKALL:
;;;	Procedure entry checks.

;;; Registers used:
;;;	%t1	(a) interrupt flag
;;;		(b) Prolog trail stack limit (in CHECKPLOGALL)
;;;	%t2	userstack limit
;;;	%t3	callstack limit
;;;	%t4	(a) disable flag
;;;		(b) Prolog trail pointer (in CHECKPLOGALL)

DEF_C_LAB (_checkplogall)

	ldw		_SVB_OFFS(_plog_trail_lim)(%svb), %t1
	ldw		_SVB_OFFS(_plog_trail_sp)(%svb), %t4
	ldw		_SVB_OFFS(_call_stack_lim)(%svb), %t3
	ldw		_SVB_OFFS(_userlim)(%svb), %t2

	;;; Check the trail pointer:
	;;; trail grows up, so _plog_trail_sp < _plog_trail_lim is OK
	comb,<<		%t4, %t1, dochecks
	ldw		_SVB_OFFS(_trap)(%svb), %t1

	;;; Trail overflow: chain Plog$-Area_overflow
	CHAINSYS	XC_LAB(weakref[prologvar_key] Sys$-Plog$-Area_overflow)
	nop


DEF_C_LAB (_checkall)

	ldw		_SVB_OFFS(_call_stack_lim)(%svb), %t3
	ldw		_SVB_OFFS(_userlim)(%svb), %t2
	ldw		_SVB_OFFS(_trap)(%svb), %t1

dochecks
	;;; Do standard entry checks:

	;;; Check the call stack:
	;;; stack grows up, so overflow if sp > _call_stack_lim
	comb,>>,n	%sp, %t3, L$92

	;;; Check the userstack:
	;;; userstack grows down, so overflow if usp < _userlim
	comb,<<,n	%usp, %t2, L$93

L$91	;;; Check for interrupt:
	;;; interrupted if bottom bit of _trap is set
	bb,<,n		%t1, 31, L$94

	;;; OK
	RETE
	nop

L$92	;;; Call stack overflow: if not disabled, jump to repair,
	;;; otherwise go back to do interrupt check
	LDV32		I_LAB(_disable), %t4
	bb,<		%t4, 30, L$91
	nop
	CHAINSYS	XC_LAB(Sys$-Call_overflow)
	nop

L$93	;;; Userstack overflow: if not disabled, jump to repair,
	;;; otherwise go back to do interrupt check
	LDV32		I_LAB(_disable), %t4
	bb,<		%t4, 30, L$91
	nop
	CHAINSYS	XC_LAB(Sys$-User_overflow)
	nop

L$94	;;; Interrupt: if not disabled, chain the signal handler,
	;;; otherwise just return
	LDV32		I_LAB(_disable), %t4
	bb,<,n		%t4, 31, L$95
	CHAINSYS	XC_LAB(Sys$-Async_raise_signal)
	nop

L$95	;;; OK
	RETE
	nop


;;; == CACHE FLUSH ========================================================

;;; cacheflush(_ADDR, _LEN) -> _0
;;;	flush a region from instruction and data caches starting at _ADDR
;;;	and extending for _LEN bytes.

;;;     THIS CODE WAS ADAPTED FROM CODE PROVIDED BY HP. IT ASSUMES A
;;;     MINIMUM CACHELINE SIZE OF 16 BYTES.

;;; Registers:
;;;	%arg0	_ADDR
;;;	%arg1	_LEN
;;;	%ret0	_0
;;;	%t1	loop counter (1)
;;;	%t2	loop counter (2)
;;;	%t3	data space ID
;;;	%sr0	data space ID

	.export		cacheflush, entry
cacheflush
	.proc
	.callinfo	no_calls,frame=0
	.enter

	comb,=		%arg1, 0, return
	copy		0, %ret0

	;;; convert _LEN to offset rounded to a word boundary

	addi		-1, %arg1, %t1
	dep		0, 31, 2, %t1

	;;; save in %t2 for second loop

	copy		%t1, %t2

	;;; initialise %sr0 with space ID of region to flush

	ldsid		(0, %arg0), %t3
	mtsp		%t3, %sr0

	;;; flush the data cache

	fdc		%t1(0, %arg0)
dloop	addib,>,n	-16, %t1, dloop
	fdc		%t1(0, %arg0)
	fdc		0(0, %arg0)
	sync

	;;; flush the instruction cache

	fic		%t2(%sr0, %arg0)
iloop	addib,>,n	-16, %t2, iloop
	fic		%t2(%sr0, %arg0)
	fic		0(%sr0, %arg0)
	sync

	;;; there must be at least seven instructions executed between
	;;; here and the first instruction of the flushed region: we can
	;;; assume that the procedure exit code, plus the trailing code
	;;; from _call_sys will more than account for these

return
	.leave
	.procend


;;; === ENTRY TO POPLOG ===============================================

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

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

	.export		reset_pop_reg_environ, code
reset_pop_reg_environ

	;;; Set FALSE register
	LDA32		C_LAB(false), %false

	;;; Set the special variable block register
	LDA32		C_LAB(_special_var_block), %svb

	;;; Set popint0
	ldi		3, %pzero

	;;; Set pop lvar registers to safe value (check $popsrc/asm_macros.h
	;;; for a list of Pop register names)
	copy		%false, %pop0
	copy		%false, %pop1
	copy		%false, %pop2
	copy		%false, %pop3
	copy		%false, %pop4
	RET					;;; local return
	copy		%false, %pop5


	.code
	.import		C_LAB(Sys$-objmod_pad_key), data
	.import		C_LAB(procedure_key), data
	.import		C_LAB(weakref decimal_key), data
	.import		C_LAB(integer_key), data
	.import		C_LAB(true), data
	.import		C_LAB(false), data
	.import		C_LAB(_special_var_block), data
	.import		XC_LAB(-> Sys$-Exec_nonpd), data
	.import		XC_LAB(Sys$-Exec_closure), data
	.import		XC_LAB(Sys$-Callstack_reset), data
	.import		XC_LAB(Sys$-Conspair), data
	.import		XC_LAB(weakref[prologvar_key] Sys$-Plog$-Area_overflow),data
	.import		XC_LAB(Sys$-Call_overflow), data
	.import		XC_LAB(Sys$-User_overflow), data
	.import		XC_LAB(Sys$-Async_raise_signal), data
	.import		I_LAB(Sys$- _free_pairs), data
	.import		I_LAB(_disable), data


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

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

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


/* --- Revision History ---------------------------------------------------
--- John Gibson, Feb 10 1997
	Removed _mt*chc subroutine
--- John Gibson, Oct 18 1994
	free*pairs -> _free_pairs
--- Integral Solutions Ltd (Julian Clinton), Nov 16 1993
   Renamed amisc.s and moved the main routine to amain.s
--- Robert John Duncan, May 24 1993
	Got rid of _c*mpc_order
 */
