/* --- Copyright University of Sussex 1998. All rights reserved. ----------
 * File:            C.power/src/amisc.s
 * Purpose:         Miscellaneous Assembler routines
 * Author:          John Gibson, Feb 26 1998
 */

;;;	***********************************************
;;;	****         NOTE ASSEMBLER BUG:          *****
;;;	****  (___reg) DOES NOT ASSEMBLE AS 0(___reg)   *****
;;;	***********************************************

#_<

#_INCLUDE 'asm.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;

>_#


ASM_START_FILE


ASM_CODE_PSECT


;;;---------------------------------------------------------------------------

	;;; do checks

ASM_ALIGN_QUAD
DEF_C_LAB (_checkplogall)
	ldW	rt1, _SVB_OFFS(_call_stack_lim)(rsvb)
	ldW	rt2, _SVB_OFFS(_userlim)(rsvb)
	cmplW	CR1, rsp, rt1		;;; CR1-lt set if callstack overflow
	ldW	rt3, _SVB_OFFS(_trap)(rsvb)
	cmplW	CR2, rusp, rt2		;;; CR2-lt set if user overflow
	ldW	rt4, _SVB_OFFS(_plog_trail_sp)(rsvb)
	cmplWi	CR3, rt3, 0		;;; CR3-eq set if no trap pending
	ldW	rt5, _SVB_OFFS(_plog_trail_lim)(rsvb)
	cmplW	CR4, rt4, rt5		;;; CR4-lt set if no trail overflow
	cror	CR5*4+Clt, CR1*4+Clt, CR2*4+Clt ;;; CR5-lt set if stack overflow
	crandc	CR6*4+Ceq, CR3*4+Ceq, CR5*4+Clt ;;; CR6-eq set if no trap/overflow
	crand	CR7*4+Ceq, CR6*4+Ceq, CR4*4+Clt ;;; CR7-eq set if that or no trail overflow
	btlr+	CR7*4+Ceq		;;; return if so

	bt	CR4*4+Clt, checkall_failed	;;; br if no trail overflow
	ldW	rpb, _SVB_OFFS(weakref[prologvar_key] Sys$-Plog$-Area_overflow)(rsvb)
	ldW	rt0, _PD_EXECUTE(rpb)
	mtctr	rt0
	bctr				;;; else chain Area_overflow


ASM_ALIGN_QUAD
DEF_C_LAB (_checkinterrupt)
	ldW	rt0, _SVB_OFFS(_trap)(rsvb)
	mr.	rt0, rt0		;;; test zero
	bzlr+				;;; return if no trap pending
	;;; else fall thru to _checkall

ASM_ALIGN_QUAD
DEF_C_LAB (_checkall)
	ldW	rt1, _SVB_OFFS(_call_stack_lim)(rsvb)
	ldW	rt2, _SVB_OFFS(_userlim)(rsvb)
	cmplW	CR1, rsp, rt1		;;; CR1-lt set if callstack overflow
	ldW	rt3, _SVB_OFFS(_trap)(rsvb)
	cmplW	CR2, rusp, rt2		;;; CR2-lt set if user overflow
	cmplWi	CR3, rt3, 0		;;; CR3-eq set if no trap pending
	cror	CR5*4+Clt, CR1*4+Clt, CR2*4+Clt ;;; CR5-lt set if stack overflow
	crandc	CR6*4+Ceq, CR3*4+Ceq, CR5*4+Clt ;;; CR6-eq set if no trap/overflow
	btlr+	CR6*4+Ceq		;;; return if so

	;;; one or more checks failed
ASM_ALIGN_QUAD
checkall_failed:
	ldW	rt0, _SVB_OFFS(_disable)(rsvb)
	bf	CR5*4+Clt, Lb3		;;; br if stack checks okay
	;;; stack check failed
	andi.	R0, rt0, 2		;;; stack checks disabled?
	bnz	Lb2			;;; br if so to check trap
	ldW	rpb, _SVB_OFFS(Sys$-Call_overflow)(rsvb)
	bt	CR1*4+Clt, Lb1		;;; br if call overflow
	ldW	rpb, _SVB_OFFS(Sys$-User_overflow)(rsvb)
Lb1:	ldW	rt0, _PD_EXECUTE(rpb)
	mtctr	rt0
	bctr				;;; chain overflow procedure

	;;; check for trap when stack checks disabled
Lb2:	btlr	 CR3*4+Ceq		;;; return if no trap

	;;; trap pending
Lb3:	andi.	R0, rt0, 1
	bnzlr				;;; return if traps disabled
	ldW	rpb, _SVB_OFFS(Sys$-Async_raise_signal)(rsvb)
	ldW	rt0, _PD_EXECUTE(rpb)
	mtctr	rt0
	bctr				;;; chain Async_raise_signal


;;; --- CALLING ARBITRARY OBJECTS ----------------------------------------

	;;; applying a poplog object in ARG_REG_0 = rt0
	;;; normal checking entry
ASM_ALIGN_QUAD
DEF_C_LAB (_popenter)
	ldW	rt2, _SVB_OFFS(procedure_key)(rsvb)
	andi.	R0, rt0, 1
	bnz-	Lc1			;;; branch if object simple
	ldW	rt1, _KEY(rt0)		;;; key in rt1
	ldW	rt3, _PD_EXECUTE(rt0)
	cmplW	CR0, rt1, rt2		;;; key = procedure_key?
	bne-	Lc2			;;; branch if non-procedure structure
	mr	rpb, rt0
	mtctr	rt3
	bctr				;;; execute procedure

	;;; applying a simple object. set appropriate key in rt1
ASM_ALIGN_QUAD
Lc1:	andi.	R0, rt0, 2		;;; test integer tag
	ldW	rt1, _SVB_OFFS(integer_key)(rsvb)	;;; assume integer
	bnz+	Lc2			;;; br if so
	ldW	rt1, _SVB_OFFS(weakref decimal_key)(rsvb) ;;; else decimal

	;;; applying a structure -- run key apply procedure
ASM_ALIGN_QUAD
Lc2:	ldW	rt1, _K_APPLY(rt1)	;;; K_APPLY ref from key
	stWu	rt0, -_WOFFS(rusp)	;;; stack object
	ldW	rpb, _RF_CONT(rt1)	;;; apply procedure in ref cont
	ldW	rt0, _PD_EXECUTE(rpb)	;;; execute address
	mtctr	rt0
	bctr				;;; run it


	;;; applying an object in ARG_REG_0 = rt0 in update mode
ASM_ALIGN_QUAD
DEF_C_LAB (_popuenter)
	ldW	rt2, _SVB_OFFS(procedure_key)(rsvb)
	andi.	R0, rt0, 1
	bnz-	Ld2			;;; branch if object simple
	ldW	rt1, _KEY(rt0)		;;; key in rt1
	ldW	rpb, _PD_UPDATER(rt0)	;;; assume can load updater in pb
	cmplW	CR0, rt1, rt2		;;; key = procedure_key?
	beq+	up_ex_pb		;;; branch if so to execute updater

	;;; applying non procedure as updater
	;;; -- run key apply procedure updater (key in rt1)
Ld1:	ldW	rt1, _K_APPLY(rt1)	;;; K_APPLY ref from key
	ldW	rt1, _RF_CONT(rt1)	;;; apply procedure in ref cont
	stWu	rt0, -_WOFFS(rusp)	;;; stack object
	ldW	rpb, _PD_UPDATER(rt1)	;;; get updater
	cmplW	CR0, rpb, rfalse	;;; false?
	beq-	up_err			;;; branch if so
	ldW	rt0, _PD_EXECUTE(rpb)	;;; get updater's execute address
	mtctr	rt0
	bctr				;;; run it

	;;; applying a simple object as updater. set appropriate key in rt1
Ld2:	andi.	R0, rt0, 2		;;; test integer tag
	ldW	rt1, _SVB_OFFS(integer_key)(rsvb)	;;; assume integer
	bnz+	Ld1			;;; br if so
	ldW	rt1, _SVB_OFFS(weakref decimal_key)(rsvb) ;;; else decimal
	b	Ld1

	;;; updater was false
up_err_stack:
	stWu	rt0, -_WOFFS(rusp)	;;; stack object
up_err:
	ldW	rt1, _SVB_OFFS(Sys$-Exec_nonpd)(rsvb)
	ldW	rpb, _PD_UPDATER(rt1)
	ldW	rt0, _PD_EXECUTE(rpb)
	mtctr	rt0
	bctr				;;; run Exec_nonpd updater


	;;; call updater of object in rt0 -- no-checking entry
ASM_ALIGN_QUAD
DEF_C_LAB (_popuncenter)
	ldW	rpb, _PD_UPDATER(rt0)	;;; get updater
up_ex_pb:
	cmplW	CR0, rpb, rfalse	;;; false?
	beq-	up_err_stack		;;; br if so
	ldW	rt0, _PD_EXECUTE(rpb)	;;; get updater's execute address
	mtctr	rt0
	bctr				;;; run it


;;; --- CHAINING ROUTINES ---------------------------------------------------

	;;; Unwind the current stack frame, by jumping into the procedure's
	;;; exit code. This subroutine is called immediately after executing
	;;; an M_UNWIND_SF operation, so that the (unwanted) return address
	;;; into the procedure being unwound has been replaced in the link
	;;; register by this subroutine's return address.
	;;;	The procedure's exit code finishes with 'blr', and we
	;;; replace the return address into the NEXT caller with the return
	;;; from this subroutine, but saving the former in rchain, from
	;;; whence it can be restored with an M_CALL_WITH_RETURN operation.
	;;;	POWER version also saves PB on stack (UNWIND_FRAME_SAVES_PB
	;;; set true by genproc.p)

ASM_ALIGN_QUAD
DEF_C_LAB (_unwind_frame)
	stWu	rpb, -_WOFFS(rusp)	     ;;; save rpb on stack
	ldW	rpb, _SF_OWNER(rsp)	     ;;; ensure pb set for current pdr
	mflr	rt2			     ;;; get return address
	lbz	rt1, _PD_FRAME_LEN(rpb)	     ;;; frame length in words
	ldW	rt0, _PD_EXIT(rpb)	     ;;; address of pdr's exit code
	slwi	rt1, rt1, _:WORD_SHIFT	     ;;; frame length as word offset
	add	rt1, rsp, rt1		     ;;; sp for next caller
	mtctr	rt0
	ldW	rchain, _SF_RETURN_ADDR(rt1) ;;; save its return in chain reg
	stW	rt2, _SF_RETURN_ADDR(rt1)    ;;; and replace with my return
	bctr				     ;;; go to current's exit code



	;;; Routines to chain a procedure, either directly or out of the
	;;; current caller. These are executed as a result of displacing a
	;;; stack frame return address with their address and then returning.
	;;; In the case of _syschain and _sysncchain, the displaced return is
	;;; saved in rchain.

ASM_ALIGN_QUAD
DEF_C_LAB (_syschain_caller)
	bl	C_LAB(_unwind_frame)	;;; pop frame for caller
	la	rusp, _WOFFS(rusp)	;;; erase saved rpb
DEF_C_LAB (_syschain)
	mtlr	rchain		;;; reinstate return address from chain reg
	ldW	rt0, 0(rusp)		;;; object to chain on user stack
	la	rusp, _WOFFS(rusp)
	b	C_LAB(_popenter)	;;; check and run it


	;;; The same, but with no check for procedure

ASM_ALIGN_QUAD
DEF_C_LAB (_sysncchain_caller)
	bl	C_LAB(_unwind_frame)	;;; pop frame for caller
	la	rusp, _WOFFS(rusp)	;;; erase saved rpb
DEF_C_LAB (_sysncchain)
	ldW	rpb, 0(rusp)		;;; procedure to chain on user stack
	mtlr	rchain		;;; reinstate return address from chain reg
	ldW	rt0, _PD_EXECUTE(rpb)
	la	rusp, _WOFFS(rusp)
	mtctr	rt0
	bctr				;;; run it


;;;---------------------------------------------------------------------------

	;;; erase 1 word from the call stack and chain Callstack_reset
	;;; (used by Callstack_reset in cleaning up)

DEF_C_LAB (_erase_sp_1)
	la	rsp, _WOFFS(rsp)	;;; chop off a word
	ldW	rpb, _SVB_OFFS(Sys$-Callstack_reset)(rsvb)
	b	XC_LAB(Sys$-Callstack_reset)	;;; try again


;;;---------------------------------------------------------------------------

	;;; _cache_flush(______wptr, _______woffs)
	;;; Flush the instruction cache
	.machine "ppc"

DEF_C_LAB(Sys$- _cache_flush)
	ldW	rt1, 0(rusp)		;;; _______woffs
	ldW	rt0, _WOFFS(rusp)	;;; ______wptr
	la	rusp, _WOFFS*2(rusp)
	mr.	rt2, rt1
	blelr				;;; return if none
	;;; flush the area from the data cache
Le1:	addic.	rt1, rt1, -4
	dcbf	rt0, rt1		;;; flush data cache block of word
	bnz+	Le1
	sync				;;; complete previous instructions
	;;; then flush it from the instruction cache
Le2:	addic.	rt2, rt2, -4
	icbi	rt0, rt2		;;; invalidate instr cache block of word
	bnz+	Le2

	isync				;;; discard prefetched instrs
	blr


	;;; Called from _pop_needs_cache_flush in c_core.c.
	;;; Executes an "icbi" instruction, and will therefore
	;;; give SIGILL on a POWER machine which doesn't have an I-cache.
.globl ._pop_try_cache_flush
._pop_try_cache_flush:
	mflr	rt0
	li	rt1, 0
	icbi	rt0, rt1
	blr

	.machine "com"


;;;---------------------------------------------------------------------------

	;;;  _nextframe(________sframe) -> ___________nextframe
	;;; get next stack frame from ________sframe

ASM_ALIGN_QUAD
DEF_C_LAB (_nextframe)
	ldW	rt0, 0(rusp)		    ;;; ________sframe
	ldW	rt1, _SF_OWNER(rt0)	    ;;; owner procedure
	lbz	rt1, _PD_FRAME_LEN(rt1)     ;;; get frame len in words
	slwi	rt1, rt1, _:WORD_SHIFT	    ;;; as word offset
	add	rt1, rt0, rt1		    ;;; ________sframe + frame offs = ___________nextframe
	stW	rt1, 0(rusp)		    ;;; return it
	blr


;;;---------------------------------------------------------------------------

	;;; fast routines for subscrs and its updater

	;;; _subss(_________subscript, ______string) -> ____byte

ASM_ALIGN_QUAD
DEF_C_LAB (_subss)
	ldW	rt0, 0(rusp)		;;; ______string
	ldWu	rt1, _WOFFS(rusp)	;;; _________subscript
	la	rt0, _V_BYTES-1(rt0)	;;; adjust addr for base 1 subscript
	srawi	rt1, rt1, _:WORD_SHIFT	;;; _________subscript -> sysint
	lbzx	rt1, rt0, rt1
	slwi	rt1, rt1, _:WORD_SHIFT
	addi	rt1, rt1, 3		;;; convert to popint
	stW	rt1, 0(rusp)		;;; return it
	blr


	;;; ____byte -> _subss(_________subscript, ______string)
	;;; _u_subss(____byte, _________subscript, ______string)

ASM_ALIGN_QUAD
DEF_C_LAB (-> _subss)
DEF_C_LAB (_u_subss)
	ldW	rt0, 0(rusp)		;;; ______string
	ldW	rt1, _WOFFS(rusp)	;;; _________subscript
	la	rt0, _V_BYTES-1(rt0)	;;; adjust addr for base 1 subscript
	srawi	rt1, rt1, _:WORD_SHIFT	;;; _________subscript -> sysint
	ldW	rt2, _WOFFS*2(rusp)	;;; ____byte
	la	rusp, _WOFFS*3(rusp)	;;; remove args
	srawi	rt2, rt2, _:WORD_SHIFT	;;; ____byte -> sysint
	stbx	rt2, rt0, rt1		;;; update the byte
	blr


;;; --- PREDICATES ----------------------------------------------------------

	;;; _not(____item) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_not)
	ldW	rt0, 0(rusp)
	la	rt1, _TRUEOFFS(rfalse)
	cmplW	CR0, rt0, rfalse
	beq	Lf1
	mr	rt1, rfalse
Lf1:	stW	rt1, 0(rusp)
	blr

	;;; _isinteger(____item) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_isinteger)
	ldW	rt0, 0(rusp)
	la	rt1, _TRUEOFFS(rfalse)
	andi.	R0, rt0, 2
	bnz	Lf2
	mr	rt1, rfalse
Lf2:	stW	rt1, 0(rusp)
	blr

	;;; _iscompound(____item) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_iscompound)
	ldW	rt0, 0(rusp)
	la	rt1, _TRUEOFFS(rfalse)
	andi.	R0, rt0, 1
	bz	Lf3
	mr	rt1, rfalse
Lf3:	stW	rt1, 0(rusp)
	blr

	;;; _issimple(____item) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_issimple)
	ldW	rt0, 0(rusp)
	la	rt1, _TRUEOFFS(rfalse)
	andi.	R0, rt0, 1
	bnz	Lf4
	mr	rt1, rfalse
Lf4:	stW	rt1, 0(rusp)
	blr

	;;; _zero(_____int) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_zero)
	ldW	rt0, 0(rusp)
	la	rt1, _TRUEOFFS(rfalse)
	mr.	R0, rt0
	bz	Lf5
	mr	rt1, rfalse
Lf5:	stW	rt1, 0(rusp)
	blr

	;;; _neg(_____int) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_neg)
	ldW	rt0, 0(rusp)
	la	rt1, _TRUEOFFS(rfalse)
	mr.	R0, rt0
	blt	Lf6
	mr	rt1, rfalse
Lf6:	stW	rt1, 0(rusp)
	blr


#_<
lvars CMP_ROUTINE_label = 1;

define lconstant macro CMP_ROUTINE _ cmp_op _ cbr_op;
lvars label = 'Lg' >< CMP_ROUTINE_label;
CMP_ROUTINE_label+1 -> CMP_ROUTINE_label;
[
	ldW  \t	  rt1, _0(rusp)		\n
\t	ldWu \t	  rt0, _WOFFS(rusp)	\n
\t	la   \t	  rt2, _TRUEOFFS(rfalse) \n
\t	^cmp_op \t  _0, rt0, rt1	\n
\t	^cbr_op \t  ^label		\n
\t	mr   \t	  rt2, rfalse		\n
^label: \t stW \t	  rt2, _0(rusp)	\n
\t	blr				\n
].dl
enddefine;
>_#

	;;; ______int1 _bitst ______int2 -> ____bool   (bit test)
ASM_ALIGN_QUAD
DEF_C_LAB 4 (_bitst)
	CMP_ROUTINE and. bnz

	;;; ______int1 _gr ______int2 -> ____bool   (unsigned greater than)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_gr)
	CMP_ROUTINE cmplW bgt

	;;; ______int1 _greq ______int2 -> ____bool   (unsigned greater than or equal)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_greq)
	CMP_ROUTINE cmplW bge

	;;; ______int1 _lt ______int2 -> ____bool   (unsigned less than)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_lt)
	CMP_ROUTINE cmplW blt

	;;; ______int1 _lteq ______int2 -> ____bool   (unsigned less than or equal)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_lteq)
	CMP_ROUTINE cmplW ble

	;;; ______int1 _sgr ______int2 -> ____bool   (signed greater than)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_sgr)
	CMP_ROUTINE cmpW bgt

	;;; ______int1 _sgreq ______int2 -> ____bool   (signed greater than or equal)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_sgreq)
	CMP_ROUTINE cmpW bge

	;;; ______int1 _slt ______int2 -> ____bool   (signed less than)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_slt)
	CMP_ROUTINE cmpW blt

	;;; ______int1 _slteq ______int2 -> ____bool   (signed less than or equal)
ASM_ALIGN_QUAD
DEF_C_LAB 6 (_slteq)
	CMP_ROUTINE cmpW ble

	;;; _____item1 _eq _____item2 -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB 7 (_eq)
	CMP_ROUTINE cmplW beq

	;;; _____item1 _neq _____item2 -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB 7 (_neq)
	CMP_ROUTINE cmplW bne


;;;---------------------------------------------------------------------------

	;;; _haskey(____item, ___key) -> ____bool

ASM_ALIGN_QUAD
DEF_C_LAB (_haskey)
	ldW	rt1, 0(rusp)		;;; ___key
	ldWu	rt0, _WOFFS(rusp)	;;; ____item
	mr	rt3, rfalse
	andi.	R0, rt0, 1
	bnz-	Lh1			;;; return false if simple
	ldW	rt2, _KEY(rt0)		;;; else get key
	cmplW	CR0, rt2, rt1
	bne	Lh1			;;; false if different
	la	rt3, _TRUEOFFS(rfalse)
Lh1:	stW	rt3, 0(rusp)
	blr

	;;; _datakey(____item) -> ___key
	;;; get the key of any pop object

ASM_ALIGN_QUAD
DEF_C_LAB (_datakey)
	ldW	rt0, 0(rusp)		;;; ____item
	andi.	R0, rt0, 1
	bnz-	Li1			;;; branch if simple
	ldW	rt0, _KEY(rt0)		;;; else get key
	stW	rt0, 0(rusp)		;;; return it
	blr
Li1:	andi.	R0, rt0, 2		;;; integer?
	bz	Li2			;;; branch if not
	ldW	rt0, _SVB_OFFS(integer_key)(rsvb)
	stW	rt0, 0(rusp)
	blr
Li2:	ldW	rt0, _SVB_OFFS(weakref decimal_key)(rsvb)
	stW	rt0, 0(rusp)
	blr


;;;---------------------------------------------------------------------------

	;;; _conspair(_________frontitem, ________backitem) -> ____pair
	;;; optimise subroutine for "conspair"

ASM_ALIGN_QUAD
DEF_C_LAB (_conspair)
	ldW	rt0, _SVB_OFFS(Sys$- _free_pairs)(rsvb)  ;;; get free pair list
	ldW	rt2, 0(rusp)		;;; ________backitem
	andi.	R0, rt0, 1
	bnz-	Lj1			;;; none left if simple
	ldW	rt1, _P_BACK(rt0)
	ldWu	rt3, _WOFFS(rusp)	;;; _________frontitem
	stW	rt1, _SVB_OFFS(Sys$- _free_pairs)(rsvb)  ;;; remove pair from _free_pairs
	stW	rt2, _P_BACK(rt0)	;;; assign items into pair
	stW	rt3, _P_FRONT(rt0)
	stW	rt0, 0(rusp)		;;; return ____pair
	blr
	;;; no pairs left, chain Conspair
Lj1:	ldW	rpb, _SVB_OFFS(Sys$-Conspair)(rsvb)
	b	XC_LAB(Sys$-Conspair)



ASM_END_FILE
