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;
imported definitions
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
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;
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];
SysCall[IF MPtr.switches['c] THEN RTSD.sFork ELSE 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.