/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 * File:            C.alpha/src/aprocess.s
 * Purpose:
 * Author:          John Gibson, Sep 21 1994
 */

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

#_<

#_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_l, _PD_FLAGS_b) 	= FIELD_lb(@@PD_FLAGS),
	(_PD_NLOCALS_l, _PD_NLOCALS_b)	= FIELD_lb(@@PD_NLOCALS),
	(_PD_REGMASK_l, _PD_REGMASK_b)	= FIELD_lb(@@PD_REGMASK),
	(_PD_NUM_STK_VARS_l, _PD_NUM_STK_VARS_b)
					= FIELD_lb(@@PD_NUM_STK_VARS),
	(_PS_FLAGS_l, _PS_FLAGS_b)	= FIELD_lb(@@PS_FLAGS),
	);


#_IF _PD_FRAME_LEN_l /= _PD_REGMASK_l
	mishap(0, 'CODE COMBINING FRAME_LEN/REGMASK LOADS IS WRONG')
#_ENDIF
#_IF _PD_NUM_STK_VARS_l /= _PD_NLOCALS_l
	mishap(0, 'CODE COMBINING NUM_STK_VARS/NLOCALS LOADS IS WRONG')
#_ENDIF

	;;; Macro to generate register switch code
define lconstant macro REGCODE S dstreg S dstadj S srcreg S srcadj;
    lvars   dstreg, dstadj = strnumber(dstadj), srcreg,
	    srcadj = strnumber(srcadj), Nnpl, Rnpl, Rpl, offs, S, 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;
	'\tbr  ', "!$", (Nnpl+90) sys_>< 'f', '\n\n'
    endfor;
    for Rnpl from 4 by -1 to 0 do
	-(Rnpl+1)*WOFFS -> offs;
	sys_current_val(consword('rnpl' >< Rnpl)) -> rn;
	"!$", (Rnpl+91) 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;
    "!$", '90', ':\n'
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.   *
	****************************************************/


	;;; size of an I_BRANCH_std instruction, i.e. a "br"
BRANCH_std = 4


	;;; _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
	lda	rusp, _WOFFS(rusp)
	ldW	rt6, _PS_STATE(rchain)	        ;;; base of saved callstack
	ldW	rt5, _PS_CALLSTACK_LIM(rchain)	;;; limit of saved callstack
	br	so_test

	;;; process a frame
ASM_ALIGN_QUAD
so_loop:
	;;; test if has dlocal expression code to run
	ldl	rt0, _PD_FLAGS_l(rpb)	   ;;; get lword with flags byte
	subq	rret, rpb, rret		   ;;; make return address relative
	extbl	rt0, _PD_FLAGS_b, rt0	   ;;; procedure flags
	ldl	rt2, _PD_FRAME_LEN_l(rpb)  ;;; get lword with frame len/regmask
	and	rt0, _:M_PD_PROC_DLEXPR_CODE, rt0
	bne	rt0, so_brk		   ;;; yes -- break out to run code

	;;; (continue here after break -- rt2 contains frame len/regmask)
so_cont:
	;;; swap local register values -- save current values in process,
	;;; then set from sp stack frame values
	extbl	rt2, _PD_FRAME_LEN_b, rt3 ;;; frame length in words
	extwl	rt2, _PD_REGMASK_b, rt2   ;;; register switch offset
	sWaddq	rt3, rzero, rt3		    ;;; frame offset
#_IF DEF VMS
    .begin_exact
#_ENDIF
	br	rt1, !$1f		   ;;; get address of 1f
!$1:	;;; PD_REGMASK VALUE ASSUMES 3 INSTRUCTIONS FROM HERE TO REGCODE
	addq	rt3, rsp, rt4		   ;;; (sp frame base)+offs = lim
	addq	rt1, rt2, rt1		   ;;; add switch offset to 1b
	jmp	rzero, (rt1)			   ;;; go 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
#_IF DEF VMS
    .end_exact
#_ENDIF

	subq	rt5, rt3, rt5		      ;;; (proc frame lim)-offs = base
	ldl	rt3, _PD_NUM_STK_VARS_l(rpb)  ;;; get lword with numstk/nlocals
	stW	rret, 0(rt5)		      ;;; store rel return addr
	stW	rpb, _WOFFS(rt5)		;;; store owner
	extbl	rt3, _PD_NUM_STK_VARS_b, rt2 	;;; number of on-stack lvars
	extbl	rt3, _PD_NLOCALS_b, rt3      	;;; number of dlocal ids
	lda	rret, _WOFFS(rt5)		;;; use rret to work up proc frame

	;;; on-stack lvars
	beq	rt2, !$3f		;;; br if none
!$2:	ldW	rt1, _WOFFS(rsp)	;;; copy stack lvars into proc
	subq	rt2, 1, rt2
	lda	rsp, _WOFFS(rsp)
	stW	rt1, _WOFFS(rret)
	lda	rret, _WOFFS(rret)
	bne	rt2, !$2b

	;;; dlocal ids
!$3:	beq	rt3, !$5f		;;; br if none
	sWaddq	rt3, _PD_TABLE, rt2
	addq	rpb, rt2, rpb		;;; lim of pdr dlocal ident table
!$4:	ldW	rt2, -_WOFFS(rpb)	;;; next identifier
	ldW	rt0, _WOFFS(rsp)	;;; saved idval from stack
	lda	rpb, -_WOFFS(rpb)
	ldW	rt1, _ID_VALOF(rt2)	;;; get current idval
	stW	rt0, _ID_VALOF(rt2)	;;; make saved value current
	subq	rt3, 1, rt3		;;; decrement count
	stW	rt1, _WOFFS(rret)	;;; save current idval in process
	lda	rsp, _WOFFS(rsp)
	lda	rret, _WOFFS(rret)
	bne	rt3, !$4b

!$5:	ldW	rret, -_WOFFS(rt4)	;;; load next frame's return addr
	ldW	rpb, 0(rt4)		;;; and next owner into rpb
	mov	rt4, rsp		;;; erase saved registers and retn addr

so_test:
	cmpule	rt5, rt6, rt0		;;; reached the beginning of the proc?
	blbc	rt0, so_loop		;;; next frame if not

	;;; finished -- chain procedure on stack
	ldW	rpb, 0(rusp)		  ;;; procedure from stack
	;;; ensure PARTIAL reset to NULL
	stW	rzero, _PS_CALLSTACK_PARTIAL(rchain)
	;;; zero process flags = suspended
	ldl	rt1, _PS_FLAGS_l(rchain)  ;;; load flags lword
	ldW	rt0, _PD_EXECUTE(rpb)	  ;;; procedure's exec address
	mskwl	rt1, _PS_FLAGS_b, rt1	  ;;; clear flags
	lda	rusp, _WOFFS(rusp)
	stl	rt1, _PS_FLAGS_l(rchain)  ;;; store flags lword
	jmp	rzero, (rt0)			  ;;; 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	rret, _PS_PARTIAL_RETURN(rchain)   ;;; save relative retn addr
	lda	rt0, -BRANCH_std*2(rt0)	  ;;; addr of procedure's suspend code
	stW	rt5, _PS_CALLSTACK_PARTIAL(rchain) ;;; save rt5 in CALLSTACK_PARTIAL
	jmp	rzero, (rt0)			  ;;; 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
	ldl	rt2, _PD_FRAME_LEN_l(rpb)  ;;; get lword with frame len/regmask
	ldW	rret, _PS_PARTIAL_RETURN(rchain)    ;;; rel return back in rret
	br	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)
	ldW	rt6, _PS_CALLSTACK_LIM(rchain)	;;; limit of saved callstack
	ldW	rt5, _PS_STATE(rchain)	        ;;; base of saved callstack
	br	si_test

	;;; reinstate a frame
ASM_ALIGN_QUAD
si_loop:
	ldW	rpb, _WOFFS(rt5)	   ;;; get owner from proc frame
	mov	rsp, rt0		   ;;; save lim of sp frame in rt0
	ldl	rt2, _PD_FRAME_LEN_l(rpb)  ;;; get lword with frame len/regmask
	lda	rt4, _WOFFS(rt5)	   ;;; use rt4 to work up proc frame
	extbl	rt2, _PD_FRAME_LEN_b, rt3 ;;; frame length in words
	sWaddq	rt3, rzero, rt3		   ;;; frame offset
	subq	rsp, rt3, rsp		   ;;; create new sp frame
	stW	rret, _SF_RETURN_ADDR(rt0) ;;; save caller's return

	;;; swap local register values -- save current values in sp frame,
	;;; then set from process values
	extwl	rt2, _PD_REGMASK_b, rt2  ;;; register switch offset
	addq	rt5, rt3, rt5		   ;;; (proc frame base)+offs = lim
#_IF DEF VMS
    .begin_exact
#_ENDIF
	br	rt1, !$1f		   ;;; get address of 1f
!$1:	;;; PD_REGMASK VALUE ASSUMES 3 INSTRUCTIONS FROM HERE TO REGCODE
	ldW	rret, _SF_RETURN_ADDR(rt4) ;;; this pdr's relative return addr
	addq	rt1, rt2, rt1		   ;;; add switch offset to 1b
	jmp	rzero, (rt1)			   ;;; 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
#_IF DEF VMS
    .end_exact
#_ENDIF

	ldl	rt3, _PD_NUM_STK_VARS_l(rpb)  ;;; get lword with numstk/nlocals
	mov	rsp, rchain		     ;;; use rchain to work up sp frame
	extbl	rt3, _PD_NUM_STK_VARS_b, rt2 ;;; number of on-stack lvars
	extbl	rt3, _PD_NLOCALS_b, rt3      ;;; number of dlocal ids

	;;; on-stack lvars
	beq	rt2, !$3f		;;; br if none
!$2:	ldW	rt1, _WOFFS(rt4)	;;; copy stack lvars into sp frame
	subq	rt2, 1, rt2
	lda	rt4, _WOFFS(rt4)
	stW	rt1, _WOFFS(rchain)
	lda	rchain, _WOFFS(rchain)
	bne	rt2, !$2b

	;;; dlocal ids
!$3:	beq	rt3, !$5f		;;; br if none
	sWaddq	rt3, _PD_TABLE, rt2
	addq	rpb, rt2, rfalse	;;; lim of pdr dlocal ident table
!$4:	ldW	rt2, -_WOFFS(rfalse)	;;; next identifier
	ldW	rt0, _WOFFS(rt4)	;;; saved idval from proc
	lda	rfalse, -_WOFFS(rfalse)
	ldW	rt1, _ID_VALOF(rt2)	;;; get current idval
	stW	rt0, _ID_VALOF(rt2)	;;; make proc value current
	subq	rt3, 1, rt3		;;; decrement count
	stW	rt1, _WOFFS(rchain)	;;; save current idval in sp frame
	lda	rt4, _WOFFS(rt4)
	lda	rchain, _WOFFS(rchain)
	bne	rt3, !$4b

	;;; test if has dlocal expression code to run
!$5:	ldl	rt0, _PD_FLAGS_l(rpb)	   ;;; get lword with flags byte
	stW	rpb, 0(rsp)		   ;;; store owner in sp frame
	extbl	rt0, _PD_FLAGS_b, rt0	   ;;; procedure flags
	and	rt0, _:M_PD_PROC_DLEXPR_CODE, rt0
	bne	rt0, si_brk		   ;;; yes -- break out to run code

	;;; (continue here after break)
si_cont:
	addq	rret, rpb, rret		;;; make return address absolute

si_test:
	cmpult	rt5, rt6, rt0		;;; reached the end of the proc?
	blbs	rt0, 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
	stW	rzero, _PS_CALLSTACK_PARTIAL(rchain)
	ldW	rt0, _PD_EXECUTE(rpb)	  ;;; procedure's exec address
	lda	rusp, _WOFFS*2(rusp)	  ;;; erase proc and procedure
	ldW	rfalse, _svb_FALSE	  ;;; restore rfalse
	jmp	rzero, (rt0)			  ;;; 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	rret, _PS_PARTIAL_RETURN(rchain)   ;;; save relative retn addr
	lda	rt0, -BRANCH_std(rt0)	  ;;; addr of procedure's resume code
	stW	rt5, _PS_CALLSTACK_PARTIAL(rchain) ;;; save rt5 in CALLSTACK_PARTIAL
	jmp	rzero, (rt0)			  ;;; 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	rret, _PS_PARTIAL_RETURN(rchain)    ;;; rel return back in rret
	br	si_cont				    ;;; continue swap-out



ASM_END_FILE
