*-----------------------------------------------------------
Title[DMesaXfer.mc...September 8, 1982  5:20 PM...Taft];
* Control transfers and state save/restore.
*-----------------------------------------------------------
%

	CONTENTS, by order of occurence

Subroutines for call/return
	SavePCInFrameIL	Save PCX+IL in local frame
	SavePCInFrame	Save arbitrary PC in local frame
	GetLinkID	Fetch external control link
	LoadGC		Load global frame and code pointers

Control transfer opcodes
	EFCn		External Function Call n
	KFCB		Kernel Function Call Byte
	SFC		Stack Function Call
	LFCn		Local Function Call n
	RET		Return
	PORTO		Port Out
	PORTI		Port In

Frame and link manipulations
	LLKB		Load Link Byte (external link)
	LINKB		Link Byte (to enclosing context)
	DESCB		Descriptor
	DESCBS		Descriptor Stack
	LADRB, GADRB	Local Address Byte, Global Address Byte
	CATCH		Locate catch phrase

Frame allocation
	AllocSub	subroutine to allocate a frame
	ALLOC		Allocate
	FreeSub		subroutine to free a frame
	FREE		Free

XFER primitive
	Xfer		Transfer through control link
	XferProc	Procedure call (allocate frame, patch links)

Traps
	XferTrap	Xfer trap
	SavePCAndTrap	Save PC in frame before trapping
	TrapParamDLink	Trap with DLink as trap parameter
	TrapParamSLink	Trap with SLink as trap parameter
	MTrap		Trap via SD

State save/restore
	DST		Dump State
	SaveState	Save state subroutine
	LST, LSTF	Load State, Load State and Free
	LoadState	Load state from StateVector and Xfer to new context
	LoadStack	Load stack subroutine

Mesa/Alto communication
	MGO		Entry to Mesa from Alto world
	STOP		Exit from Mesa to Alto world
	STARTIO		Alto StartIO
%

*-----------------------------------------------------------
SavePCInFrameIL:
* Saves PCX+IL in local frame
* Entry conditions:
*	RBase=RMforIFU
*	All ID code bytes must have been consumed already
* Exit conditions:
*	MemBase=L
*	SLink and T loaded from L
* Uses RTemp1 as local work storage
* Does not clobber MD
* PrincOps: XferFlags[xf.invalidContext] indicates that the context is
* invalid and the PC should not be stored in the local frame.
*-----------------------------------------------------------
Subroutine;
KnowRBase[RMforIFU];

	RTemp1_ (ID)-(PCX')-1, Global;	*ID=instruction length
:If[AltoMode];		********** Alto version **********
SPCIL0:	MemBase_ L;
	RTemp1_ (RTemp1) RSH 1, Branch[.+2, R even];
	RTemp1_ (0S)-(RTemp1);
:Else;			******** PrincOps version ********
SPCIL0:	MemBase_ L, XferFlags, Branch[.+2, R>=0]; * xf.invalidContext = bit 0
	T_ NOT (DummyRef_ 1S), RTemp1_ MD, Branch[.+2];
:EndIf;			**********************************
	T_ NOT (Store_ 1S), DBuf_ RTemp1; * T_ 177776, VA_ L+1
	SLink_ T_ T AND (VALo), Return;	* L mod 4 = 0 => (L+1) AND 177776 = L

*-----------------------------------------------------------
SavePCInFrame:
* Entry and exit conditions same as SavePCInFrameIL, except:
*	RTemp1 = PC to store
*-----------------------------------------------------------
	Branch[SPCIL0], Global;


*-----------------------------------------------------------
GetLinkID:
* Fetches external link given link index
* Entry conditions:
*	RBase = RTemp
*	MemBase = G
*	ID = index of the link
*	MD = global 0 (= Fetch[G]^)
* Exit:
*	RBase = RTemp
*	MD = requested control link
*	MemBase = G or Code, depending on where the links are
*-----------------------------------------------------------
KnowRBase[RMforIFU];

	RTemp0_ MD, T_ NOT (ID);
GLID0:	RTemp0_ T-T-1, Branch[.+2, R even];
	MemBase_ Code;
	LongFetch_ T, B_ RTemp0, Return;

*-----------------------------------------------------------
GetLink:
* Entry and exit conditions same as GetLinkID, except:
*	T = index of the link (instead of ID)
*-----------------------------------------------------------

	RTemp0_ MD, T_ NOT (T), Branch[GLID0];

*-----------------------------------------------------------
LoadGC:
* Loads global pointer and code pointer given local pointer or GFT pointer
* Entry conditions:
*	MemBase=MDS
*	RBase=RMforIFU
*	T contains either (1) local frame pointer +1 or (2) pointer to GFT entry +1
*	MD = global frame pointer (= FetchMDS[T-1]^)
* Exit conditions:
*	MemBase=Code
*	G set
*	Code set from global frame
*	case (1): RTemp1 = PC;
*	case (2): (Alto only) RTemp1 = epi bias
*		(PrincOps only) RTemp2 = top 2 bits of epi
*	Alto: first word of code segment set to 1 (used by code swapper)
*	Alto: RTemp1 value is also returned in Q
* Clobbers T, RTemp1, RTemp2
*-----------------------------------------------------------
KnowRBase[RMforIFU];

:If[AltoMode];		********** Alto version **********
	RTemp1_ (B_ MD), Fetch_ T;	* Fetch PC (if case 1); RTemp1_ global frame
	T_ (RTemp1)+1, Branch[LoadGCNull, ALU=0];
	T_ (Fetch_ T)+1, Q_ MD;		* Fetch code base
	RTemp2_ MD, Fetch_ T;		*RTemp2=code base (odd => swapped out)
	T_ MD, RTemp2, Branch[CSegSwappedOut, R odd];

	MemBase_ G;			* load up G -- RTemp1 has new value
	BRLo_ RTemp1, RTemp1_ Q;

* load up CP
* if the upper byte of (G+2)^ is not 0, we assume it is a
* FileHandle.  Otherwise, we assume that the least
* significant byte is the most significant part of CP.
	PD_ T AND (177400C);
	MemBase_ Code, Branch[.+2, ALU=0];
	T_ VAHi;			* Left over from MDS-relative Fetch
	BRHi_ T;
	T_ A0, BRLo_ RTemp2;
	Store_ T, DBuf_ 1C, Return;	* set code referenced bit

:Else;			******** PrincOps version ********
	Fetch_ T, T_ MD, RTemp1_ 177774C; * Fetch PC (if case 1); T_ global frame
	RTemp1_ (RTemp1) AND T, MemBase_ G; * gfti[0..13],,00 = global frame
	T_ (BRLo_ RTemp1) XOR T,	* T_ gfti[14..15] = ep bias (case 2)
		RTemp1_ MD,		* RTemp1_ PC (case 1)
		Branch[LoadGCNull, ALU=0]; * global frame = 0 => unbound
	RTemp2_ (Fetch_ 1S)+1;		* Fetch global word 1 = low code base
	Fetch_ RTemp2, RTemp2_ MD;	* word 2 = high code base
	MemBase_ Code, RTemp2,
		Branch[CSegSwappedOut, R odd]; * Code base odd => swapped out
	RTemp2_ MD, BRLo_ RTemp2;	* Load up code base
	RTemp2_ T, BRHi_ RTemp2, Return; * RTemp2_ ep bias (case 2)
:EndIf;			**********************************

TopLevel;

LoadGCNull:
	T_ SUnbound, Branch[TrapParamDLink];
CSegSwappedOut:
	T_ sSwapTrap, Branch[TrapParamDLink];

*-----------------------------------------------------------
IFUP[EFC0, 1, G, N[0]];		* External Function Call n: EFC[n];
IFUP[EFC1, 1, G, N[1]];
IFUP[EFC2, 1, G, N[2]];
IFUP[EFC3, 1, G, N[3]];
IFUP[EFC4, 1, G, N[4]];
IFUP[EFC5, 1, G, N[5]];
IFUP[EFC6, 1, G, N[6]];
IFUP[EFC7, 1, G, N[7]];
IFUP[EFC8, 1, G, N[10]];
IFUP[EFC9, 1, G, N[11]];
IFUP[EFC10, 1, G, N[12]];
IFUP[EFC11, 1, G, N[13]];
IFUP[EFC12, 1, G, N[14]];
IFUP[EFC13, 1, G, N[15]];
IFUP[EFC14, 1, G, N[16]];
IFUP[EFCB, 2, G];		* External Function Call Byte: EFC[alpha];
* EFC: PROCEDURE[index] =
* StoreMDS[@LocalBase[L].pc]^ _ PC;
* XFER[dst: FetchLink[index], src: L, free: FALSE, trap: FALSE];
*-----------------------------------------------------------

:IfMEP;
	Branch[EFCM1];
	Stack_ MD, Branch[EFCM1];
	StkP+1, Branch[EFCM1];
:EndIf;

EFCM1:
	Fetch_ 0S, Call[GetLinkID];
EFCM3:
	XferFlags_ A0, Call[SavePCInFrameIL];
	DLink_ MD, MemBase_ MDS, Branch[Xfer];

*-----------------------------------------------------------
IFUP[EFC15, 1, G, N[16]];	* External Function Call n: EFC[n];
* Alternate entry, required to obtain N=15 (17B)
*-----------------------------------------------------------

	T_ ID+1, Branch[EFCM2];
:IfMEP;
	T_ ID+1, Stack_ MD, Branch[EFCM2];
	T_ ID+1, StkP+1, Branch[EFCM2];
:EndIf;

EFCM2:
	Fetch_ 0S, Call[GetLink];
	Branch[EFCM3];

*-----------------------------------------------------------
IFUP[KFCB, 2, MDS];	* Kernel Function Call Byte:
* StoreMDS[@LocalBase[L].pc]^ _ PC;
* XFER[dst: FetchMDS[@SD[alpha]]^, src: L, free: FALSE, trap: FALSE];
*-----------------------------------------------------------

	XferFlags_ A0, MemBase_ SD, Branch[KFCBM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	StkP+1, Branch[.-2];
:EndIf;

KFCBM1:
	Fetch_ ID, Call[SavePCInFrameIL]; * Fetch SD[alpha]
XferMD:
	DLink_ MD, MemBase_ MDS, Branch[Xfer];

*-----------------------------------------------------------
IFUP[BRK, 1, MDS];	* Breakpoint: Trap[sBreak];
*-----------------------------------------------------------

	T_ XferFlags_ A0, Branch[SavePCAndTrap];	* sBreak = 0
:IfMEP;
	T_ XferFlags_ A0, Stack_ MD, Branch[SavePCAndTrap];
	T_ XferFlags_ A0, StkP+1, Branch[SavePCAndTrap];
:EndIf;

*-----------------------------------------------------------
IFUP[SFC, 1, L];		* Stack Function Call:
* link _ Pop[]; StoreMDS[@LocalBase[L].pc]^ _ PC;
* XFER[dst: link, src: L, free: FALSE, trap: FALSE];
*-----------------------------------------------------------

:IfMEP;
	T_ Stack&-1, Branch[.+2];
	T_ Stack&-1_ MD, Branch[.+1];
	DLink_ T, Call[SavePCInFrameIL];

	XferFlags_ A0;
:Else;
	XferFlags_ A0, Call[SavePCInFrameIL];
	DLink_ Stack&-1;
:EndIf;
	MemBase_ MDS, Branch[Xfer];


*-----------------------------------------------------------
IFUP[LFC1, 1, L, N[1]];		* Local Function Call n: LFC[n];
IFUP[LFC2, 1, L, N[2]];
IFUP[LFC3, 1, L, N[3]];
IFUP[LFC4, 1, L, N[4]];
IFUP[LFC5, 1, L, N[5]];
IFUP[LFC6, 1, L, N[6]];
IFUP[LFC7, 1, L, N[7]];
IFUP[LFC8, 1, L, N[10]];
IFUP[LFC9, 1, L, N[11]];
IFUP[LFC10, 1, L, N[12]];
IFUP[LFC11, 1, L, N[13]];
IFUP[LFC12, 1, L, N[14]];
IFUP[LFC13, 1, L, N[15]];
IFUP[LFC14, 1, L, N[16]];
IFUP[LFCB, 2, L];		* Local Function Call Byte: LFC[alpha];
* LFC: PROCEDURE[epi] =
* StoreMDS[@LocalBase[L].pc]^ _ PC;
* evi _ FetchDbl[@C.entry[epi]]^; tPC _ evi.pc; tL _ Alloc[evi.fsi];
* StoreMDS[@LocalBase[tL].accessLink]^ _ G;
* StoreMDS[@LocalBase[tL].returnLink]^ _ L; L_ tL; PC _ tPC;
*-----------------------------------------------------------

:IfMEP;
	T_ (ID)+1, Branch[LFCM1];
	T_ (ID)+1, Stack_ MD, Branch[LFCM1];
	T_ (ID)+1, StkP+1, Branch[LFCM1];
:Else;
	RTemp4_ ((ID)+1) LSH 1, Call[SavePCInFrameIL]; * RTemp4_ 2*(epi+1)
	XferFlags_ A0, Branch[LFCM2];
:EndIf;

*-----------------------------------------------------------
IFUP[LFC15, 1, L, N[0]];	* Local Function Call n: LFC[n];
IFUP[LFC16, 1, L, N[1]];
* Alternate entry, required to obtain N=15 and 16
*-----------------------------------------------------------

	T_ (ID)+(17C)+1, Branch[LFCM1];
:IfMEP;
	T_ (ID)+(17C)+1, Stack_ MD, Branch[LFCM1];
	T_ (ID)+(17C)+1, StkP+1, Branch[LFCM1];
:EndIf;

LFCM1:
	RTemp4_ T+T, Call[SavePCInFrameIL]; * RTemp4_ 2*(epi+1)
	XferFlags_ A0;
LFCM2:
	DLink_ A0, MemBase_ Code, Branch[XferProc];

*-----------------------------------------------------------
IFUP[RET, 1, L, N[2]];		* Return:
* dst: ControlLink _ FetchMDS[@LocalBase[L].returnLink]^;
* XFER[dst: dst, src: NIL, free: TRUE, trap: FALSE];
*-----------------------------------------------------------

* Fetch word 2 of local frame, and set XferFlags to 1 = xf.free.
	XferFlags_ (Fetch_ ID)-1, Branch[RETM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	XferFlags_ (Fetch_ ID)-1, StkP+1, Branch[RETM1];
:EndIf;

RETM1:
	SLink_ A0, Branch[XferMD];	* source is NIL, dest is in MD


*-----------------------------------------------------------
IFUP[PORTO, 1, L];		* Port Out:
* port: PortLink _ Pop[]; StoreMDS[@LocalBase[L].pc]^ _ PC;
* StoreMDS[@port.inPort]^ _ L;
* XFER[dst: FetchMDS[@port.outPort]^, src: port, free: FALSE, trap: FALSE];
*-----------------------------------------------------------

:IfMEP;
	Branch[.+3];
	Stack_ MD, Branch[.+2];
	StkP+1, Branch[.+1];
:EndIf;

PORTOM1:
	XferFlags_ A0, Call[SavePCInFrameIL];
	T_ SLink, MemBase_ MDS;		* SLink = L
	T_ (Store_ Stack&-1)+1, DBuf_ T;
	SLink_ (Fetch_ T)-1, Branch[XferMD];


*-----------------------------------------------------------
IFUR[PORTI, 1, MDS];		* Port In:
* port: PortLink _ stack[SP+1]; source: ControlLink _ stack[SP+2];
* -- Alto: these are kept in machine registers rather than on the stack!
* StoreMDS[@port.inPort]^ _ NIL;
* IF source#NIL THEN StoreMDS[@port.outPort]^ _ source;
*-----------------------------------------------------------
	
:If[AltoMode];		********** Alto version **********
	PD_ SLink, Branch[PORTIM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	StkP+1, Branch[.-2];
:EndIf;

PORTIM1:
	T_ DLink, Branch[.+2, ALU=0];
	T_ (Store_ T)+1, DBuf_ 0C;
	Store_ T, DBuf_ SLink, IFUNext0CF;

:Else;			******** PrincOps version ********
	StkP+2, Branch[PORTIM1];
:IfMEP;
	Stack&+2_ MD, Branch[PORTIM1];
	StkP+3, Branch[PORTIM1];
:EndIf;

PORTIM1:
	PD_ Stack&-1;
	T_ Stack&+1, Branch[.+2, ALU=0];
	T_ (Store_ T)+1, DBuf_ 0C;
	Store_ T, DBuf_ Stack&-2, IFUNext0CF;
:EndIf;			**********************************

*-----------------------------------------------------------
IFUR[LLKB, 2, G];		* Load Link Byte:
* Push[IF FetchMDS[@GlobalBase[G].codeLinks]^.codeLinks
*  THEN Fetch[C-LONG[alpha]-1]^ ELSE FetchMDS[G-alpha-1]^];
*-----------------------------------------------------------
	
:IfMEP;
	Branch[LLKBM1];
	Stack_ MD, Branch[LLKBM1];
	StkP+1, Branch[LLKBM1];
:EndIf;

LLKBM1:
	Fetch_ 0S, StkP+1, Call[GetLinkID];
	StackT_ MD, IFUNext2;


*-----------------------------------------------------------
IFUR[LINKB, 2, L];		* Link Byte:
* link: ControlLink _ stack[SP+1];  -- dest link of previous Xfer
* -- Alto: kept in machine register rather than on the stack!
* StoreMDS[L]^ _ link-alpha;  -- store in Local 0
*-----------------------------------------------------------

:If[AltoMode];		********** Alto version **********
	T_ (DLink)-T, TisID, Branch[LINKBM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	StkP+1, Branch[.-2];
:EndIf;
:Else;			******** PrincOps version ********
	StkP+1, Branch[LINKBM0];
:IfMEP;
	Stack&+1_ MD, Branch[LINKBM0];
	StkP+2, Branch[LINKBM0];
:EndIf;
LINKBM0:
	T_ (Stack&-1)-T, TisID;
:EndIf;			**********************************

LINKBM1:
* This can't fault, because the store is into the frame we are running in.
* Therefore can exit with IFUNext0 instead of IFUNext0CF.
	Store_ 4S, DBuf_ T, IFUNext0;		* local 0 = @frame+4

*-----------------------------------------------------------
IFUR[DESCB, 2, G, N[0]];	* Descriptor Byte:
* frame: FrameHandle _ G; gf: GlobalWord _ FetchMDS[@GlobalBase[frame].word]^;
* epi: EPIndex _ alpha;  -- see note below
* Push[ProcDesc[gfi: gf.gfi+(epi/EPRange), epi: epi MOD EPRange, tag: 1]];
* Alto:		ProcDesc[gfi (0..8), epi (9..13), tag (14..15)]
* PrincOps:	ProcDesc[gfi (0..9), epi (10..14), tag (15)]
* Note: apparently the compiler generates alpha = 2*epi; that is, epi is already
* left-shifted one bit.
*-----------------------------------------------------------

	Fetch_ ID, StkP+1, Branch[DESCBM1];
:IfMEP;
	Fetch_ ID, Stack&+1_ MD, Branch[DESCBM1];
	Fetch_ ID, StkP+2, Branch[DESCBM1];	*ID=0
:EndIf;

:If[AltoMode];		********** Alto version **********
DESCBM1:
	Stack_ MD, T_ T+T+1, TisID;
	Stack_ (Stack) AND (177600C);
:Else;			******** PrincOps version ********
DESCBM1:
	Stack_ MD, T_ ID+1;
	Stack_ (Stack) AND (177700C);
:EndIf;			**********************************
	StackT_ T+(StackT), IFUNext2;

*-----------------------------------------------------------
IFUR[DESCBS, 2, MDS];		* Descriptor Byte Stack:
* frame: FrameHandle _ Pop[]; gf: GlobalFrame _ GlobalBase[frame];
* Push[ProcDesc[gfi: gf.gfi+(alpha/EPRange), epi: alpha MOD EPRange, tag: 1]];
*-----------------------------------------------------------

	Fetch_ Stack, Branch[DESCBM1];
:IfMEP;
	Fetch_ MD, Branch[DESCBM1];
	Fetch_ T, StkP+1, Branch[DESCBM1];	
:EndIf;

*-----------------------------------------------------------
IFUR[LADRB, 2, L];	* Local Address Byte: Push[L+alpha];
IFUR[GADRB, 2, G];	* Global Address Byte: Push[G+alpha];
*-----------------------------------------------------------

	DummyRef_ StackNoUfl&+1, T_ MD, RisID, Branch[LADRBM1];
:IfMEP;
	DummyRef_ Stack&+1, Stack&+1_ MD, RisID, Branch[LADRBM1];
	DummyRef_ StackNoUfl&+2, T_ MD, RisID, Branch[LADRBM1];
:EndIf;

LADRBM1:
	StackT_ VALo, IFUNext2;


*-----------------------------------------------------------
IFUR[CATCH, 2, L];	* Catch: no-op
*-----------------------------------------------------------

	IFUNext0;
:IfMEP;
	T_ Stack&-1_ MD, IFUNext2;
	IFUNext2;
:EndIf;

*-----------------------------------------------------------
IFUR[ALLOC, 1, MDS];		* Allocate frame: Push[Alloc[Pop[]]];	
*-----------------------------------------------------------

:IfMEP;
	T_ Stack&-1, Branch[.+2];
	T_ Stack&-1_ MD, Branch[.+1];
	StkP+1, Call[AllocSub];
:Else;
	T_ Stack, Call[AllocSub];
:EndIf;

:If[AltoMode];		********** Alto version **********
	Branch[.+2, ALU=0];
	StackT_ T, IFUNext2;
	T_ LSH[Stack&-1, 2];		* Alloc failed, trap.  ATPReg _ 4*fsi
	ATPReg_ T;
	T_ sAllocListEmpty, Branch[SavePCAndTrap];
:Else;			******** PrincOps version ********
	StackT_ T, IFUNext2;
:EndIf;			**********************************

*-----------------------------------------------------------
AllocSub:	* Allocate frame
* Enter: T = fsi
*	MemBase = MDS
* Normal exit: T = frame, ALU#0
* Failure exit: Alto: T = ALU = 0
*	PrincOps: does not return but executes an AllocTrap[fsi]
* Clobbers T, Q, RTemp2, RTemp3; specifically, preserves RTemp0 and RTemp1
* Page faults can occur.
*-----------------------------------------------------------
Subroutine;
KnowRBase[RMforIFU];

	RTemp2_ T_ T+(AV);
AllocRepeat:
	Fetch_ T, RTemp3_ LShift[AV!, 2]C;
	Q_ Link;
TopLevel;
AllocProcEntry:		* Enter here from AllocForProc in Xfer
	RTemp3_ (RTemp3)+(BDispatch_ MD);
Subroutine;
	Link_ Q, Branch[AllocTable];

*-----------------------------------------------------------
AllocTable: DispTable[4, 7, 4];
	T_ MD, Fetch_ MD, Q_ T, Branch[AllocRet]; * 0 good frame
:If[AltoMode];		********** Alto version **********
	T_ A0, Return;			* 1 empty
:Else;			******** PrincOps version ********
	T_ (RTemp2)-(AV), Branch[AllocFail]; * 1 empty; recover original fsi
:EndIf;			**********************************
	T_ RSH[RTemp3, 2], Branch[AllocRepeat]; * 2 indirect
	T_ RSH[RTemp3, 2], Branch[AllocRepeat]; * 3 indirect
*-----------------------------------------------------------

* Found good frame.  Remove it from the head of its AV chain.
AllocRet:
	Store_ T, DBuf_ T, RTemp3_ MD;		* Dirty new frame in case WP fault
	PD_ Store_ Q, DBuf_ RTemp3, Return;	* ALU#0

TopLevel;

:If[Not[AltoMode]];	******** PrincOps version ********
AllocFail:
	FaultParam0_ T;
	T_ qFrameFault, Branch[MesaFault];
:EndIf;			**********************************

*-----------------------------------------------------------
IFUR[FREE, 1, MDS];		* Free frame: Free[Pop[]];	
*-----------------------------------------------------------

:IfMEP;
	T_ Stack&-1, Branch[.+2];
	T_ Stack&-1_ MD, Branch[.+1];
	T_ T-1, Call[FreeSub];
:Else;
	T_ (Stack&-1)-1, Call[FreeSub];
:EndIf;
	IFUNext0;

*-----------------------------------------------------------
FreeSub:	* Free frame
* Enter: T = frame-1
*	MemBase = MDS
* Clobbers T, RTemp0
*-----------------------------------------------------------
Subroutine;

	RTemp0_ (Fetch_ T)+1;		* Fetch frame[-1] = fsi
	T_ AV;
	T_ T+MD;			* AV+fsi
	Fetch_ T;			* Fetch current head of frame list
	Store_ T, DBuf_ RTemp0, T_ MD;	* Store freed frame at head
	Store_ RTemp0, DBuf_ T, Return;	* Store old head in freed frame

TopLevel;

*-----------------------------------------------------------
Xfer:
* Entry conditions:
*	MemBase = MDS
* 	SLink = source link
*	DLink = dest link
*	XferFlags = trap and free flags as appropriate; push = 0
* Performs complete PrincOps XFER operation, or else traps or faults
* in an appropriate manner.
*-----------------------------------------------------------
KnowRBase[RMforIFU];

	T_ BDispatch_ DLink,		* DLink = initial destination link
		DblBranch[XferTagOdd, XferTagEven, R odd], Global;

* T = ALU = control link being dispatched on (from DLink or indirect link).
* If the control link is zero, we must generate a ControlFault.
* A zero control link causes the tag=0 case to be diverted to the tag=1 dispatch
* instruction, and thence to ZeroDest.  The test can't be done directly by the tag=0
* instruction because (1) the Fetch would have to be delayed, and (2) the
* successor of that instruction is a Call which couldn't be placed.
XferTagEven:
	RTemp0_ T,			* Save control link for later, and put thru ALU
		DblBranch[XferTagTable, XferTagTable+1, ALU#0];

* Note that the following instruction puts the ENTIRE control link through the ALU,
* and hence the ALU is guaranteed to be nonzero when the test is made at XferTagTable+1.
XferTagOdd:
	RTemp2_ RSH[T, IfE[AltoMode, 0, 6, 7]], * Extract gfi
		Branch[XferTagTable];

*-----------------------------------------------------------
* The Xfer dispatch on the tag field.
* The instructions in the dispatch table are duplicated as comments
* in the code dispatched to, flagged with "^^^".
XferTagTable: DispTable[4, 7, 4];
	RTemp3_ (Fetch_ T)-T-1, Branch[XferDisp00];		* Tag = 00
XferTagTable+1:
	RTemp4_ LDF[T, 5, IfE[AltoMode, 0, 1, 2]],		* Tag = 01
		DblBranch[XferDisp01, ZeroDest, ALU#0];
	Fetch_ T, Branch[XferDisp10];				* Tag = 10
:If[AltoMode];		********** Alto version **********
	T_ sUnbound, Branch[TrapParamDLink];			* Tag = 11
:Else;			******** PrincOps version ********
	RTemp4_ LDF[T, 5, 1], Branch[XferDisp01];		* Tag = 11
:EndIf;			**********************************
*-----------------------------------------------------------

* Destination link = 0 => control fault.  Trap parameter is SLink.
ZeroDest:
	T_ sControlFault, Branch[TrapParamSLink];

*-----------------------------------------------------------
* dest[14:15]=00   frame pointer
*-----------------------------------------------------------
XferDisp00:
* ^^^	RTemp3_ (Fetch_ T)-T-1;		* RTemp3_ -1 ^^^
	T_ (Store_ T)+1, DBuf_ MD,	* Dirty frame to force WP fault if any
		Call[LoadGC];		* Load G and Code; RTemp1_ PC

* No page faults are possible after here -- we have touched both L and G.
:If[AltoMode];		********** Alto version **********
	T_ (0S)-(RTemp1), Branch[.+2, R<0]; * Convert PC from Alto convention
	RTemp1_ (RTemp1)+(RTemp1), Branch[.+2]; * Positive => even byte
	RTemp1_ T+T+1;			* Negative => odd byte
:EndIf;			**********************************

* Guarantee that if a Reschedule is pending, it won't cause a trap
* until at least the second IFUJump.
	StkP+1, NoReschedule, Branch[.+2, Reschedule']; * StkP+1 for XferExit
	Reschedule;

	PCF_ RTemp1, Branch[XferExitDispatch]; * Start up the IFU

*-----------------------------------------------------------
* dest[14:15]=01 (or 11 if PrincOps)  dest link is proc descriptor, 
* Alto:	 RTemp2 = dest[0:8] = gfi, dest[10:13] = epi
* PrincOps: RTemp2 = dest[0:9] = gfi, dest[10:14] = epi
*-----------------------------------------------------------
:If[AltoMode];		********** Alto version **********
XferDisp01:
* ^^^	RTemp4_ LDF[T, 5, 2];		* ^^^ extract epi
	T_ (RTemp2)+(RTemp2);
	T_ T+(GFT);
	T_ (Fetch_ T)+1, Call[LoadGC];	* Returns ep bias in Q
	RTemp4_ ((RTemp4)+Q+1) LSH 1, Branch[XferProc];
:Else;			******** PrincOps version ********
XferDisp01:
* ^^^	RTemp4_ LDF[T, 5, 1];		* ^^^ extract epi
	T_ (RTemp2)+(GFT);
	T_ (Fetch_ T)+1, Call[LoadGC]; * Returns (ep bias)/32 in RTemp2
	T_ LSH[RTemp2, 5];
	RTemp4_ ((RTemp4)+T+1) LSH 1, Branch[XferProc];
:EndIf;			**********************************

*-----------------------------------------------------------
* dest[14:15]=10  dest link is indirect, 
*	 dest[0:15] address of loc holding dest link
*-----------------------------------------------------------
xferDisp10: ;
* ^^^	Fetch_ T;			* ^^^
:If[Not[AltoMode]];	******** PrincOps version ********
	XferFlags_ (XferFlags) OR (xf.push);
:EndIf;			**********************************
	RTemp0_ MD;
	T_ BDispatch_ RTemp0, DblBranch[XferTagOdd, XferTagEven, R odd];

*-----------------------------------------------------------
* dest[14:15]=11  dest link is unbound -- Alto only
*-----------------------------------------------------------
* ^^^	T_ sUnbound, Branch[TrapParamDLink];	* ^^^

*-----------------------------------------------------------
XferProc:	* Xfer to procedure given entry vector offset.
* Used both by Local Function Calls and by the Procedure case of Xfer.
* Allocates new frame and patches links
* Entry conditions:
*	RTemp4 holds index into code segment entry vector = 2*(epi+1)
*	MemBase = Code
*-----------------------------------------------------------
KnowRBase[RMforIFU];

	T_ (Fetch_ RTemp4)+1;		* Fetch PC
	Fetch_ T, T_ A0, RTemp1_ MD, FlipMemBase; * Fetch fsi; MemBase_ MDS

* Guarantee that if a Reschedule is pending, it won't cause a trap
* until at least the second IFUJump.
	PD_ RTemp1, NoReschedule, Branch[.+2, Reschedule'];
	PD_ RTemp1, Reschedule;

	T_ DPF[T, 10, 10, MD],		* Extract fsi from right byte
		Branch[ProcUnbound, ALU=0]; * Branch if PC was zero

* The following two instructions, plus the instruction at AllocForProc,
* duplicate the first three instructions of AllocSub (due to placement constraints).
	RTemp2_ T_ T+(AV);
	Fetch_ T, RTemp3_ LShift[AV!, 2]C, Call[AllocForProc];

:If[AltoMode];		********** Alto version **********
	RTemp0_ T, MemBase_ G,		* T = ALU = allocated frame
		Branch[XferAllocFail, ALU=0]; * 0 => allocation failed
:Else;			******** PrincOps version ********
* No page faults are possible after here, so it's ok to load L and PCF now.
	RTemp0_ T, MemBase_ G;
:EndIf;			**********************************

	RTemp1_ (RTemp1)+(RTemp1);	* Convert word PC to byte PC
	DummyRef_ 0S, T_ MD, StkP+1;	* Get VA of G[0]; StkP+1 for XferExit
	RTemp3_ T-T-1, MemBase_ MDS;	* RTemp3_ -1 for XferExitDispatch
	T_ VALo;			* T_ global frame pointer
	T_ (Store_ RTemp0)+1, DBuf_ T;	* L[0] _ G
	T_ T+1, PCF_ RTemp1;		* Start the IFU with the new PC
	Store_ T, DBuf_ SLink,		* L[2] _ caller's frame
		Branch[XferExitDispatch];

* Third instruction of AllocSub, duplicated here for placement (see above).
AllocForProc:
	Q_ Link, Branch[AllocProcEntry];

* Procedure entry point had PC of zero.  This may be caused by attempting to call
* a procedure in a discarded code pack.  Give an unbound trap with the destination
* control link as the trap parameter.
ProcUnbound:
	T_ sUnbound, Branch[TrapParamDLink];

:If[AltoMode];		********** Alto version **********
* Allocation failed.  Cause alloc trap in source context with destination link
* as trap parameter (ATPReg).  If this was a LFC, there was no real destination
* link, so we must fabricate one.  DLink = 0 and RTemp4 = 2*(epi+1) in this case.
XferAllocFail:
	T_ DLink;
	T_ (Fetch_ 0S)+T+1,		* Fetch G[0]; has gfi in bits [0..8]
		Branch[HaveLinkAlready, ALU#0];
	RTemp4_ ((RTemp4)-1) LSH 1;	* 4*epi +2
	T_ DPF[DLink, 7, 0, MD];	* gfi*128 (DLink=0 here)
	T_ (RTemp4)+T;			* gfi*128 + epi*4 +2
HaveLinkAlready:
	ATPReg_ T-1;			* Original DLink, or gfi*128 + epi*4 +1
	T_ sAllocListEmpty, Branch[MTrap];
:EndIf;			**********************************

*-----------------------------------------------------------
XferExitDispatch:
* Tail of all Xfer cases.
* Here RTemp0 = new frame, RTemp1 = new PC, RTemp3 = -1.
* StkP has been incremented in anticipation of pushing DLink and SLink.
*-----------------------------------------------------------

	T_ XferFlags, MemBase_ L;
	DummyRef_ RTemp3, T_ MD,	* Get VA of previous local frame -1
		BDispatch_ T;		* Dispatch on exit actions
	BRLo_ RTemp0;			* Load new local frame

* Here we have dispatched on the flags xf.trap, xf.push, and xf.free.
* Note: the combination (trap AND free) is impossible,
* so only cases 0-4 and 6 need be considered.
* Note: in Alto mode, only cases 0 and 1 are possible.
XferExitTable: DispTable[IfE[AltoMode, 0, 7, 2]];
:If[AltoMode];		********** Alto version **********
	StkP-1, IFUNext0;		* 0 no exit action
	MemBase_ MDS, Branch[XferFree];	* 1
:Else;			******** PrincOps version ********
	XTSReg_ (XTSReg) RSH 1, DblBranch[XferTrap, XferExit, R odd]; * 0
	MemBase_ MDS, Branch[XferFree];	* 1
	T_ DLink, Branch[XferPush];	* 2
	T_ DLink, MemBase_ MDS, Branch[XferPush&Free]; * 3
	T_ (Store_ 2S)+1, DBuf_ SLink;	* 4 store return link, in case not already done
	Store_ T, DBuf_ TrapParam, Branch[XferExitTable]; * 5 (dispatch can't happen)
	T_ (Store_ 2S)+1, DBuf_ SLink, Branch[.-1]; * 6 (trapped thru indirect link??)

XferExit:
	XferFlags_ A0, StkP-1, IFUNext0;

* Push DLink and SLink onto the stack.  T = DLink.
XferPush:
	Stack&+1_ T;
	T_ SLink;
	Stack&-1_ T, Branch[XferExitTable];

* Push DLink and SLink onto the stack, and free the old frame.
* T = DLink, MemBase = MDS.
XferPush&Free:
	Stack&+1_ T;
	T_ SLink;
	Stack&-1_ T, Q_ VALo, Branch[XferFreeQ];
:EndIf;			**********************************

* Free the old frame.  VALo = old frame -1, MemBase = MDS.
XferFree:
	Q_ VALo;
XferFreeQ:
	RTemp0_ (Fetch_ Q)+1;		* Fetch L[-1] = fsi
	T_ AV;
	T_ T+MD;			* AV+fsi
	Fetch_ T;			* Fetch current head of frame list
	Store_ T, DBuf_ RTemp0, T_ MD;	* Store freed frame at head
	Store_ RTemp0, DBuf_ T,		* Store old head in freed frame
		Branch[XferExitTable];

:If[Not[AltoMode]];	******** PrincOps version ********
* DLink = destination link of Xfer (0 if LFC); RTemp1 = PC of destination context;
* StkP advanced one beyond TOS.
* Initiate the trap AFTER the Xfer takes place, so it appears that the trap
* occurred in the first instruction of the destination context.
XferTrap:
	TrapParam_ DLink;
	T_ sXferTrap, StkP-1, Branch[SaveRTemp1AndTrap];
:EndIf;			**********************************

*-----------------------------------------------------------
* Trap sequences:
* Entry condition:
*	T: index in SD through which to trap
*	(PrincOps only) TrapParam = trap parameter to be passed, if any
* Entry points:
*	SavePCAndTrap	saves PC in frame before trapping (Alto: PC+IL)
*	TrapParamDLink	traps with DLink as trap parameter
*	TrapParamSLink	traps with SLink as trap parameter
*	MTrap		no additional actions
* Note: PrincOps traps always save PC (not PC+IL) and abort the instruction
* that was being executed, as if it had never been executed to begin with.
* Alto traps are handled in two different ways.  For traps that occur
* other than inside Xfer, PC+IL is stored and the trapping instruction is
* effectively turned into a KFCB of the trap routine.  For traps that occur
* inside Xfer, the Xfer is first completed and then the trap routine is
* called with the destination link as an argument; the trap routine does its
* thing and then transfers control to the original Xfer's destination context.
*-----------------------------------------------------------
TopLevel;

:If[AltoMode];		********** Alto version **********
TrapParamDLink:
	OTPReg_ DLink, Branch[.+2];
TrapParamSLink:
	OTPReg_ SLink;
	MemBase_ L, XferFlags_ T,	* Save SD index for trap
		Branch[TrapNoFree, R even]; * Need to free frame?
	DummyRef_ 0S, T_ MD;		* Yes, get old local frame
	T_ VALo;
	T_ T-1, MemBase_ MDS, Call[FreeSub];
TrapNoFree:
	T_ XferFlags, Branch[MTrap];	* Recover SD index for trap

SavePCAndTrap:
SavePCTrapNRStkP:
	A_ ID, Cnt_ 2S, Global;		* Consume all _ID bytes to ensure ID=IL
	A_ ID, Branch[., Cnt#0&-1];
	RTemp0_ T, Call[SavePCInFrameIL]; * Save PCX+IL in frame
	T_ RTemp0;
MTrap:
	MemBase_ SD;
	Fetch_ T, XferFlags_ xf.trap, Branch[XferMD];

:Else;			******** PrincOps version ********
TrapParamDLink:
	TrapParam_ DLink, Branch[SavePCAndTrap];
TrapParamSLink:
	TrapParam_ SLink, Branch[SavePCAndTrap];
SavePCAndTrap:
	XferFlags, Branch[.+2, R<0], Global;
	RestoreStkP;			* Do this only if context is valid
SavePCTrapNRStkP:
	RTemp1_ NOT (PCX');
SaveRTemp1AndTrap:
	RTemp0_ T, Call[SavePCInFrame];	* Save contents of RTemp1 as PC
	T_ RTemp0;
MTrap:
	MemBase_ SD;
	Fetch_ T, XferFlags_ xf.trap, Branch[XferMD, R>=0];
* If current context is invalid, leave it that way so recursive traps work.
	XferFlags_ (XferFlags) OR (xf.invalidContext), Branch[XferMD];
:EndIf;			**********************************

*-----------------------------------------------------------
IFUR[DST, 2, L];		* Dump State at L+alpha
*-----------------------------------------------------------

	DummyRef_ 0S, T_ MD, Branch[DSTM1];
:IfMEP;
	DummyRef_ 0S, Stack_ MD, Branch[DSTM1];
	DummyRef_ 0S, T_ MD, StkP+1, Branch[DSTM1];
:EndIf;

DSTM1:
	RTemp0_ ID;			* RTemp0_ alpha
	DLink_ VALo, Call[SaveState];	* DLink_ L
	Store_ T, DBuf_ SLink, IFUNext0CF;


*-----------------------------------------------------------
SaveState:
* Callers:	DST, MSTOP
* Entry conditions:
*	RTemp0 holds the address of the StateVector
*	MemBase = whatever is appropriate
*	RBase = RMforIFU
*	DLink = destination link
* Exit conditions:
*	State saved, StkP=0
*	T = @state.data[0] = RTemp0+sizeStack+2
*	Clobbers RTemp1
*-----------------------------------------------------------
Subroutine;
KnowRBase[RMforIFU];

	RTemp1_ T_ TIOA&StkP;		* Read StkP -- know TIOA=0 !
	PD_ T-(Add[sizeStack, 1]C), StkP+1; * See if valid stack pointer
	T_ T+1, StkP+1, Branch[SaveStackBad, ALU>=0];

* Note: must save 2 words beyond TOS.  Save StkP and DLink after storing
* stack so that they aren't clobbered if too many stack words are stored.
	T_ (RTemp0)+(Cnt_ T);		* State[0..StkP+1] _ Stack[1..StkP+2]
	T_ (Store_ T)-1, DBuf_ Stack&-1, Branch[., Cnt#0&-1];

	T_ (RTemp0)+(Add[sizeStack]C);
	T_ (Store_ T)+1, DBuf_ RTemp1;	* State[sizeStack] _ StkP
	T_ (Store_ T)+1, DBuf_ DLink, Return; * State[sizeStack+1] _ DLink

TopLevel;

SaveStackBad:
	Branch[StackError];

*-----------------------------------------------------------
IFUP[LST, 2, L, N[0]];		* Load State
* Load state from state block at L+alpha.
IFUP[LSTF, 2, L, N[xf.free!]];	* Load State and Free
* Load state from state block at L+alpha, and free L.
*-----------------------------------------------------------

	XferFlags_ ID, Branch[LSTM1];
:IfMEP;
	XferFlags_ ID, Branch[LSTM1];	* Don't care about state of StkP,
	XferFlags_ ID, Branch[LSTM1];	*  because we are about to clobber it
:EndIf;

LSTM1:
	RTemp0_ ID, Call[SavePCInFrameIL]; * Superfluous if LSTF

*-----------------------------------------------------------
LoadState:	* Load state from state vector, and Xfer to new context
* Enter: RTemp0 points to block from which state is to be loaded
*	MemBase = whatever is appropriate
*	XferFlags = whatever is appropriate
* Exit:	StkP, DLink, SLink, and Stack loaded
*	MemBase=MDS
* Transfers control via Xfer[DLink, SLink] when done.
*-----------------------------------------------------------

	T_ (RTemp0)+(Add[sizeStack, 2]C);
	Fetch_ T;			* State[sizeStack+2] = source link
	SLink_ MD, Call[LoadStack];
	MemBase_ MDS, Branch[Xfer];

*-----------------------------------------------------------
LoadStack:	* Load stack from StateVector
* Enter: RTemp0 points to block from which state is to be loaded
*	MemBase = whatever is appropriate
*	XferFlags = whatever is appropriate
* Exit:	Stack, StkP, and DLink loaded
* Clobbers T, RTemp1, Cnt
*-----------------------------------------------------------
Subroutine;

	T_ (RTemp0)+(Add[sizeStack, 1]C);
	T_ (Fetch_ T)-1;		* State[sizeStack+1] = dest link
	DLink_ MD, Fetch_ T, T_ 177400C; * State[sizeStack] = brkbyte,,stkP
	RTemp1_ T AND (Cnt_ MD);	* Is there a break pending?
LoadStack2:
	T_ RTemp0, StkP_ T, Branch[XferNoBreak, ALU=0]; * StkP_ B[8:15]_ 0

	T_ 50C;
	T_ T-1, IFUReset, Branch[., ALU#0];
	RTemp1_ (RTemp1) XOR (BrkIns_ MD); * BrkIns_ B[0:7], RTemp1[0:7]_ 0
	T_ A0, Cnt_ RTemp1, Branch[LoadStack2];

* Note: must load 2 words beyond TOS.  Stack[1..StkP+2] _ State[0..StkP+1]
XferNoBreak:
	T_ (Fetch_ T)+1, StkP+1;
	T_ (Fetch_ T)+1, Stack&+1_ MD, Branch[., Cnt#0&-1];
	Stack&-2_ MD, Return;		* Leave 2 words above TOS

TopLevel;

*-----------------------------------------------------------
*	Mesa emulator entry and exit
*-----------------------------------------------------------

*-----------------------------------------------------------
MGo:
* Entry to Mesa Emulator
*	Alto: AC0 (Stack) holds address of current process state block
*	Alto: Location 'PSBloc' is assumed to hold the same value
*-----------------------------------------------------------
DontKnowRBase;

	T_ Add[100000, LShift[MesaInsSet, 10]]C;
	InsSetOrEvent_ T;
	MemBX_ 0S;			* MemBX_ first register group
	MemBase_ SD;			* Init SD base register
	T_ And[SDLoc, 177400]C;
	T_ T OR (And[SDLoc, 377]C);
	BRLo_ T;
	T_ A0, RBase_ RBase[RTemp0];
	TIOA_ T;			* TIOA=0 required in various places
:If[AltoMode];		********** Alto version **********
	PD_ WDC, RBase_ RBase[NWW], Call[UpdateNWW];
	T_ EmuBRHiReg, RBase_ RBase[RTemp0];
	MDSHi_ T;
	XferFlags_ A0, MemBase_ MDS;
	RTemp0_ Stack, Branch[LoadState];
:Else;			******** PrincOps version ********
	WDC_ 1C;
	T_ NWW_ A0;
	XferFlags_ A0, StkP_ T;
	TickCount_ T+1;
	MemBase_ PDA;
	T_ PDAHi;
	T_ A0, BRHi_ T;
	BRLo_ T;
	MDSHi_ pilotMDSHi, Call[SetMDS];
	T_ XTSReg_ A0;
	SLink_ BRLo_ T;
	T_ sBoot, Branch[MTrap];	* Xfer[dst: Fetch[@SD[sBoot]]^, src:0]
:EndIf;			**********************************

:If[AltoMode];		********** Alto version **********
*-----------------------------------------------------------
IFUP[STOP, 1, MDS, RBase[AEmRegs]];	* Save state and exit to Nova world
*-----------------------------------------------------------

	NWW_ (NWW) OR (100000C), Branch[STOPM1]; * Nova interrupts disabled
:IfMEP;
	Stack_ MD, Branch[.-1];
	StkP+1, Branch[.-2];
:EndIf;

STOPM1:
	RBase_ RBase[RTemp0], Call[SavePCInFrameIL];
	MemBase_ PDA;
	DLink_ CurrentState;
	Fetch_ DLink, DLink_ T;		* T=L (set by SavePCInFrameIL)
	RTemp0_ MD, Call[SaveState];
	Store_ T, DBuf_ SLink;
	T_ MesaStopLoc, Branch[Start];

:Else;			******** PrincOps version ********
UndefOp[MOpSTOP];	* Pilot never stops, it says here
:EndIf;			**********************************


:If[AltoMode];		********** Alto version **********
*-----------------------------------------------------------
IFUR[STARTIO, 1, MDS];	* Alto STARTIO
*-----------------------------------------------------------

	Branch[DiskSIO];
:IfMEP;
	Stack_ MD, Branch[DiskSIO];
	StkP+1, Branch[DiskSIO];
:EndIf;
:Else;			******** PrincOps version ********
UndefOp[MOpSTARTIO];
:EndIf;			**********************************
(1552)