-- Calls.mesa
-- last modified by Sweet, September 18, 1980 2:56 PM
-- last modified by Satterthwaite, March 21, 1983 9:33 am
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [
actenable, catchcount, cfsi, cfSize, CodePassInconsistency, codeptr, substenable],
CodeDefs: TYPE USING [
Base, BoVarIndex, Byte, CodeCCIndex, codeType, LabelCCIndex, LabelCCNull,
Lexeme, MaxParmsInStack, NullLex, VarComponent, VarIndex],
ComData: TYPE USING [bodyIndex, stopping, switches],
Counting: TYPE USING [CheckArgRefs, Free],
Environment: TYPE USING [bitsPerWord],
FOpCodes: TYPE 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: TYPE USING [Error, Warning],
OpTableDefs: TYPE USING [InstLength],
P5: TYPE USING [
CatchPhrase, Exp, GenTempLex, PushLex, PushRhs, ReleaseLock,
SAssign, SCatchPhrase, TransferConstruct],
P5L: TYPE USING [
CopyToTemp, CopyVarItem, EasilyLoadable, GenVarItem, LoadAddress,
LoadComponent, LoadVar, MakeBo, OVarItem, ReusableCopies, TOSAddrLex,
TOSLex, ReleaseLex, VarForLex, VarVarAssign],
P5S: TYPE USING [],
P5U: TYPE USING [
AllocCodeCCItem, BitsForOperand, BitsForType, ComputeFrameSize,
CreateLabel, InsertLabel, LabelAlloc, LongTreeAddress, NextVar,
OperandType, Out0, Out1, OutJump, PushLitVal,
TreeLiteralValue, WordsForOperand, WordsForSei],
PrincOps: TYPE USING [AllocationVectorSize, returnOffset],
RTSD: TYPE USING [sFork, sProcCheck],
SDDefs: TYPE USING [
sCopy, sError, sErrorList, sFork, sJoin, sRestart, sReturnError,
sReturnErrorList, sSignal, sSignalList, sStart, sUnnamedError],
Stack: TYPE USING [DeleteToMark, Dump, Incr, Load, Mark, TempStore, Top],
SymbolOps: TYPE USING [
FindExtension, FirstCtxSe, NextSe, TransferTypes, WordsForType, XferMode],
Symbols: TYPE USING [
Base, BitAddress, bodyType, CBTIndex, CBTNull, ContextLevel, CSEIndex,
CTXIndex, ctxType, ISEIndex, lG, RecordSEIndex, SEIndex, SENull, seType],
Tree: TYPE USING [Base, Index, Link, Null, treeType],
TreeOps: TYPE 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;
-- imported definitions
bitsPerWord: CARDINAL = Environment.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[SDDefs.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[SDDefs.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[SDDefs.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[SDDefs.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[SDDefs.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 ← ctxb[seb[sei].idCtx].level # 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, ~portcall];
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
-- 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.
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;
cast, pad =>
BEGIN
node: Tree.Index = TreeOps.GetNode[t];
tb[node].son[1] ← DoSafen[tb[node].son[1]];
v ← t;
END;
ENDCASE => -- dont unroll nested constructors
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 = [
[SDDefs.sSignal, SDDefs.sSignalList],
[SDDefs.sError, SDDefs.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, FALSE];
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 SDDefs.sErrorList ELSE SDDefs.sError];
ChainCatch[CPtr.substenable];
END
ELSE SysCall[IF nparms > 1 THEN SDDefs.sReturnErrorList ELSE SDDefs.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, refSafe: BOOL←TRUE]
RETURNS [nparms: CARDINAL] =
BEGIN
rsei: RecordSEIndex = SymbolOps.TransferTypes[ptsei].typeIn;
RETURN [IF argsBuilt
THEN PushArgRecord[t, rsei, sigerr, FALSE, refSafe]
ELSE BuildArgRecord[t, rsei, sigerr, FALSE, refSafe]]
END;
BuildArgRecord: PUBLIC PROC [
t: Tree.Link, rsei: RecordSEIndex, sigerr, isResume, refSafe: 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
BEGIN
IF ~(refSafe OR Counting.CheckArgRefs[t, rsei]) THEN Log.Warning[unsafeArgs];
P5.TransferConstruct[nparms, bb[MPtr.bodyIndex].resident, t, rsei];
END
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, refSafe: 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;
refSafe ← refSafe OR Counting.CheckArgRefs[t, rsei];
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;
IF ~refSafe THEN Log.Warning[unsafeArgs];
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, FALSE];
P5.PushRhs[tb[node].son[1]];
SysCall[IF MPtr.switches['c] THEN RTSD.sFork ELSE SDDefs.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[SDDefs.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.