*-----------------------------------------------------------
Title[CpaXfer.mc...May 15, 1986 9:47:14 am PDT...Willie-Sue];
* Control transfers and state save/restore.
* Adds statistics gathering for function calls
*-----------------------------------------------------------
%

 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];

 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)
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];
*-----------------------------------------------------------
* adding statistics gathering for function calls
: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];
:IfMEP;
 Branch[EFCM1];
 Stack← MD, Branch[EFCM1];
 StkP+1, Branch[EFCM1];
:EndIf;
EFCM1:
T ← ID, Call[EFCStats];
EFCM12:
Membase ← G;
Fetch← 0S, Call[GetLink];
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:
Call[EFCStats];
Membase ← G;
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, Call[KFCbStats];
MemBase← SD, Branch[KFCBM1];
:IfMEP;
Stack← MD, Branch[.-2];
StkP+1, Branch[.-3];
:EndIf;
KFCBM1:
Fetch← ID, Call[SavePCInFrameIL]; * Fetch SD[alpha]
XferMD:
DLink← MD, MemBase← MDS, Branch[Xfer];

 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;
Call[SFCStats];
MemBase← MDS, Branch[Xfer];

: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;

: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:
T ← RTemp4, Call[LfcStats];
DLink← A0, MemBase← Code, Branch[XferProc];

 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];
Call[PortoStats];
T← SLink, MemBase← MDS;  * SLink = L
T← (Store← Stack&-1)+1, DBuf← T;
SLink← (Fetch← T)-1, Branch[XferMD];

: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;
*-----------------------------------------------------------

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;
Call[PortiStats];
IFUNext0CF;

 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;
*-----------------------------------------------------------
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
*-----------------------------------------------------------

 StkP+1, Branch[LINKBM0];
:IfMEP;
 Stack&+1← MD, Branch[LINKBM0];
 StkP+2, Branch[LINKBM0];
:EndIf;
LINKBM0:
 T← (Stack&-1)-T, TisID;

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;

DESCBM1:
 Stack← MD, T← ID+1;
 Stack← (Stack) AND (177700C);
 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;

 StackT← T, IFUNext2;
*-----------------------------------------------------------
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
 T← (RTemp2)-(AV), Branch[AllocFail]; * 1 empty; recover original fsi
 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;

AllocFail:
 FaultParam0← T;
 T← qFrameFault, Branch[MesaFault];
*-----------------------------------------------------------
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
 RTemp4← LDF[T, 5, 1], Branch[XferDisp01];  * Tag = 11
*-----------------------------------------------------------

* 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.

* 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
*-----------------------------------------------------------
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];
*-----------------------------------------------------------
* dest[14:15]=10 dest link is indirect,
*  dest[0:15] address of loc holding dest link
*-----------------------------------------------------------
xferDisp10: ;
* ^^^ Fetch← T;   * ^^^
 XferFlags← (XferFlags) OR (xf.push);
 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];

* No page faults are possible after here, so it's ok to load L and PCF now.
 RTemp0← T, MemBase← G;

 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];
*-----------------------------------------------------------
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]];
 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];

* 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];

* 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];
*-----------------------------------------------------------
* 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;

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];
*-----------------------------------------------------------
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
 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]
UndefOp[MOpSTOP]; * Pilot never stops, it says here
UndefOp[MOpSTARTIO];