/* --- Copyright University of Sussex 1998. All rights reserved. ----------
 * File:            C.power/src/aprocess.s
 * Purpose:
 * Author:          John Gibson, Mar  3 1998
 */

;;; --- ROUTINES TO HANDLE PROCESS CALL STACK SWAPPING -----------------------

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

#_<

#_INCLUDE 'asm.ph'
#_INCLUDE 'process.ph'

lconstant macro (
	_ID_VALOF		= @@ID_VALOF,
	_PD_TABLE		= @@PD_TABLE,
	_PS_CALLSTACK_LIM	= @@PS_CALLSTACK_LIM,
	_PS_CALLSTACK_PARTIAL	= @@PS_CALLSTACK_PARTIAL,
	_PS_PARTIAL_RETURN 	= @@PS_PARTIAL_RETURN,
	_PS_STATE		= @@PS_STATE,

	_PD_FLAGS		= @@PD_FLAGS,
	_PD_NLOCALS		= @@PD_NLOCALS,
	_PD_REGMASK		= @@PD_REGMASK,
	_PD_NUM_STK_VARS	= @@PD_NUM_STK_VARS,
	_PS_FLAGS		= @@PS_FLAGS,

	;;; size of an I_BRANCH_std instruction, i.e. a "b"
	_BRANCH_std		= @@(code)++,
	);


	;;; Macro to generate register switch code
lvars label_num = 10;

define lconstant macro REGCODE _ dstreg _ dstadj _ srcreg _ srcadj;
    lvars   dstreg, dstadj = strnumber(dstadj), srcreg,
	    srcadj = strnumber(srcadj), Nnpl, Rnpl, Rpl, offs, rn;
    lconstant WOFFS = _pint(_WOFFS);
    for Nnpl from 5 by -1 to 0 do
	for Rpl from 10 by -1 to 0 do
	    -(Nnpl+Rpl+1)*WOFFS -> offs;
	    sys_current_val(consword('rpl' >< Rpl)) -> rn;
	    sprintf('\t%p  %p, %p(%p)\n', [%stW,rn,offs-dstadj,dstreg%]);
	    sprintf('\t%p  %p, %p(%p)\n', [%ldW,rn,offs-srcadj,srcreg%])
	endfor;
	'\tb    ', "LR", (Nnpl+label_num) sys_>< nullstring, '\n\n'
    endfor;
    for Rnpl from 4 by -1 to 0 do
	-(Rnpl+1)*WOFFS -> offs;
	sys_current_val(consword('rnpl' >< Rnpl)) -> rn;
	"LR", (Rnpl+label_num+1) sys_>< nullstring;
	sprintf(':\t%p  %p, %p(%p)\n', [%stW,rn,offs-dstadj,dstreg%]);
	sprintf( '\t%p  %p, %p(%p)\n', [%ldW,rn,offs-srcadj,srcreg%])
    endfor;
    "LR", label_num sys_>< nullstring, ':\n';

    label_num+10 -> label_num
enddefine;

>_#


ASM_START_FILE


ASM_CODE_PSECT


	/***************************************************
	*  N.B. Because signals can interrupt on any       *
	*  instruction, sp must never be `out of phase',   *
	*  i.e. pointing above data that's still wanted.   *
	****************************************************/



	;;; _swap_out_callstack(_p, _______process)
	;;; swap out the callstack for _______process and then chain _p
ASM_ALIGN_QUAD
DEF_C_LAB (_swap_out_callstack)
	ldW	rchain, 0(rusp)		;;; save process in chain reg
	mflr	rt7			   	;;; get return address in rt7
	ldW	rt6, _PS_STATE(rchain)	        ;;; base of saved callstack
	ldW	rt5, _PS_CALLSTACK_LIM(rchain)	;;; limit of saved callstack
	b	so_test

	;;; process a frame
ASM_ALIGN_QUAD
so_loop:
	;;; test if has dlocal expression code to run
	lbz	rt0, _PD_FLAGS(rpb)	   ;;; procedure flags
	subfc	rt7, rpb, rt7		   ;;; make return address relative
	andi.	R0, rt0, _:M_PD_PROC_DLEXPR_CODE
	bnz-	so_brk		   	   ;;; yes -- break out to run code

	;;; (continue here after break)
so_cont:
	;;; swap local register values -- save current values in process,
	;;; then set from sp stack frame values
	lbz	rt3, _PD_FRAME_LEN(rpb)	   ;;; frame len
	lhz	rt2, _PD_REGMASK(rpb)	   ;;; register switch offset
	slwi	rt3, rt3, _:WORD_SHIFT	   ;;; frame len as word offset
	bl	La1		   	   ;;; to get address of La1
La1:	;;; PD_REGMASK VALUE ASSUMES 5 INSTRUCTIONS FROM HERE TO REGCODE
	add	rt4, rsp, rt3		   ;;; (sp frame base)+offs = lim
	mflr	rt1			   ;;; address of La1 into rt1
	add	rt1, rt1, rt2		   ;;; add switch offset to La1
	mtctr	rt1			   ;;; into count reg
	bctr				   ;;; jump to it

	;;; REGCODE macro takes lim addrs of proc and sp frames -- offsets on
	;;; sp frame are _WOFFS less than proc, because rt4 points to next
	;;; SF_OWNER.
	REGCODE rt5 0 rt4 _WOFFS

	subfc	rt5, rt3, rt5		   ;;; (proc frame lim)-offs = base
	lbz	rt2, _PD_NUM_STK_VARS(rpb) ;;; number of on-stack lvars
	lbz	rt3, _PD_NLOCALS(rpb)	   ;;; number of dlocal ids
	stW	rt7, 0(rt5)		   ;;; store rel return addr
	stW	rpb, _WOFFS(rt5)	   ;;; store owner
	mr.	R0, rt2			   ;;; test number of on-stack lvars
	la	rt7, _WOFFS(rt5)	   ;;; use rt7 to work up proc frame

	;;; on-stack lvars
	bz+	La3			;;; branch if no on-stack lvars
La2:	ldWu	rt1, _WOFFS(rsp)	;;; copy stack lvars into proc
	addic.	rt2, rt2, -1
	stWu	rt1, _WOFFS(rt7)
	bnz-	La2

	;;; dlocal ids
La3:	mr.	R0, rt3			;;; test number of dlocal ids
	bz+	La5			;;; branch if none
	slwi	rt2, rt3, _:WORD_SHIFT	;;; as offset
	la	rpb, _PD_TABLE(rpb)
	add	rpb, rpb, rt2		;;; lim of pdr dlocal ident table
La4:	ldWu	rt2, -_WOFFS(rpb)	;;; next identifier and step back
	ldWu	rt0, _WOFFS(rsp)	;;; saved idval from stack and step
	ldW	rt1, _ID_VALOF(rt2)	;;; get current idval
	stW	rt0, _ID_VALOF(rt2)	;;; make saved value current
	addic.	rt3, rt3, -1		;;; decrement count
	stWu	rt1, _WOFFS(rt7)	;;; save current idval in proc and step
	bnz-	La4

La5:	ldW	rt7, -_WOFFS(rt4)	;;; load next frame's return addr
	mr	rsp, rt4		;;; erase saved registers and retn addr
	ldW	rpb, 0(rsp)		;;; load next owner into rpb

so_test:
	cmplW	CR0, rt5, rt6		;;; reached the beginning of the proc?
	bgt+	so_loop			;;; next frame if not

	;;; finished -- chain procedure on stack
	ldW	rpb, _WOFFS(rusp)	;;; procedure from stack
	;;; ensure PARTIAL reset to NULL
	li	rt0, 0
	mtlr	rt7			;;; set return address
	ldW	rt1, _PD_EXECUTE(rpb)	;;; procedure's exec address
	stW	rt0, _PS_CALLSTACK_PARTIAL(rchain)
	sth	rt0, _PS_FLAGS(rchain)	;;; zero process flags = suspended
	mtctr	rt1
	la	rusp, _WOFFS*2(rusp)	;;; erase proc and procedure
	bctr			  	;;; chain procedure

	;;; come here to run dlocal expression code, by jumping into the
	;;; owner procedure. process is in rchain.
ASM_ALIGN_QUAD
so_brk:
	ldW	rt0, _PD_EXIT(rpb)	  ;;; procedure's exit code base addr
	stW	rt7, _PS_PARTIAL_RETURN(rchain)   ;;; save relative retn addr
	la	rt0, -_BRANCH_std*2(rt0)	  ;;; addr of procedure's suspend code
	stW	rt5, _PS_CALLSTACK_PARTIAL(rchain) ;;; save rt5 in CALLSTACK_PARTIAL
	mtctr	rt0
	bctr				  ;;; go into procedure's suspend code

	;;; then return from procedure's suspend code is to here
	;;; with process in rchain.
ASM_ALIGN_QUAD
DEF_C_LAB (_swap_out_continue)
	ldW	rt6, _PS_STATE(rchain)		    ;;; restore limit
	ldW	rt5, _PS_CALLSTACK_PARTIAL(rchain)  ;;; restore proc frame base
	ldW	rt7, _PS_PARTIAL_RETURN(rchain)    ;;; rel return back in rret
	b	so_cont				    ;;; continue swap-out



	;;; _swap_in_callstack(_p, _______process)
	;;; swap in the callstack for _______process and then chain _p
ASM_ALIGN_QUAD
DEF_C_LAB (_swap_in_callstack)
	ldW	rchain, 0(rusp)		;;; get process in chain reg (save on stack)
	mflr	rt7			   	;;; get return address in rt7
	ldW	rt6, _PS_CALLSTACK_LIM(rchain)	;;; limit of saved callstack
	ldW	rt5, _PS_STATE(rchain)	        ;;; base of saved callstack
	b	si_test

	;;; reinstate a frame
ASM_ALIGN_QUAD
si_loop:
	ldW	rpb, _WOFFS(rt5)	   ;;; get owner from proc frame
	mr	rt0, rsp		   ;;; save lim of sp frame in rt0
	lbz	rt3, _PD_FRAME_LEN(rpb)	   ;;; frame length in words
	la	rt4, _WOFFS(rt5)	   ;;; use rt4 to work up proc frame
	slwi	rt3, rt3, _:WORD_SHIFT	   ;;; frame offset
	subfc	rsp, rt3, rsp		   ;;; create new sp frame
	stW	rt7, _SF_RETURN_ADDR(rt0)  ;;; save caller's return

	;;; swap local register values -- save current values in sp frame,
	;;; then set from process values
	lhz	rt2, _PD_REGMASK(rpb)	   ;;; register switch offset
	add	rt5, rt5, rt3		   ;;; (proc frame base)+offs = lim
	bl	Lb1			   ;;; get address of Lb1 ...
Lb1:	;;; PD_REGMASK VALUE ASSUMES 5 INSTRUCTIONS FROM HERE TO REGCODE
	mflr	rt1			   ;;; ... in rt1
	ldW	rt7, _SF_RETURN_ADDR(rt4)  ;;; this pdr's relative return addr
	add	rt1, rt1, rt2		   ;;; add switch offset to Lb1
	mtctr	rt1
	bctr				   ;;; go to it

	;;; REGCODE macro takes lim addrs of sp and proc frames -- offsets on
	;;; sp frame are _WOFFS less than proc, because rt0 points to next
	;;; SF_OWNER
	REGCODE rt0 _WOFFS rt5 0

	lbz	rt2, _PD_NUM_STK_VARS(rpb) ;;; number of on-stack lvars
	mr	rchain, rsp		   ;;; use rchain to work up sp frame
	mr.	R0, rt2			   ;;; test number of on-stack lvars
	lbz	rt3, _PD_NLOCALS(rpb)	   ;;; number of dlocal ids

	;;; on-stack lvars
	bz+	Lb3			;;; branch if no on-stack lvars
Lb2:	ldWu	rt1, _WOFFS(rt4)	;;; copy stack lvars into sp frame
	addic.	rt2, rt2, -1
	stWu	rt1, _WOFFS(rchain)
	bnz-	Lb2

	;;; dlocal ids
Lb3:	mr.	R0, rt3			;;; test number of dlocal ids
	bz+	Lb5			;;; branch if none
	slwi	rt2, rt3, _:WORD_SHIFT	;;; as offset
	la	rfalse, _PD_TABLE(rpb)
	add	rfalse, rfalse, rt2	;;; lim of pdr dlocal ident table
Lb4:	ldWu	rt2, -_WOFFS(rfalse)	;;; next identifier
	ldWu	rt0, _WOFFS(rt4)	;;; saved idval from proc
	ldW	rt1, _ID_VALOF(rt2)	;;; get current idval
	stW	rt0, _ID_VALOF(rt2)	;;; make proc value current
	addic.	rt3, rt3, -1		;;; decrement count
	stWu	rt1, _WOFFS(rchain)	;;; save current idval in sp frame
	bnz-	Lb4

	;;; test if has dlocal expression code to run
Lb5:	lbz	rt0, _PD_FLAGS(rpb)	;;; procedure flags
	stW	rpb, 0(rsp)		;;; store owner in sp frame
	andi.	R0, rt0, _:M_PD_PROC_DLEXPR_CODE
	bnz-	si_brk			;;; yes -- break out to run code

	;;; (continue here after break)
si_cont:
	add	rt7, rt7, rpb		;;; make return address absolute

si_test:
	cmplW	CR0, rt5, rt6		;;; reached the end of the proc?
	blt+	si_loop			;;; next frame if not

	;;; finished -- chain procedure on stack
	ldW	rchain, 0(rusp)		;;; get process again
	ldW	rpb, _WOFFS(rusp)	;;; procedure from stack
	;;; ensure PARTIAL reset to NULL
	li	rt0, 0
	mtlr	rt7			;;; set return address
	stW	rt0, _PS_CALLSTACK_PARTIAL(rchain)
	ldW	rt0, _PD_EXECUTE(rpb)	;;; procedure's exec address
	la	rusp, _WOFFS*2(rusp)	;;; erase proc and procedure
	mtctr	rt0
	ldW	rfalse, _svb_FALSE	;;; restore rfalse
	bctr				;;; chain procedure

	;;; come here to run dlocal expression code, by jumping into the
	;;; owner procedure. process is in on top of stack, must be put in
	;;; rchain.
ASM_ALIGN_QUAD
si_brk:
	ldW	rchain, 0(rusp)		;;; get process in chain reg
	ldW	rt0, _PD_EXIT(rpb)	;;; procedure's exit code base addr
	ldW	rfalse, _svb_FALSE	;;; restore rfalse
	stW	rt7, _PS_PARTIAL_RETURN(rchain)   ;;; save relative retn addr
	la	rt0, -_BRANCH_std(rt0)	;;; addr of procedure's resume code
	stW	rt5, _PS_CALLSTACK_PARTIAL(rchain) ;;; save rt5 in CALLSTACK_PARTIAL
	mtctr	rt0
	bctr			  	;;; go into procedure's resume code

	;;; then return from procedure's resume code is to here
	;;; with process in rchain.
ASM_ALIGN_QUAD
DEF_C_LAB (_swap_in_continue)
	ldW	rt6, _PS_CALLSTACK_LIM(rchain)	;;; restore limit
	ldW	rt5, _PS_CALLSTACK_PARTIAL(rchain)  ;;; restore proc frame base
	ldW	rt7, _PS_PARTIAL_RETURN(rchain)	;;; rel return back in rret
	b	si_cont				;;; continue swap-out



ASM_END_FILE
