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

	.title	"aprocess.o"	;;; must be the object file name

;;; --- 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;
    for Nnpl from 5 by -1 to 0 do
	for Rpl from 10 by -1 to 0 do
	    -(Nnpl+Rpl+1)*4 -> offs;
	    sys_current_val(consword('rpl' >< Rpl)) -> rn;
	    sprintf('\tstl  %p, %p(%p)\n', [%rn,offs-dstadj,dstreg%]);
	    sprintf('\tldl  %p, %p(%p)\n', [%rn,offs-srcadj,srcreg%])
	endfor;
	sprintf('\tbr  999%p$\n\n', [%Nnpl%]);
    endfor;
    for Rnpl from 4 by -1 to 0 do
	-(Rnpl+1)*4 -> offs;
	sys_current_val(consword('rnpl' >< Rnpl)) -> rn;
	sprintf('999%p$:\tstl  %p, %p(%p)\n', [%Rnpl+1,rn,offs-dstadj,dstreg%]);
	sprintf(       '\tldl  %p, %p(%p)\n', [%rn,offs-srcadj,srcreg%])
    endfor;
    '9990$:\n'
enddefine;

>_#


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
	.align quad
DEF_C_LAB (_swap_out_callstack)
	ldl	rchain, (rusp)		;;; save process in chain reg
	lda	rusp, 4(rusp)
	ldl	rt6, _PS_STATE(rchain)	        ;;; base of saved callstack
	ldl	rt5, _PS_CALLSTACK_LIM(rchain)	;;; limit of saved callstack
	br	so_test

	;;; process a frame
	.align quad
so_loop:
	;;; test if has dlocal expression code to run
	ldl	rt0, _PD_FLAGS_l(rpb)	   ;;; get word with flags byte
	subl	rret, rpb, rret		   ;;; make return address relative
	extbl	rt0, #_PD_FLAGS_b, rt0	   ;;; procedure flags
	ldl	rt2, _PD_FRAME_LEN_l(rpb)  ;;; get word 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
	sll	rt3, #2, rt3		   ;;; frame offset
    .begin_exact
	br	rt1, 1$			   ;;; get address of 1$
1$:	;;; PD_REGMASK VALUE ASSUMES 3 INSTRUCTIONS FROM HERE TO REGCODE
	addl	rt3, sp, rt4		   ;;; (sp frame base)+offs = lim
	addl	rt1, rt2, rt1		   ;;; add switch offset to 1$
	jmp	(rt1)			   ;;; go to it

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

	subl	rt5, rt3, rt5		      ;;; (proc frame lim)-offs = base
	ldl	rt3, _PD_NUM_STK_VARS_l(rpb)  ;;; get word with numstk/nlocals
	stl	rret, (rt5)		      ;;; store rel return addr
	stl	rpb, 4(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, 4(rt5)		;;; use rret to work up proc frame

	;;; on-stack lvars
	beq	rt2, 3$			;;; br if none
2$:	ldl	rt1, 4(sp)		;;; copy stack lvars into proc
	subl	rt2, #1, rt2
	lda	sp, 4(sp)
	stl	rt1, 4(rret)
	lda	rret, 4(rret)
	bne	rt2, 2$

	;;; dlocal ids
3$:	beq	rt3, 5$			;;; br if none
	s4addl	rt3, #_PD_TABLE, rt2
	addl	rpb, rt2, rpb		;;; lim of pdr dlocal ident table
4$:	ldl	rt2, -4(rpb)		;;; next identifier
	ldl	rt0, 4(sp)		;;; saved idval from stack
	lda	rpb, -4(rpb)
	ldl	rt1, _ID_VALOF(rt2)	;;; get current idval
	stl	rt0, _ID_VALOF(rt2)	;;; make saved value current
	subl	rt3, #1, rt3		;;; decrement count
	stl	rt1, 4(rret)		;;; save current idval in process
	lda	sp, 4(sp)
	lda	rret, 4(rret)
	bne	rt3, 4$

5$:	ldl	rret, -4(rt4)		;;; load next frame's return addr
	ldl	rpb, (rt4)		;;; and next owner into rpb
	mov	rt4, sp			;;; 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
	ldl	rpb, (rusp)		  ;;; procedure from stack
	;;; ensure PARTIAL reset to NULL
	stl	rzero, _PS_CALLSTACK_PARTIAL(rchain)
	;;; zero process flags = suspended
	ldl	rt1, _PS_FLAGS_l(rchain)  ;;; load flags word
	ldl	rt0, _PD_EXECUTE(rpb)	  ;;; procedure's exec address
	mskwl	rt1, #_PS_FLAGS_b, rt1	  ;;; clear flags
	lda	rusp, 4(rusp)
	stl	rt1, _PS_FLAGS_l(rchain)  ;;; store flags word
	jmp	(rt0)			  ;;; chain procedure

	;;; come here to run dlocal expression code, by jumping into the
	;;; owner procedure. process is in rchain.
	.align quad
so_brk:
	ldl	rt0, _PD_EXIT(rpb)	  ;;; procedure's exit code base addr
	stl	rret, _PS_PARTIAL_RETURN(rchain)   ;;; save relative retn addr
	lda	rt0, -BRANCH_std*2(rt0)	  ;;; addr of procedure's suspend code
	stl	rt5, _PS_CALLSTACK_PARTIAL(rchain) ;;; save rt5 in CALLSTACK_PARTIAL
	jmp	(rt0)			  ;;; go into procedure's suspend code

	;;; then return from procedure's suspend code is to here
	;;; with process in rchain.
	.align quad
DEF_C_LAB (_swap_out_continue)
	ldl	rt6, _PS_STATE(rchain)		    ;;; restore limit
	ldl	rt5, _PS_CALLSTACK_PARTIAL(rchain)  ;;; restore proc frame base
	ldl	rt2, _PD_FRAME_LEN_l(rpb)  ;;; get word with frame len/regmask
	ldl	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
	.align quad
DEF_C_LAB (_swap_in_callstack)
	ldl	rchain, (rusp)		;;; get process in chain reg (save on stack)
	ldl	rt6, _PS_CALLSTACK_LIM(rchain)	;;; limit of saved callstack
	ldl	rt5, _PS_STATE(rchain)	        ;;; base of saved callstack
	br	si_test

	;;; reinstate a frame
	.align quad
si_loop:
	ldl	rpb, 4(rt5)		   ;;; get owner from proc frame
	mov	sp, rt0			   ;;; save lim of sp frame in rt0
	ldl	rt2, _PD_FRAME_LEN_l(rpb)  ;;; get word with frame len/regmask
	lda	rt4, 4(rt5)		   ;;; use rt4 to work up proc frame
	extbl	rt2, #_PD_FRAME_LEN_b, rt3 ;;; frame length in words
	sll	rt3, #2, rt3		   ;;; frame offset
	subl	sp, rt3, sp		   ;;; create new sp frame
	stl	rret, _SF_RETURN_ADDR(r0)  ;;; 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
	addl	rt5, rt3, rt5		   ;;; (proc frame base)+offs = lim
    .begin_exact
	br	rt1, 1$			   ;;; get address of 1$
1$:	;;; PD_REGMASK VALUE ASSUMES 3 INSTRUCTIONS FROM HERE TO REGCODE
	ldl	rret, _SF_RETURN_ADDR(rt4) ;;; this pdr's relative return addr
	addl	rt1, rt2, rt1		   ;;; add switch offset to 1$
	jmp	(rt1)			   ;;; go to it

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

	ldl	rt3, _PD_NUM_STK_VARS_l(rpb)  ;;; get word with numstk/nlocals
	mov	sp, 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, 3$			;;; br if none
2$:	ldl	rt1, 4(rt4)		;;; copy stack lvars into sp frame
	subl	rt2, #1, rt2
	lda	rt4, 4(rt4)
	stl	rt1, 4(rchain)
	lda	rchain, 4(rchain)
	bne	rt2, 2$

	;;; dlocal ids
3$:	beq	rt3, 5$			;;; br if none
	s4addl	rt3, #_PD_TABLE, rt2
	addl	rpb, rt2, rfalse	;;; lim of pdr dlocal ident table
4$:	ldl	rt2, -4(rfalse)		;;; next identifier
	ldl	rt0, 4(rt4)		;;; saved idval from proc
	lda	rfalse, -4(rfalse)
	ldl	rt1, _ID_VALOF(rt2)	;;; get current idval
	stl	rt0, _ID_VALOF(rt2)	;;; make proc value current
	subl	rt3, #1, rt3		;;; decrement count
	stl	rt1, 4(rchain)		;;; save current idval in sp frame
	lda	rt4, 4(rt4)
	lda	rchain, 4(rchain)
	bne	rt3, 4$

	;;; test if has dlocal expression code to run
5$:	ldl	rt0, _PD_FLAGS_l(rpb)	   ;;; get word with flags byte
	stl	rpb, (sp)		   ;;; 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:
	addl	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
	ldl	rchain, (rusp)		  ;;; get process again
	ldl	rpb, 4(rusp)		  ;;; procedure from stack
	;;; ensure PARTIAL reset to NULL
	stl	rzero, _PS_CALLSTACK_PARTIAL(rchain)
	ldl	rt0, _PD_EXECUTE(rpb)	  ;;; procedure's exec address
	lda	rusp, 8(rusp)		  ;;; erase proc and procedure
	ldl	rfalse, _svb_FALSE	  ;;; restore rfalse
	jmp	(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.
	.align quad
si_brk:
	ldl	rchain, (rusp)		  ;;; get process in chain reg
	ldl	rt0, _PD_EXIT(rpb)	  ;;; procedure's exit code base addr
	ldl	rfalse, _svb_FALSE	  ;;; restore rfalse
	stl	rret, _PS_PARTIAL_RETURN(rchain)   ;;; save relative retn addr
	lda	rt0, -BRANCH_std(rt0)	  ;;; addr of procedure's resume code
	stl	rt5, _PS_CALLSTACK_PARTIAL(rchain) ;;; save rt5 in CALLSTACK_PARTIAL
	jmp	(rt0)			  ;;; go into procedure's resume code

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



	.end