DIRECTORY
Alloc USING [Notifier],
Basics USING [bitsPerWord],
Code USING [actenable, catchcount, cfsi, cfSize, CodePassInconsistency, codeptr, substenable],
CodeDefs USING [Base, BoVarIndex, Byte, CodeCCIndex, codeType, LabelCCIndex, LabelCCNull,
Lexeme, MaxParmsInStack, NullLex, VarComponent, VarIndex],
ComData USING [bodyIndex, stopping],
Counting USING [Free],
FOpCodes USING [qALLOC, qBLT, qCATCH, qDUP, qEFC, qFREE, qGADRB, qKFCB, qLFC, qLI, qLL, qLP, qMRE, qMREL, qMXD, qMXDL, qMXW, qMXWL, qPORTI, qPORTO, qPUSH, qR, qRDL, qRL, qSFC],
Log USING [Error, Warning],
OpTableDefs USING [InstLength],
P5 USING [CatchPhrase, Exp, GenTempLex, PushLex, PushRhs, ReleaseLock,  SAssign, SCatchPhrase, TransferConstruct],
P5L USING [CopyToTemp, CopyVarItem, EasilyLoadable, GenVarItem, LoadAddress, LoadComponent, LoadVar, MakeBo, OVarItem, ReusableCopies, TOSAddrLex, TOSLex, ReleaseLex, VarForLex, VarVarAssign],
P5S USING [],
P5U USING [AllocCodeCCItem, BitsForOperand, BitsForType, ComputeFrameSize,  CreateLabel, InsertLabel, LabelAlloc, LongTreeAddress, NextVar,  OperandType, Out0, Out1, OutJump, PushLitVal, TreeLiteralValue, WordsForOperand, WordsForSei],
PrincOps USING [AllocationVectorSize, returnOffset, sCopy, sError, sErrorList, sFork, sJoin, sRestart, sReturnError, sReturnErrorList, sSignal, sSignalList, sStart, sUnnamedError],
RTSD USING [sProcCheck],
Stack USING [DeleteToMark, Dump, Incr, Load, Mark, TempStore, Top],
SymbolOps USING [CtxLevel, FindExtension, FirstCtxSe, NextSe, TransferTypes, WordsForType, XferMode],
Symbols USING [Base, BitAddress, bodyType, CBTIndex, CBTNull, ContextLevel, CSEIndex,  CTXIndex, ctxType, ISEIndex, lG, RecordSEIndex, SEIndex, SENull, seType],
Tree USING [Base, Index, Link, Null, treeType],
TreeOps USING [FreeNode, GetNode, OpName, NthSon, ScanList, UpdateList];

Calls: PROGRAM
IMPORTS  MPtr: ComData, CPtr: Code, Counting, Log, OpTableDefs, P5, P5L, P5U, Stack, SymbolOps, TreeOps 
EXPORTS CodeDefs, P5, P5S = BEGIN OPEN CodeDefs;


bitsPerWord: CARDINAL = Basics.bitsPerWord;

BitAddress: TYPE = Symbols.BitAddress;
CBTIndex: TYPE = Symbols.CBTIndex;
CBTNull: CBTIndex = Symbols.CBTNull;
ContextLevel: TYPE = Symbols.ContextLevel;
CSEIndex: TYPE = Symbols.CSEIndex;
CTXIndex: TYPE = Symbols.CTXIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
lG: ContextLevel = Symbols.lG;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;


tb: Tree.Base;		-- tree base (local copy)
seb: Symbols.Base;		-- semantic entry base (local copy)
ctxb: Symbols.Base;		-- context entry base (local copy)
bb: Symbols.Base;		-- body entry base (local copy)
cb: CodeDefs.Base;		-- code base (local copy)

CallsNotify: PUBLIC Alloc.Notifier =
BEGIN  -- called by allocator whenever table area is repacked
seb _ base[Symbols.seType];
ctxb _ base[Symbols.ctxType];
bb _ base[Symbols.bodyType];
tb _ base[Tree.treeType];
cb _ base[codeType];
END;

SysError: PUBLIC PROC =
BEGIN
Stack.Dump[]; Stack.Mark[];
SysCall[PrincOps.sUnnamedError];
CallCatch[Tree.Null];
P5U.OutJump[JumpRet,LabelCCNull];
END;


SysErrExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
nrets: CARDINAL = P5U.WordsForSei[tb[node].info];
Stack.Dump[]; Stack.Mark[];
SysCall[PrincOps.sUnnamedError];
CallCatch[Tree.Null];
P5U.OutJump[JumpRet,LabelCCNull];
RETURN[PRetLex[nrets, node, TRUE]]
END;


Create: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN -- generate code for NEW
Stack.Dump[]; Stack.Mark[];
IF tb[node].attr1 THEN P5.PushRhs[tb[node].son[1]]
ELSE P5U.Out1[FOpCodes.qGADRB, 0];
SysCall[PrincOps.sCopy];
CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
Stack.Incr[1];
RETURN[P5L.TOSLex[1]]
END;


SStart: PROC[node: Tree.Index] RETURNS[nrets: CARDINAL] =
BEGIN
ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
Stack.Dump[]; Stack.Mark[];
[] _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, FALSE];
P5.PushRhs[tb[node].son[1]];
SysCall[PrincOps.sStart];
CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
RETURN[P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut]]
END;

Start: PUBLIC PROC[node: Tree.Index] = {[] _ SStart[node]};

StartExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
nrets: CARDINAL = SStart[node];
RETURN[PRetLex[nrets, node, FALSE]]
END;

Restart: PUBLIC PROC[node: Tree.Index] =
BEGIN
Stack.Dump[]; Stack.Mark[];
P5.PushRhs[tb[node].son[1]];
SysCall[PrincOps.sRestart];
CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
END;


Stop: PUBLIC PROC[node: Tree.Index]  =
BEGIN OPEN FOpCodes;
IF ~MPtr.stopping THEN SIGNAL CPtr.CodePassInconsistency;
P5U.Out1[qLL, PrincOps.returnOffset]; P5U.Out0[qSFC];
END;


CallCatch: PUBLIC PROC[t: Tree.Link] =
BEGIN
IF t # Tree.Null THEN P5.CatchPhrase[TreeOps.GetNode[t]]
ELSE ChainCatch[CPtr.actenable];
END;

ChainCatch: PROC[label: LabelCCIndex] =
BEGIN
IF label # LabelCCNull THEN
BEGIN
clabel: LabelCCIndex = P5U.LabelAlloc[];
P5U.Out1[FOpCodes.qCATCH, CPtr.cfsi];
P5U.OutJump[JumpA, clabel];
P5U.OutJump[Jump, label];
P5U.InsertLabel[clabel];
END;
END;


SCall: PROC[node: Tree.Index] RETURNS[nrets: CARDINAL] =
BEGIN -- generates code for procedure call statement
OPEN FOpCodes;
ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
portcall: BOOL = (SymbolOps.XferMode[ptsei] = port);
computedtarget: BOOL;
nparms: CARDINAL;
sei: ISEIndex;
inlineCall: BOOL;
WITH tb[node].son[1] SELECT FROM
symbol =>
BEGIN
sei _ index;
inlineCall _ seb[sei].constant AND seb[sei].extended;
computedtarget _ SymbolOps.CtxLevel[seb[sei].idCtx] # lG;
END;
ENDCASE => {inlineCall _ FALSE; computedtarget _ TRUE};
IF ~inlineCall THEN Stack.Dump[]; 
Stack.Mark[];
nparms _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, FALSE];
IF inlineCall THEN 
BEGIN
inlineTree: Tree.Link = SymbolOps.FindExtension[sei].tree;
Stack.DeleteToMark[];
TreeOps.ScanList[TreeOps.NthSon[inlineTree, 1], CodeInline];
END 
ELSE IF computedtarget THEN
IF portcall THEN 
BEGIN
[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
Stack.DeleteToMark[]; Stack.Incr[1];
P5U.Out0[qPORTO]; P5U.Out0[qPORTI];
END
ELSE
BEGIN
P5.PushRhs[tb[node].son[1]];
Stack.DeleteToMark[]; Stack.Incr[1];
P5U.Out0[qSFC];
END
ELSE
BEGIN
Stack.DeleteToMark[]; -- assert that loading pdesc won't dump stack
IF seb[sei].constant THEN 
BEGIN
bti: CBTIndex = seb[sei].idInfo;
IF bti # CBTNull AND bb[bti].nesting = Outer THEN
P5U.Out1[qLFC, bb[bti].entryIndex]
ELSE {P5.PushLex[[se[sei]]]; P5U.Out0[qSFC]};
END
ELSE IF portcall THEN
BEGIN
[] _ P5L.LoadAddress[P5L.VarForLex[[se[sei]]]];
P5U.Out0[qPORTO]; P5U.Out0[qPORTI];
END
ELSE IF seb[sei].linkSpace THEN
{a: BitAddress = seb[sei].idValue; P5U.Out1[qEFC, a.wd]}
ELSE {P5.PushLex[[se[sei]]]; P5U.Out0[qSFC]};
END;
nrets _ P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut];
IF inlineCall THEN 
{IF tb[node].nSons > 2 THEN P5.CatchPhrase[TreeOps.GetNode[tb[node].son[3]]]}
ELSE CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
RETURN
END;

ConstructOnStack: PUBLIC PROC[maint: Tree.Link, rcsei: RecordSEIndex] =
BEGIN OPEN SymbolOps;
ctx: CTXIndex = seb[rcsei].fieldCtx;
sei: ISEIndex;
firstArg: BOOL _ TRUE;

DoSafen: PROC[t: Tree.Link] RETURNS[v: Tree.Link] =
BEGIN
SELECT TreeOps.OpName[t] FROM
safen =>
BEGIN
node: Tree.Index = TreeOps.GetNode[t];
IF firstArg OR ~tb[node].attr2 THEN
BEGIN -- this dies horribly if there is only a single
v _ tb[node].son[1];
tb[node].son[1] _ Tree.Null;  TreeOps.FreeNode[node];
END
ELSE
BEGIN
r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
sei: ISEIndex = P5L.CopyToTemp[r].sei;
seb[sei].idType _ tb[node].info;
v _ [symbol[sei]];
TreeOps.FreeNode[node];
END;
firstArg _ FALSE;
END;
rowcons, construct =>
BEGIN  -- why not unroll nested constructors?
node: Tree.Index = TreeOps.GetNode[t];
IF tb[node].name = rowcons AND tb[node].attr1 THEN firstArg _ FALSE
ELSE tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], DoSafen];
v _ t;
END;
cast, pad =>
BEGIN
node: Tree.Index = TreeOps.GetNode[t];
tb[node].son[1] _ DoSafen[tb[node].son[1]];
v _ t;
END;
ENDCASE =>
BEGIN v _ t; firstArg _ FALSE END;
RETURN
END;

LoadOne: PROC[t: Tree.Link] =
BEGIN
IF t = Tree.Null THEN
THROUGH [0..SymbolOps.WordsForType[seb[sei].idType]) DO
P5U.Out1[FOpCodes.qLI, 0];
ENDLOOP
ELSE IF TreeOps.OpName[t] = pad THEN
BEGIN
t1: Tree.Link = TreeOps.NthSon[t, 1];
delta: CARDINAL = P5U.BitsForType[seb[sei].idType] - P5U.BitsForOperand[t1];
P5.PushRhs[t1];
IF delta MOD bitsPerWord # 0 THEN ERROR;
THROUGH [0.. delta/bitsPerWord) DO P5U.Out1[FOpCodes.qLI, 0] ENDLOOP;
END
ELSE P5.PushRhs[t];
sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
END;

SELECT TreeOps.OpName[maint] FROM
list =>
BEGIN
maint _ TreeOps.UpdateList[maint, DoSafen];
sei _ SymbolOps.FirstCtxSe[ctx];
TreeOps.ScanList[maint, LoadOne];
END;
safen => P5.PushRhs[TreeOps.NthSon[maint, 1]];
ENDCASE => P5.PushRhs[maint];
END;

SSigErr: PROC[node: Tree.Index, error: BOOL] RETURNS[nrets: CARDINAL] =
BEGIN -- generates code for signal/error
ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
nparms: CARDINAL;
sysFn: ARRAY BOOL OF ARRAY BOOL OF Byte = [
[PrincOps.sSignal, PrincOps.sSignalList],
[PrincOps.sError, PrincOps.sErrorList]];
Stack.Dump[]; Stack.Mark[];
IF tb[node].son[1] = Tree.Null THEN P5U.PushLitVal[-1]
ELSE P5.PushRhs[tb[node].son[1]];
nparms _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, TRUE];
SysCall[sysFn[error][nparms > 1]];
nrets _ P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut];
CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
RETURN
END;

RetWithError: PUBLIC PROC[node: Tree.Index] =
BEGIN -- generates code for RETURN WITH error
ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
nparms: CARDINAL;
monitored: BOOL _ tb[node].attr1;
IF monitored AND tb[node].attr2 THEN {P5.ReleaseLock[]; monitored _ FALSE};
Stack.Dump[]; Stack.Mark[];
IF tb[node].son[1] = Tree.Null THEN P5U.PushLitVal[-1]
ELSE P5.PushRhs[tb[node].son[1]];
nparms _ PushParms[FALSE, tb[node].son[2], ptsei, TRUE];
IF monitored THEN
BEGIN
Stack.Dump[];
P5.ReleaseLock[];
Stack.Load[Stack.Top[2],2];
END;
IF tb[node].attr3 THEN  -- inline expanded
BEGIN
SysCall[IF nparms > 1 THEN PrincOps.sErrorList ELSE PrincOps.sError];
ChainCatch[CPtr.substenable];
END
ELSE SysCall[IF nparms > 1 THEN PrincOps.sReturnErrorList ELSE PrincOps.sReturnError];
P5U.OutJump[JumpRet,LabelCCNull];
END;

CodeInline: PROC[t: Tree.Link] =
BEGIN
opByte: ARRAY [0..7) OF Byte;
iLength: CARDINAL _ 0;
tLength: CARDINAL;
c: CodeCCIndex;

PickUpByte: PROC[t: Tree.Link] =
BEGIN
IF iLength < 7 THEN
BEGIN
opByte[iLength] _ WITH t SELECT FROM
symbol => seb[index].idValue,
ENDCASE => P5U.TreeLiteralValue[t];
iLength _ iLength + 1;
END
ELSE Log.Error[instLength];
END;

TreeOps.ScanList[t, PickUpByte];
IF iLength = 0 THEN RETURN;
tLength _ OpTableDefs.InstLength[opByte[0]];
IF tLength # 0 AND iLength # tLength THEN Log.Warning[instLength];
c _ P5U.AllocCodeCCItem[iLength-1];
cb[c].realinst _ TRUE;
cb[c].inst _ opByte[0];
cb[c].isize _ iLength;
FOR i: CARDINAL IN [1..iLength) DO cb[c].parameters[i] _ opByte[i] ENDLOOP;
END;


PushParms: PROC[argsBuilt: BOOL, t: Tree.Link, ptsei: CSEIndex, sigerr: BOOL] 
RETURNS[nparms: CARDINAL] =
BEGIN
rsei: RecordSEIndex = SymbolOps.TransferTypes[ptsei].typeIn;
RETURN[IF argsBuilt
THEN PushArgRecord[t, rsei, sigerr, FALSE]
ELSE BuildArgRecord[t, rsei, sigerr, FALSE]]
END;

BuildArgRecord: PUBLIC PROC[t: Tree.Link, rsei: RecordSEIndex, sigerr, isResume: BOOL]
RETURNS[nparms: CARDINAL] =
BEGIN
nparms _ IF rsei = Symbols.SENull THEN 0 ELSE P5U.WordsForSei[rsei];
IF nparms > MaxParmsInStack OR (sigerr AND nparms > 1) THEN
P5.TransferConstruct[nparms, bb[MPtr.bodyIndex].resident, t, rsei]
ELSE IF sigerr AND ~isResume AND nparms = 0 THEN P5U.PushLitVal[-1]
ELSE IF nparms # 0 THEN ConstructOnStack[t, rsei];
RETURN
END;

PushArgRecord: PUBLIC PROC[t: Tree.Link, rsei: RecordSEIndex, sigerr, isResume: BOOL]
RETURNS[nparms: CARDINAL] =
BEGIN
offStack: BOOL;
frameExists: BOOL _ FALSE;
nparms _ IF rsei = Symbols.SENull THEN 0 ELSE P5U.WordsForSei[rsei];
offStack _ (nparms > MaxParmsInStack OR (sigerr AND nparms > 1));
IF t # Tree.Null THEN
BEGIN
l: Lexeme;
l _ P5.Exp[t ! LogHeapFree => 
IF calltree = t AND offStack THEN
{frameExists _ TRUE; RESUME [TRUE, NullLex]}
ELSE RESUME [FALSE, NullLex] ];
SELECT TRUE FROM
frameExists => P5L.ReleaseLex[l];
offStack =>
BEGIN
source: VarIndex = P5L.VarForLex[l];
dest: VarIndex;
temp: VarComponent;
fs: CARDINAL _ P5U.ComputeFrameSize[nparms];
IF bb[MPtr.bodyIndex].resident THEN
fs _ fs + PrincOps.AllocationVectorSize;
P5U.PushLitVal[fs];  P5U.Out0[FOpCodes.qALLOC];
temp _ Stack.TempStore[1];
dest _ P5L.GenVarItem[bo];
cb[dest] _ [body: bo[base: temp, offset: [wSize: nparms, space: frame[]]]];
l _ P5L.VarVarAssign[to: dest, from: source, isexp: FALSE];
P5L.LoadComponent[temp];
END;
ENDCASE => P5.PushLex[l];
END
ELSE IF sigerr AND ~isResume THEN P5U.PushLitVal[-1];
RETURN
END;


Call: PUBLIC PROC[node: Tree.Index] = {[] _ SCall[node]};

SigErr: PUBLIC PROC[node: Tree.Index] =
BEGIN
error: BOOL = (tb[node].name = error);
[] _ SSigErr[node, error];
IF error THEN P5U.OutJump[JumpRet,LabelCCNull];
END;

CallExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
nrets: CARDINAL = SCall[node];
RETURN[PRetLex[nrets, node, FALSE]];
END;

LogHeapFree: PUBLIC SIGNAL [calltree: Tree.Link] RETURNS[BOOL, Lexeme.se] = CODE;

IndirectReturnRecord: PUBLIC PROC[node: Tree.Index, nrets: CARDINAL]
RETURNS[Lexeme] =
BEGIN -- also called by SubstExp
OPEN FOpCodes;
tlex, hlex: Lexeme.se;
logged: BOOL;
[logged, hlex] _ SIGNAL LogHeapFree[[subtree[node]]];
IF ~logged THEN
BEGIN
tlex _ P5.GenTempLex[1];
P5.SAssign[tlex.lexsei];
P5U.Out0[qPUSH];
hlex _ P5.GenTempLex[nrets];
P5U.PushLitVal[nrets];
[] _ P5L.LoadAddress[P5L.VarForLex[hlex]];
P5U.Out0[qBLT];
P5.PushLex[tlex];
P5U.Out0[qFREE];
RETURN[hlex]
END;
IF hlex # NullLex THEN
BEGIN
P5.SAssign[hlex.lexsei]; 
P5.PushLex[hlex]; -- will become PUSH, helps stack model
END;
RETURN[P5L.TOSAddrLex[nrets, FALSE]]
END;

SigExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
nrets: CARDINAL = SSigErr[node, FALSE];
RETURN[PRetLex[nrets, node, TRUE]]
END;

ErrExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
nrets: CARDINAL = P5U.WordsForSei[tb[node].info];
[] _ SSigErr[node, TRUE];
P5U.OutJump[JumpRet,LabelCCNull];
RETURN[PRetLex[nrets, node, TRUE]]
END;

SysCall: PUBLIC PROC[alpha: Byte] =
BEGIN -- puts out call via system transfer vector
Stack.DeleteToMark[];
P5U.Out1[FOpCodes.qKFCB, alpha];
END;

SysCallN: PUBLIC PROC[alpha: Byte, n: CARDINAL] =
BEGIN -- puts out call via system transfer vector
Stack.DeleteToMark[];
P5U.Out1[FOpCodes.qKFCB, alpha];
Stack.Incr[n];
END;

Wait: PUBLIC PROC[node: Tree.Index] =
BEGIN OPEN FOpCodes;
retry: LabelCCIndex;
t1Long: BOOL = P5U.LongTreeAddress[tb[node].son[1]];
t2Long: BOOL = P5U.LongTreeAddress[tb[node].son[2]];
longWait: BOOL = t1Long OR t2Long;
[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
IF ~t1Long AND t2Long THEN P5U.Out0[qLP];
[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
IF ~longWait THEN
BEGIN 
P5U.Out0[qDUP]; P5U.Out1[qR,1];  -- load timeout 
P5U.Out0[qMXW];
END 
ELSE
BEGIN
IF ~t2Long THEN P5U.Out0[qLP];
[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
P5U.Out1[IF t2Long THEN qRL ELSE qR, 1];
P5U.Out0[qMXWL];
END;
retry _ P5U.CreateLabel[];
[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
IF longWait AND ~t1Long THEN P5U.Out0[qLP];
[] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[tb[node].son[2]]]];
IF longWait AND ~t2Long THEN P5U.Out0[qLP];
P5U.Out0[IF longWait THEN qMREL ELSE qMRE];
CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
P5U.Out1[FOpCodes.qLI, 0];
P5U.OutJump[JumpE, retry];
END;

ForkExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
Stack.Dump[]; Stack.Mark[];
[] _ PushParms[tb[node].attr1, tb[node].son[2], ptsei, FALSE];
P5.PushRhs[tb[node].son[1]];
SysCall[PrincOps.sFork];
CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
Stack.Incr[1];
RETURN[P5L.TOSLex[1]]
END;

SJoin: PUBLIC PROC[node: Tree.Index] RETURNS[nrets: CARDINAL] =
BEGIN
ptsei: CSEIndex = P5U.OperandType[tb[node].son[1]];
Stack.Dump[]; Stack.Mark[];
P5.PushRhs[tb[node].son[1]];
SysCall[PrincOps.sJoin];
IF tb[node].nSons > 2 THEN
BEGIN
saveCfSize: CARDINAL = CPtr.cfSize;
saveCfsi: CARDINAL = CPtr.cfsi;
cr: CodeCCIndex;
aroundlabel, firstcatch: LabelCCIndex;
aroundlabel _ P5U.LabelAlloc[];  firstcatch _ P5U.LabelAlloc[];
CPtr.catchcount _ CPtr.catchcount + 1;
P5U.Out1[FOpCodes.qCATCH, 0];
cr _ LOOPHOLE[CPtr.codeptr, CodeCCIndex];
P5U.OutJump[JumpA, aroundlabel];
P5U.InsertLabel[firstcatch];
P5.SCatchPhrase[TreeOps.GetNode[tb[node].son[3]]];
cb[cr].parameters[1] _ CPtr.cfsi;
P5U.InsertLabel[aroundlabel];
CPtr.catchcount _ CPtr.catchcount - 1;

Stack.Incr[1];
P5U.Out0[FOpCodes.qSFC];

aroundlabel _ P5U.LabelAlloc[];
P5U.Out1[FOpCodes.qCATCH, CPtr.cfsi];
P5U.OutJump[JumpA, aroundlabel];
P5U.OutJump[Jump, firstcatch];
P5U.InsertLabel[aroundlabel];
CPtr.cfSize _ saveCfSize;  CPtr.cfsi _ saveCfsi;
END 
ELSE
BEGIN
CallCatch[Tree.Null];
Stack.Incr[1];
P5U.Out0[FOpCodes.qSFC];
CallCatch[Tree.Null];
END;
RETURN[P5U.WordsForSei[SymbolOps.TransferTypes[ptsei].typeOut]]
END;

JoinExp: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
nrets: CARDINAL = SJoin[node];
RETURN[PRetLex[nrets, node, FALSE]]
END;

Join: PUBLIC PROC[node: Tree.Index] = {[] _ SJoin[node]};

Unlock: PUBLIC PROC[node: Tree.Index] =
BEGIN
mlock: Tree.Link = tb[node].son[1];
IF mlock # Tree.Null THEN
BEGIN 
long: BOOL = P5L.LoadAddress[P5L.VarForLex[P5.Exp[mlock]]]; 
P5U.Out0[IF long THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD]; 
END;
END;

ProcCheck: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] =
BEGIN
Stack.Dump[]; Stack.Mark[];
P5.PushRhs[tb[node].son[1]];
SysCallN[RTSD.sProcCheck, 1];
RETURN[P5L.TOSLex[1]]
END;

PRetLex: PUBLIC PROC[nrets: CARDINAL, node: Tree.Index, sig: BOOL_FALSE]
RETURNS[Lexeme] =
BEGIN
IF nrets > MaxParmsInStack OR sig AND nrets > 1 THEN
BEGIN
Stack.Incr[1];
RETURN[IndirectReturnRecord[node, nrets]]
END
ELSE
BEGIN
Stack.Incr[nrets];
RETURN[P5L.TOSLex[nrets]]
END
END;

Free: PUBLIC PROC[node: Tree.Index] =
BEGIN
countedVar: BOOL = tb[node].attr1;
counted: BOOL = tb[node].attr3;
zoneLink: Tree.Link = tb[node].son[1];
varLink: Tree.Link = tb[node].son[2];
catchLink: Tree.Link = IF tb[node].nSons > 3 THEN tb[node].son[4] ELSE Tree.Null;
r: VarIndex _ P5L.VarForLex[P5.Exp[varLink]];
IF counted THEN Counting.Free[r, countedVar, zoneLink, catchLink]
ELSE
BEGIN
rr: VarIndex;
pLength: CARDINAL = P5U.WordsForOperand[varLink];
c0: VarIndex _ P5L.OVarItem[[wSize: pLength, space: const[d1:0, d2:0]]];
long: BOOL = tb[node].attr2;
bor: BoVarIndex _ P5L.MakeBo[r];

PushVar: PROC =
BEGIN
P5L.LoadVar[bor]; [] _ P5L.VarVarAssign[rr, c0, FALSE];
END;

cb[bor].base _ P5L.EasilyLoadable[cb[bor].base, load];
rr _ P5L.CopyVarItem[bor];
ZoneOp[zoneLink, 1, PushVar, catchLink, long];
END;
END;

ZoneOp: PUBLIC PROC[
zone: Tree.Link, index: CARDINAL, pushArg: PROC, catch: Tree.Link, long: BOOL] =
BEGIN
z, zCopy: VarIndex;
z _ P5L.VarForLex[P5.Exp[zone]];
[first: z, next: zCopy] _ P5L.ReusableCopies[z, load, FALSE];
Stack.Dump[];  Stack.Mark[];
P5L.LoadVar[z];
pushArg[];
P5L.LoadVar[zCopy];
IF long THEN {P5U.Out1[FOpCodes.qRDL, 0]; P5U.Out1[FOpCodes.qRL, index]}
ELSE {P5U.Out1[FOpCodes.qR, 0]; P5U.Out1[FOpCodes.qR, index]};
Stack.DeleteToMark[];  Stack.Incr[1];
P5U.Out0[FOpCodes.qSFC];
CallCatch[catch];
END;

END.


ϊCalls.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, September 18, 1980  2:56 PM
Satterthwaite, March 27, 1986 9:31:07 am PST
Maxwell, August 11, 1983 9:02 am
Paul Rovner, November 14, 1983 8:37 am
Russ Atkinson (RRA) March 6, 1985 11:12:07 pm PST
imported definitions
parameter, i.e., no list node, since the call node
then contains a pointer to the safen which we free
Therefore, we test below for safen.
SysCall[IF MPtr.switches['c] THEN RTSD.sFork ELSE PrincOps.sFork];
Κ˜
codeš
œ
™
Kšœ
Οm
œ1™<Kš
œ"™"Kš
œ,™,K™ K™&K™1—K˜š
Οk	˜	Kšœžœ˜Kšœžœ˜KšœžœT˜^šœ	žœK˜YK˜:—Kšœžœ˜$Kšœ	žœ˜Kšœ	žœ’
˜°
Kšœžœ˜Kšœžœ˜Kšœžœj˜rKšœžœ·
˜ΐ
Kšœžœ˜
Kšœžœβ
˜λ
Kšœ	žœ¦
˜΄
Kšžœ
žœ˜Kšœžœ8˜CKšœ
žœV˜eKšœžœ“
˜ 
Kšœžœ%˜/Kšœžœ;˜HK˜—šœž˜Kšžœa˜hKšžœžœ
˜0K˜Kš
œ™K˜Kšœ
žœ˜+K˜Kšœžœ˜&Kšœ
žœ˜"K˜$Kšœžœ˜*Kšœ
žœ˜"Kšœ
žœ˜"Kšœ
žœ˜"K˜Kšœžœ˜,K˜K˜KšœΟc˜)KšœŸ#˜7KšœŸ"˜7KšœŸ˜2KšœŸ˜-K˜šœ
žœ˜$KšžœŸ6˜=K˜K˜K˜K˜K˜Kšžœ
˜K˜—šΟnœžœ
žœ˜Kš
ž˜K˜K˜ K˜K˜!Kšžœ
˜K˜K˜—š 	œžœ
žœžœ
˜:Kš
ž˜Kšœžœ"˜1K˜K˜ K˜K˜!Kšžœžœ˜"Kšžœ
˜K˜K˜—š œžœ
žœžœ
˜7Kšžœ
Ÿ˜K˜Kšžœžœ˜2Kšžœ˜"K˜Kšœ
žœžœžœ˜EK˜Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœžœ˜9Kš
ž˜K˜3K˜Kšœ7žœ˜>K˜K˜Kšœ
žœžœžœ˜EKšžœ9˜?Kšžœ
˜K˜—Kš œžœ
žœ)˜;K˜š œžœ
žœžœ
˜9Kš
ž˜Kšœžœ˜Kšžœžœ˜#Kšžœ
˜K˜—š œžœ
žœ˜(Kš
ž˜K˜K˜K˜Kšœ
žœžœžœ˜EKšžœ
˜K˜K˜—š œžœ
žœ˜&Kšžœ
žœ
˜Kšžœžœ
žœ˜9K˜5Kšžœ
˜K˜K˜—š 	œžœ
žœ˜&Kš
ž˜Kšžœžœ#˜8Kšžœ˜ Kšžœ
˜K˜—š 
œžœ˜'Kš
ž˜šžœž˜Kš
ž˜K˜(K˜%K˜K˜K˜Kšžœ
˜—Kšžœ
˜K˜K˜—š œžœžœžœ˜8Kšžœ
Ÿ.˜4Kšžœ
˜K˜3Kšœ
žœ&˜4Kšœžœ
˜Kšœžœ
˜K˜Kšœžœ
˜šžœžœ
ž˜ ˜	Kš
ž˜K˜Kšœžœ˜5K˜9Kšžœ
˜—Kšžœžœžœ˜7—Kšžœ
žœ˜"K˜
Kšœ;žœ˜Bšžœžœ
˜Kš
ž˜K˜:K˜K˜<Kšžœ
˜—šžœ
žœž˜šžœ
žœ
˜Kš
ž˜K˜=K˜$K˜#Kš
ž˜—š
ž˜Kš
ž˜K˜K˜$K˜Kš
ž˜——š
ž˜Kš
ž˜KšœŸ-˜Cšžœžœ
˜Kš
ž˜K˜ šžœžœž˜1K˜"—Kšžœ)˜-Kš
ž˜—šžœ
žœ
ž˜Kš
ž˜K˜/K˜#Kš
ž˜—šžœ
žœž˜K˜8—Kšžœ)˜-Kšžœ
˜—K˜@šžœžœ
˜Kšœ
žœžœ2˜M—Kšžœžœžœžœ˜JKš
ž˜Kšžœ
˜K˜—š œžœ
žœ*˜GKšžœ
žœ˜K˜$K˜Kšœ
žœžœ
˜K˜š œžœžœ˜3Kš
ž˜šžœž˜˜Kš
ž˜K˜&šžœ
žœž˜#šžœ
Ÿ/˜5Kš
œ2™2Kš
œ2™2Kš
œ#™#—K˜K˜5Kš
ž˜—š
ž˜Kš
ž˜K˜5K˜&K˜ K˜K˜Kšžœ
˜—Kšœžœ
˜Kšžœ
˜—˜KšžœŸ&˜-K˜&Kšžœžœžœž˜CKšžœ@˜DK˜Kšžœ
˜—˜Kš
ž˜K˜&K˜+K˜Kšžœ
˜—šžœ˜
Kšžœžœ
žœ
˜"——Kš
ž˜Kšžœ
˜K˜—š œžœ˜Kš
ž˜šžœž˜šžœ.ž˜7K˜Kš
ž˜——šžœ
žœž˜$Kš
ž˜K˜%Kšœžœ=˜LK˜Kšžœžœžœ
žœ
˜(Kšžœžœžœ
˜EKš
ž˜—Kšžœ˜K˜)Kšžœ
˜K˜—šžœž˜!˜Kš
ž˜K˜+K˜ K˜!Kšžœ
˜—K˜.Kšžœ˜—Kšžœ
˜K˜—š
 œžœžœžœžœ˜GKšžœ
Ÿ"˜(K˜3Kšœžœ
˜š
œžœ
žœ
žœ
žœ
žœ
žœ	˜+K˜)K˜(—K˜Kšžœžœ˜6Kšžœ˜!Kšœ;žœ˜AK˜"K˜@Kšœ
žœžœžœ˜EKš
ž˜Kšžœ
˜K˜—š œžœ
žœ˜-Kšžœ
Ÿ'˜-K˜3Kšœžœ
˜Kšœžœ˜!Kšžœžœžœ žœ˜KK˜Kšžœžœ˜6Kšžœ˜!Kšœžœžœ˜8šžœž˜Kš
ž˜K˜
K˜K˜Kšžœ
˜—šžœžœŸ˜*Kš
ž˜Kšœžœžœžœ˜EK˜Kš
ž˜—Kšžœ	žœžœžœ˜VK˜!Kšžœ
˜K˜—š 
œžœ˜ Kš
ž˜Kšœžœžœ˜Kšœ	žœ˜Kšœ	žœ
˜K˜K˜š 
œžœ˜ Kš
ž˜šžœ
ž˜Kš
ž˜šœžœžœ
ž˜$K˜Kšžœ˜#—K˜Kš
ž˜—Kšžœ˜Kšžœ
˜K˜—K˜ Kšžœ
žœ
žœ
˜K˜,Kšžœ
žœžœ˜BK˜#Kšœžœ
˜K˜K˜Kš
žœžœ
žœžœ!žœ
˜KKšžœ
˜K˜K˜—š 	œžœžœ)žœ˜NKšžœ	žœ˜Kš
ž˜K˜<šžœ
žœ
˜Kšžœ žœ
˜*Kšžœ!žœ˜,—Kšžœ
˜K˜—š œžœ
žœ6žœ
˜VKšžœ	žœ˜Kš
ž˜Kšœ	žœžœžœ˜Dšžœžœ	žœ
ž˜;K˜B—Kš
žœ
žœžœžœžœ˜CKšžœ
žœžœ˜2Kš
ž˜Kšžœ
˜K˜—š 
œžœ
žœ6žœ
˜UKšžœ	žœ˜Kš
ž˜Kšœ
žœ
˜Kšœ
žœžœ
˜Kšœ	žœžœžœ˜DKšœ%žœ	žœ˜Ašžœž˜Kš
ž˜K˜
˜šžœžœ
ž˜!Kšœžœžœžœ˜,—Kšžœ
žœžœ
˜—šžœ
žœ
ž˜K˜!˜Kš
ž˜K˜$K˜K˜Kšœžœ ˜,šžœž˜#K˜(—K˜/K˜K˜K˜KKšœ4žœ˜;K˜Kšžœ
˜—Kšžœ˜—Kš
ž˜—Kšžœ
žœžœžœ˜5Kš
ž˜Kšžœ
˜K˜K˜—Kš œžœ
žœ(˜9K˜š œžœ
žœ˜'Kš
ž˜Kšœžœ˜&K˜Kšžœžœ"˜/Kšžœ
˜K˜—š œžœ
žœžœ
˜8Kš
ž˜Kšœžœ˜Kšžœžœ˜$Kšžœ
˜K˜—Kšœ
žœ
žœžœ
žœžœ
˜QK˜š œžœ
žœžœ
˜DKšžœ
˜Kšžœ
Ÿ˜ Kšžœ
˜K˜Kšœžœ
˜
Kšœžœ˜5šžœ	ž˜Kš
ž˜K˜K˜K˜K˜K˜K˜*K˜K˜K˜Kšžœ˜Kšžœ
˜—šžœž˜Kš
ž˜K˜KšœŸ&˜8Kšžœ
˜—Kšžœžœ˜$Kšžœ
˜K˜—š œžœ
žœžœ
˜7Kš
ž˜Kšœžœžœ˜'Kšžœžœ˜"Kšžœ
˜K˜—š œžœ
žœžœ
˜7Kš
ž˜Kšœžœ"˜1Kšœžœ˜K˜!Kšžœžœ˜"Kšžœ
˜K˜—š œžœ
žœ˜#Kšžœ
Ÿ+˜1K˜K˜ Kšžœ
˜K˜—š œžœ
žœžœ˜1Kšžœ
Ÿ+˜1K˜K˜ K˜Kšžœ
˜K˜—š œžœ
žœ˜%Kšžœ
žœ
˜K˜Kšœžœ(˜4Kšœžœ(˜4Kšœ
žœ
žœ˜"K˜=Kšžœ	žœžœ˜)K˜=šžœž˜Kšžœ
˜Kšœ!Ÿ˜1K˜Kšžœ
˜—š
ž˜Kš
ž˜Kšžœ	žœ˜K˜=Kšœ	žœžœžœ˜(K˜Kšžœ
˜—K˜K˜=Kšžœ
žœ	žœ˜+K˜=Kšžœ
žœ	žœ˜+Kšœ	žœ
žœžœ˜+Kšœ
žœžœžœ˜EK˜K˜Kšžœ
˜K˜—š œžœ
žœžœ
˜8Kš
ž˜K˜3K˜Kšœ7žœ˜>K˜Kš
œ˜Kš	œžœžœ
žœžœ™BKšœ
žœžœžœ˜EK˜Kšžœ˜Kšžœ
˜K˜—š
 œžœ
žœžœžœ˜?Kš
ž˜K˜3K˜K˜K˜šžœž˜Kš
ž˜Kšœžœ˜#Kšœ
žœ
˜K˜K˜&K˜?K˜&K˜Kšœžœ˜)K˜ K˜K˜2K˜!K˜K˜&K˜K˜K˜K˜K˜K˜%K˜ K˜K˜K˜0Kšžœ
˜—š
ž˜Kš
ž˜K˜K˜K˜K˜Kšžœ
˜—Kšžœ9˜?Kšžœ
˜K˜—š œžœ
žœžœ
˜8Kš
ž˜Kšœžœ˜Kšžœžœ˜#Kšžœ
˜K˜—Kš œžœ
žœ(˜9K˜š œžœ
žœ˜'Kš
ž˜K˜#šžœž˜Kšžœ
˜Kšœžœ2˜<Kšœ	žœžœžœ˜:Kšžœ
˜—Kšžœ
˜K˜—š 	œžœ
žœžœ
˜:Kš
ž˜K˜K˜Kšœ	žœ˜Kšžœ˜Kšžœ
˜K˜—š œžœ
žœžœžœ
žœ
˜HKšžœ
˜Kš
ž˜šžœžœžœž˜4Kš
ž˜K˜Kšžœ#˜)Kš
ž˜—š
ž˜Kš
ž˜K˜Kšžœ˜Kš
ž˜—Kšžœ
˜K˜—š œžœ
žœ˜%Kš
ž˜Kšœžœ˜"Kšœ	žœ˜K˜&K˜%Kšœžœžœžœ˜QK˜-Kšžœ	žœ2˜Aš
ž˜Kš
ž˜K˜
Kšœ	žœ ˜1K˜HKšœžœ˜K˜ K˜š œžœ˜Kš
ž˜Kšœ0žœ˜7Kšžœ
˜K˜—K˜6K˜K˜.Kšžœ
˜—Kšžœ
˜K˜—š œžœ
žœ
˜Kšœžœžœžœ˜PKš
ž˜K˜K˜ Kšœ6žœ˜=K˜K˜K˜
K˜Kšžœžœ<˜HKšžœ:˜>K˜%K˜K˜Kšžœ
˜K˜—Kšžœ
˜K˜——…—Ld