-- Statement.mesa, modified by Sweet, November 18, 1979 12:00 AM
DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE, wordlength],
Code: FROM "code" USING [
actenable, caseCVState, catchcount, catchoutrecord, cfs,
CodeNotImplemented, codeptr, curctxlvl, dStar, fileindex, framesz,
inlineFileIndex, mwCaseCV, StackNotEmptyAtStatement, xtracting],
CodeDefs: FROM "codedefs" USING [
CaseCVState, CCIndex, CCItem, CodeCCIndex, EXLRIndex, JumpCCNull,
JumpType, LabelCCIndex, LabelCCNull, Lexeme, NULLfileindex, NullLex,
OtherCCIndex, StackIndex, TempStateRecord, VarComponent, VarIndex,
VarNull],
ComData: FROM "comdata" USING [bodyIndex, switches, textIndex],
ControlDefs: FROM "controldefs" USING [AllocationVectorSize, localbase],
FOpCodes: FROM "fopcodes" USING [
qBCAST, qBCASTL, qBNDCK, qCATCH, qDADD, qDCOMP, qDEC, qDST, qDSUB,
qDUCOMP, qINC, qLL, qLP, qLST, qLSTF, qNOOP, qNOTIFY, qNOTIFYL, qPUSH,
qRET, qSL],
Log: FROM "log" USING [Error],
P5: FROM "p5" USING [
Exp, FlowTree, GenAnonLex, GenHeapLex, GetLabelMark, LabelCreate,
LabelList, LogHeapFree, MakeExitLabel, P5Error, PopInVals, PopLabels,
PopTempState, PurgeHeapList, PurgePendTempList, PushHeapList, PushLex,
PushRhs, PushTempState, ReleaseTempLex, SAssign, SysError, TTAssign],
P5L: FROM "p5l" USING [
CopyToTemp, LoadAddress, LoadVar, MakeComponent, NormalizeExp, NormalLex,
OVarItem, ReleaseLex, VarForLex],
P5S: FROM "p5s" USING [
Assign, Call, CatchMark, Continue, Exit, Extract, GoTo, Join, Label, Lock,
Loop, ProcInit, Restart, Result, Resume, Retry, Return, RetWithError,
SigErr, Start, Stop, Subst, Unlock, Wait],
P5U: FROM "p5u" USING [
CCellAlloc, ComputeFrameSize, CreateLabel, EnumerateCaseArms, FreeChunk,
InsertLabel, LabelAlloc, Out0, Out1, OutJump, PushLitVal, TreeLiteral,
TreeLiteralValue, WordsForOperand],
Stack: FROM "stack" USING [
Clear, Decr, Depth, Dump, Incr, Mark, New, Off, On, Pop, Require, Reset,
ResetToMark, Restore, UnMark],
SymbolOps: FROM "symbolops" USING [WordsForType],
Symbols: FROM "symbols" USING [
bodyType, BTIndex, ContextLevel, CTXIndex, CTXNull, ctxType, HTIndex,
ISEIndex, ISENull, RecordSEIndex, RecordSENull, SEIndex, SENull, SERecord,
seType],
SymbolSegment: FROM "symbolsegment" USING [ByteIndex],
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
Table: FROM "table" USING [Base, Limit, Notifier],
Tree: FROM "tree" USING [Index, Link, NodeName, Null, treeType],
TreeOps: FROM "treeops" USING [
FreeTree, ListLength, ReverseUpdateList, ScanList, SetShared, UpdateList];
Statement: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, P5U, CodeDefs, P5L, P5, P5S,
Stack, SymbolOps, SystemDefs, TreeOps, Log
EXPORTS CodeDefs, P5 =
BEGIN
OPEN FOpCodes, CodeDefs;
-- imported definitions
BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;
ContextLevel: TYPE = Symbols.ContextLevel;
CTXIndex: TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
SEIndex: TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
BTIndex: TYPE = Symbols.BTIndex;
tb: Table.Base; -- tree base (local copy)
seb: Table.Base; -- semantic entry base (local copy)
ctxb: Table.Base; -- context entry base (local copy)
cb: Table.Base; -- code base (local copy)
bb: Table.Base; -- body base (local copy)
StatementNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
cb ← tb ← base[Tree.treeType];
bb ← base[Symbols.bodyType];
RETURN
END;
CatchFrameTooLarge: SIGNAL = CODE;
recentStmt: PUBLIC Tree.Link; -- for debugging
StatementTree: PUBLIC PROCEDURE [t: Tree.Link] RETURNS[Tree.Link] =
BEGIN -- generates code for Mesa statements
node: Tree.Index;
savheaplist: ISEIndex;
saveIndex: CARDINAL = MPtr.textIndex;
recentStmt ← t;
IF t = Tree.Null THEN RETURN[Tree.Null];
BEGIN
ENABLE
BEGIN
P5.LogHeapFree => RESUME[TRUE, P5.GenHeapLex[]];
CPtr.CodeNotImplemented => IF ~MPtr.switches['d] THEN
GO TO unimplementedConstruct
END;
savheaplist ← P5.PushHeapList[];
WITH t SELECT FROM
subtree =>
BEGIN
fIndex: SymbolSegment.ByteIndex ← CPtr.inlineFileIndex;
node ← index;
IF fIndex = NULLfileindex THEN fIndex ← tb[node].info;
CPtr.fileindex ← MPtr.textIndex ← fIndex;
IF ~CPtr.xtracting AND Stack.Depth[] # 0 THEN
BEGIN SIGNAL CPtr.StackNotEmptyAtStatement; Stack.Clear[]; END;
SELECT tb[node].name FROM
block => Block[node];
start => P5S.Start[node];
restart => P5S.Restart[node];
stop => P5S.Stop[node];
dst => DumpState[node];
lst => LoadState[node];
lstf => LoadStateFree[node];
call, portcall => P5S.Call[node];
signal,error => P5S.SigErr[node];
syserror => P5.SysError[];
label => P5S.Label[node];
assign => P5S.Assign[node];
extract => P5S.Extract[node];
if => IfStmt[node];
case => [] ← CaseStmtExp[node, FALSE];
do => DoStmt[node];
exit => P5S.Exit[];
loop => P5S.Loop[];
retry => P5S.Retry[];
continue => P5S.Continue[];
goto => P5S.GoTo[node];
catchmark => P5S.CatchMark[node];
return => P5S.Return[node];
resume => P5S.Resume[node];
result => P5S.Result[node];
open => Open[node];
enable => Enable[node];
procinit => P5S.ProcInit[node];
wait => P5S.Wait[node];
notify => Notify[node];
broadcast => Broadcast[node];
join => P5S.Join[node];
unlock => P5S.Unlock[node];
lock => P5S.Lock[node];
subst => P5S.Subst[node];
xerror => P5S.RetWithError[node];
null => NULL;
list => t ← TreeOps.UpdateList[t, StatementTree];
ENDCASE => GO TO unimplementedConstruct;
END;
ENDCASE;
P5.PurgeHeapList[savheaplist];
P5.PurgePendTempList[];
EXITS
unimplementedConstruct =>
BEGIN
Log.Error[unimplemented];
Stack.Clear[];
END;
END;
MPtr.textIndex ← saveIndex;
[] ← TreeOps.FreeTree[t];
RETURN[Tree.Null]
END;
Open: PROCEDURE [node: Tree.Index] =
BEGIN
OPEN TreeOps;
sCopen: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
BEGIN
SetShared[t, FALSE];
RETURN[FreeTree[t]]
END;
tb[node].son[2] ← StatementTree[tb[node].son[2]];
tb[node].son[1] ← ReverseUpdateList[tb[node].son[1], sCopen];
RETURN
END;
DumpState: PROCEDURE [node: Tree.Index] =
BEGIN -- generates dumpstate
DLState[node, qDST];
RETURN
END;
LoadState: PROCEDURE [node: Tree.Index] =
BEGIN -- generates loadstate
DLState[node, qLST];
RETURN
END;
LoadStateFree: PROCEDURE [node: Tree.Index] =
BEGIN -- generates loadstateandfree
DLState[node, qLSTF];
P5U.OutJump[JumpRet, LabelCCNull];
RETURN
END;
InvalidStateStorageLocation: SIGNAL = CODE;
DLState: PROCEDURE [node: Tree.Index, opc: BYTE] =
BEGIN -- does state move after checking for small currentcontext address
var: VarComponent;
var ← P5L.MakeComponent[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
WITH var SELECT FROM
frame => IF level = CPtr.curctxlvl AND wd IN BYTE THEN
BEGIN
P5U.Out1[opc, wd];
RETURN
END;
ENDCASE;
SIGNAL InvalidStateStorageLocation;
END;
Block: PROCEDURE [node: Tree.Index] =
BEGIN
bti: BTIndex ← tb[node].info;
WITH bb[bti].info SELECT FROM
Internal => IF CPtr.inlineFileIndex = NULLfileindex THEN
CPtr.fileindex ← MPtr.textIndex ← sourceIndex
ELSE sourceIndex ← CPtr.inlineFileIndex;
ENDCASE;
P5U.CCellAlloc[other];
cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody ←
startbody[index: bti];
tb[node].son[1] ← TreeOps.UpdateList[tb[node].son[1], StatementTree];
tb[node].son[2] ← TreeOps.UpdateList[tb[node].son[2], StatementTree];
P5U.CCellAlloc[other];
cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody ←
endbody[index: bti];
END;
IfStmt: PROCEDURE [node: Tree.Index] =
BEGIN -- generates code for an IF statement
ilabel,elabel: LabelCCIndex;
elabel←P5U.LabelAlloc[];
P5.FlowTree[tb[node].son[1], FALSE, elabel];
tb[node].son[2] ← StatementTree[tb[node].son[2]];
IF tb[node].son[3] # Tree.Null THEN
BEGIN
P5U.OutJump[Jump, ilabel←P5U.LabelAlloc[]];
P5U.InsertLabel[elabel];
tb[node].son[3] ← StatementTree[tb[node].son[3]];
P5U.InsertLabel[ilabel];
END
ELSE P5U.InsertLabel[elabel];
RETURN
END;
CaseStmtExp: PUBLIC PROCEDURE [node: Tree.Index, iscasexp: BOOLEAN] RETURNS [Lexeme] =
BEGIN -- generate code for CASE statment and expression
caseEndLabel: LabelCCIndex ← P5U.LabelAlloc[];
caseLPEndLabel: LabelCCIndex ← P5U.LabelAlloc[];
cvSize: CARDINAL ← P5U.WordsForOperand[tb[node].son[1]];
nwords: CARDINAL ←
IF iscasexp THEN SymbolOps.WordsForType[tb[node].info] ELSE 0;
savemwCaseCV: Lexeme ← CPtr.mwCaseCV;
savextracting: BOOLEAN ← CPtr.xtracting;
savecaseCVState: CaseCVState ← CPtr.caseCVState;
allConst: BOOLEAN;
CheckConst: PROCEDURE [t: Tree.Link] =
BEGIN
allConst ← allConst AND P5U.TreeLiteral[t];
END;
longExpValue: BOOLEAN;
cvtlex: se Lexeme ← NullLex;
valTsei: ISEIndex ← ISENull;
sCitem: PROCEDURE [t: Tree.Link] =
BEGIN
faillabel: LabelCCIndex = P5U.LabelAlloc[];
longx: BOOLEAN ← FALSE;
r: VarIndex;
WITH t SELECT FROM
subtree => [r, valTsei] ← CaseItem[index, iscasexp,
FALSE, valTsei, faillabel];
ENDCASE;
IF iscasexp THEN
BEGIN
[long: longx, tsei: valTsei] ← P5L.NormalizeExp[r, valTsei, allConst];
Stack.ResetToMark[];
END;
P5U.OutJump[Jump, IF longx THEN caseLPEndLabel ELSE caseEndLabel];
P5U.InsertLabel[faillabel];
RETURN
END;
cvr: VarIndex;
CPtr.xtracting ← FALSE;
IF ~CPtr.dStar THEN Stack.Dump[];
cvr ← P5L.VarForLex[P5.Exp[tb[node].son[1]]];
IF iscasexp THEN
BEGIN
Stack.Mark[];
allConst ← TRUE;
P5U.EnumerateCaseArms[node, CheckConst];
END;
IF cvSize = 1 THEN
BEGIN
P5L.LoadVar[cvr];
CPtr.caseCVState ← singleLoaded;
END
ELSE
BEGIN
cvtlex ← P5.GenAnonLex[cvSize];
CPtr.mwCaseCV ←
[bdo[P5L.OVarItem[P5L.CopyToTemp[cvr, cvtlex.lexsei].var]]];
CPtr.caseCVState ← multi;
END;
BEGIN ENABLE
P5.LogHeapFree => IF iscasexp THEN RESUME[FALSE, NullLex];
TreeOps.ScanList[tb[node].son[2], sCitem];
IF iscasexp THEN
BEGIN
r: VarIndex ← P5L.VarForLex[P5.Exp[tb[node].son[3]]];
long: BOOLEAN ← P5L.NormalizeExp[r, valTsei, allConst].long;
P5U.OutJump[Jump, IF long THEN caseLPEndLabel ELSE caseEndLabel];
Stack.UnMark[];
END
ELSE tb[node].son[3] ← StatementTree[tb[node].son[3]];
END;
P5U.InsertLabel[caseEndLabel];
longExpValue ← cb[caseLPEndLabel].jumplist # JumpCCNull;
IF longExpValue THEN P5U.Out0[qLP]; -- unreachable if all arms long
P5U.InsertLabel[caseLPEndLabel];
IF cvtlex # NullLex THEN
BEGIN
P5.ReleaseTempLex[cvtlex];
P5L.ReleaseLex[CPtr.mwCaseCV];
END;
IF valTsei # ISENull THEN P5.ReleaseTempLex[[se[valTsei]]];
CPtr.mwCaseCV ← savemwCaseCV;
CPtr.caseCVState ← savecaseCVState;
CPtr.xtracting ← savextracting;
tb[node].son[1] ← TreeOps.FreeTree[tb[node].son[1]];
tb[node].son[2] ← TreeOps.FreeTree[tb[node].son[2]];
tb[node].son[3] ← TreeOps.FreeTree[tb[node].son[3]];
IF tb[node].nSons > 3 THEN TreeOps.SetShared[tb[node].son[4], FALSE];
IF iscasexp THEN RETURN [P5L.NormalLex[nwords, longExpValue, allConst]]
ELSE RETURN [NullLex];
END;
NewBranches: PROCEDURE [t: Tree.Link, itemlabel, faillabel: LabelCCIndex,
bt: DESCRIPTOR FOR ARRAY OF LabelCCIndex]
RETURNS [new: BOOLEAN] =
BEGIN -- sees if any new branches need to be added to branch table
i: CARDINAL;
snb: PROCEDURE [t: Tree.Link] =
BEGIN
i ← P5U.TreeLiteralValue[t];
IF bt[i] = faillabel THEN
BEGIN bt[i] ← itemlabel; new ← TRUE; END;
RETURN
END;
new ← FALSE;
TreeOps.ScanList[t, snb];
RETURN
END;
Branch: PROCEDURE [node: Tree.Index, isexp: BOOLEAN, tempsei: ISEIndex, faillabel: LabelCCIndex] RETURNS [r: VarIndex, tsei: ISEIndex] =
BEGIN -- generate code for case switch if range is densely packed
nwords, range, i: CARDINAL;
btcp, savcodeptr: CCIndex;
valLabel, valLPLabel: LabelCCIndex;
bt: DESCRIPTOR FOR ARRAY OF LabelCCIndex;
first: BOOLEAN ← TRUE;
allConst: BOOLEAN;
longExp: BOOLEAN;
LookForConst: PROCEDURE [t: Tree.Link] =
BEGIN
allConst ← allConst AND P5U.TreeLiteral[t];
END;
scb: PROCEDURE [t: Tree.Link] =
BEGIN
itemlabel: LabelCCIndex;
WITH t SELECT FROM
subtree =>
BEGIN -- is an item
longx: BOOLEAN ← FALSE;
bnode: Tree.Index ← index;
itemlabel ← P5U.LabelAlloc[];
IF NewBranches[tb[bnode].son[1], itemlabel, faillabel, bt] THEN
BEGIN
P5U.InsertLabel[itemlabel];
IF isexp THEN
BEGIN
longx: BOOLEAN;
tr: VarIndex;
IF first THEN first ← FALSE ELSE Stack.ResetToMark[];
tr ← P5L.VarForLex[P5.Exp[tb[bnode].son[2]]];
[nwords: nwords, long: longx, tsei: tsei] ←
P5L.NormalizeExp[tr, tsei, allConst];
END
ELSE tb[bnode].son[2] ← StatementTree[tb[bnode].son[2]];
P5U.OutJump[Jump, IF longx THEN valLPLabel ELSE valLabel];
END
ELSE P5U.FreeChunk[itemlabel, SIZE[label CCItem]];
RETURN
END;
ENDCASE
END;
tsei ← tempsei;
IF isexp THEN
BEGIN
allConst ← TRUE;
TreeOps.ScanList[tb[node].son[3], LookForConst];
END;
range ← P5U.TreeLiteralValue[tb[node].son[2]];
valLabel ← P5U.LabelAlloc[];
valLPLabel ← P5U.LabelAlloc[];
IF ~CPtr.dStar THEN
IF CPtr.caseCVState = singleLoaded THEN Stack.Require[1]
ELSE Stack.Dump[];
P5.PushRhs[tb[node].son[1]];
P5U.PushLitVal[range];
Stack.Decr[2];
P5U.CCellAlloc[other];
cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody ←
table[btab: , tablecodebytes: 3, taboffset: ];
btcp ← CPtr.codeptr;
P5U.OutJump[JumpCA, faillabel];
bt ← DESCRIPTOR[SystemDefs.AllocateHeapNode[range], range];
FOR i IN [0..range) DO bt[i] ← faillabel ENDLOOP;
TreeOps.ScanList[tb[node].son[3], scb];
savcodeptr ← CPtr.codeptr;
CPtr.codeptr ← btcp;
FOR i IN [0..range) DO P5U.OutJump[JumpC, bt[i]] ENDLOOP;
CPtr.codeptr ← savcodeptr;
P5U.InsertLabel[valLabel];
longExp ← cb[valLPLabel].jumplist # JumpCCNull;
IF longExp THEN P5U.Out0[qLP];
P5U.InsertLabel[valLPLabel];
SystemDefs.FreeHeapNode[BASE[bt]];
IF isexp THEN RETURN [
P5L.VarForLex[P5L.NormalLex[nwords, longExp, allConst]], tsei]
ELSE RETURN [VarNull, tsei];
END;
CaseItem: PROCEDURE [node: Tree.Index, isexp, isenable: BOOLEAN, tempsei: ISEIndex, faillabel: LabelCCIndex] RETURNS [r: VarIndex, tsei: ISEIndex] =
BEGIN -- generate code for a CASE item
itemlabel: LabelCCIndex;
irecord, savcatchoutrecord: RecordSEIndex;
sei: Table.Base RELATIVE POINTER [0..Table.Limit) TO transfer cons SERecord;
savinctxlevel, savoutctxlevel: ContextLevel;
ictx, octx: CTXIndex ← CTXNull;
lasson: CARDINAL;
thisson: CARDINAL ← 0;
sci: PROCEDURE [t: Tree.Link] =
BEGIN
IF thisson # lasson THEN
BEGIN
P5.FlowTree[t, TRUE, itemlabel];
thisson ← thisson+1;
END
ELSE
BEGIN
P5.FlowTree[t, FALSE, faillabel];
P5U.InsertLabel[itemlabel];
END;
RETURN
END;
tsei ← tempsei; r ← VarNull;
IF tb[node].name = caseswitch THEN
BEGIN
[r, tsei] ← Branch[node, isexp, tsei, faillabel];
RETURN
END;
WITH t1: tb[node].son[1] SELECT FROM
subtree =>
BEGIN
itemlabel ← P5U.LabelAlloc[];
IF tb[t1.index].name # list THEN lasson ← 0
ELSE lasson ← TreeOps.ListLength[t1]-1;
TreeOps.ScanList[t1, sci];
END;
ENDCASE => P5.FlowTree[t1, FALSE, faillabel];
IF isexp THEN r ← P5L.VarForLex[P5.Exp[tb[node].son[2]]]
ELSE
IF isenable THEN
BEGIN
savcatchoutrecord ← CPtr.catchoutrecord;
sei ← tb[node].info;
IF sei # SENull THEN
BEGIN
irecord ← seb[sei].inRecord;
CPtr.catchoutrecord ← seb[sei].outRecord;
IF irecord # RecordSENull THEN
BEGIN
ictx ← seb[irecord].fieldCtx;
savinctxlevel ← ctxb[ictx].level;
ctxb[ictx].level ← CPtr.curctxlvl;
END;
IF CPtr.catchoutrecord # RecordSENull THEN
BEGIN
octx ← seb[CPtr.catchoutrecord].fieldCtx;
savoutctxlevel ← ctxb[octx].level;
ctxb[octx].level ← CPtr.curctxlvl;
END;
END
ELSE irecord ← CPtr.catchoutrecord ← RecordSENull;
P5.PopInVals[irecord, TRUE];
tb[node].son[2] ← StatementTree[tb[node].son[2]];
IF ictx # CTXNull THEN ctxb[ictx].level ← savinctxlevel;
IF octx # CTXNull THEN ctxb[octx].level ← savoutctxlevel;
CPtr.catchoutrecord ← savcatchoutrecord;
END
ELSE tb[node].son[2] ← StatementTree[tb[node].son[2]];
RETURN
END;
DoStmt: PROCEDURE [rootnode: Tree.Index] =
BEGIN -- generates code for all the loop statments
steploop, tempindex, tempend, uploop, forseqloop, signed, long, bigforseq: BOOLEAN ← FALSE;
t, Sson, Eson: Tree.Link;
node, node2: Tree.Index;
inttype: Tree.NodeName;
indexlex: se Lexeme;
endlex: Lexeme;
toplabel: LabelCCIndex ← P5U.LabelAlloc[];
startlabel: LabelCCIndex;
finlabel: LabelCCIndex ← P5U.LabelAlloc[];
endlabel, looplabel: LabelCCIndex;
labelmark: EXLRIndex ← P5.GetLabelMark[];
updateCV: PROCEDURE [loadlong: BOOLEAN] =
BEGIN
IF long THEN
BEGIN
IF ~CPtr.dStar THEN
IF loadlong THEN
BEGIN Stack.Dump[]; P5.PushLex[indexlex]; END
ELSE Stack.Require[2];
P5U.PushLitVal[1]; P5U.PushLitVal[0];
P5U.Out0[IF uploop THEN qDADD ELSE qDSUB];
P5.SAssign[indexlex.lexsei];
END
ELSE P5U.Out0[IF uploop THEN qINC ELSE qDEC];
END;
-- set up for EXIT clause
[exit: endlabel, loop: looplabel] ← P5.MakeExitLabel[];
TreeOps.ScanList[tb[rootnode].son[5], P5.LabelCreate];
-- handle initialization node
t ← tb[rootnode].son[1];
WITH t SELECT FROM
subtree =>
IF t # Tree.Null THEN
BEGIN
node ← index;
SELECT tb[node].name FROM
forseq =>
BEGIN
t1: Tree.Link ← tb[node].son[1];
t2: Tree.Link ← tb[node].son[2];
WITH t1 SELECT FROM
symbol => indexlex ← [se[index]];
ENDCASE;
forseqloop ← TRUE;
bigforseq ← P5U.WordsForOperand[t1] > 2;
IF bigforseq THEN
BEGIN
P5.TTAssign[t1, t2];
P5U.InsertLabel[toplabel];
END
ELSE
BEGIN
P5.PushRhs[t2];
P5U.InsertLabel[toplabel];
P5.SAssign[indexlex.lexsei];
END;
END;
upthru, downthru =>
BEGIN
cvBound: Tree.Link = tb[node].son[3];
nonempty: BOOLEAN = tb[node].attr1;
steploop ← TRUE;
uploop ← tb[node].name = upthru;
WITH tb[node].son[2] SELECT FROM
subtree =>
BEGIN
node2 ← index;
inttype ← tb[node2].name;
IF tb[node2].attr1 THEN SIGNAL CPtr.CodeNotImplemented;
long ← tb[node2].attr2;
signed ← tb[node2].attr3;
END;
ENDCASE;
WITH tb[node].son[1] SELECT FROM
subtree => -- son1 is empty
BEGIN
indexlex ← P5.GenAnonLex[IF long THEN 2 ELSE 1];
tempindex ← TRUE;
END;
symbol => indexlex ← Lexeme[se[index]];
ENDCASE;
WITH tb[node].son[2] SELECT FROM
subtree =>
BEGIN
IF uploop THEN
BEGIN Sson ← tb[node2].son[1]; Eson ← tb[node2].son[2]; END
ELSE
BEGIN
SELECT inttype FROM
intCO => inttype ← intOC;
intOC => inttype ← intCO;
ENDCASE;
Sson ← tb[node2].son[2];
Eson ← tb[node2].son[1];
END;
WITH e: Eson SELECT FROM
literal =>
WITH e.info SELECT FROM
word => endlex ←
Lexeme[literal[word[index]]];
ENDCASE => P5.P5Error[769];
ENDCASE =>
BEGIN
P5.PushRhs[e]; tempend ← TRUE;
P5.SAssign[
(endlex ← P5.GenAnonLex[IF long THEN 2 ELSE 1]).lexsei];
END;
startlabel ← P5U.LabelAlloc[];
IF long AND ~CPtr.dStar THEN Stack.Dump[];
P5.PushRhs[Sson];
IF long THEN P5.SAssign[indexlex.lexsei];
IF (inttype = intCC OR inttype = intOO) AND ~nonempty THEN
BEGIN -- earlier passes check for empty intervals
TopTest: ARRAY BOOLEAN OF
ARRAY BOOLEAN OF ARRAY BOOLEAN OF JumpType =
[[[UJumpL,UJumpLE], -- unsigned, down, closed/open
[UJumpG,UJumpGE]], -- unsigned, up, closed/open
[[JumpL,JumpLE], -- signed, down, closed/open
[JumpG,JumpGE]]]; -- signed, up, closed/open
IF long THEN BEGIN P5U.Out0[qPUSH]; P5U.Out0[qPUSH] END;
P5.PushLex[endlex];
IF long THEN
BEGIN
P5U.Out0[IF signed THEN qDCOMP ELSE qDUCOMP];
P5U.PushLitVal[0]
END;
P5U.OutJump[
TopTest[long OR signed][uploop][inttype = intOO],
finlabel];
IF ~long THEN P5U.Out0[qPUSH];
END;
IF ~long THEN Stack.Decr[1];
P5U.OutJump[Jump, startlabel];
P5U.InsertLabel[toplabel];
IF ~long THEN P5U.Out0[qPUSH];
SELECT inttype FROM
intCC => BEGIN updateCV[TRUE]; P5U.InsertLabel[startlabel]; END;
intOC => updateCV[TRUE];
intCO, intOO => NULL;
ENDCASE;
IF ~long THEN
BEGIN
IF cvBound # Tree.Null THEN
BEGIN P5.PushRhs[cvBound]; P5U.Out0[FOpCodes.qBNDCK]; END;
P5.SAssign[indexlex.lexsei];
END;
END;
ENDCASE;
END;
ENDCASE;
END
ELSE P5U.InsertLabel[toplabel];
ENDCASE;
-- now the pre-body test
IF tb[rootnode].son[2] # Tree.Null THEN
P5.FlowTree[tb[rootnode].son[2], FALSE, finlabel];
-- ignore the opens
-- tb[node].son3;
-- now the body
tb[rootnode].son[4] ← StatementTree[tb[rootnode].son[4]];
-- now (update and) test the control variable
P5U.InsertLabel[looplabel];
IF steploop THEN
BEGIN
IF long AND (inttype = intOC OR inttype = intOO) THEN
P5U.InsertLabel[startlabel];
P5.PushLex[indexlex];
SELECT inttype FROM
intCC => NULL;
intCO => BEGIN updateCV[FALSE]; P5U.InsertLabel[startlabel]; END;
intOC => IF ~long THEN P5U.InsertLabel[startlabel];
intOO =>
BEGIN
IF ~long THEN P5U.InsertLabel[startlabel];
updateCV[FALSE];
END;
ENDCASE;
IF long THEN SELECT inttype FROM
intCO, intOO => BEGIN P5U.Out0[qPUSH]; P5U.Out0[qPUSH] END;
ENDCASE;
P5.PushLex[endlex];
IF long THEN
BEGIN
P5U.Out0[IF signed THEN qDCOMP ELSE qDUCOMP];
P5U.PushLitVal[0]
END;
P5U.OutJump[
IF ~long AND ~signed THEN
IF uploop THEN UJumpL ELSE UJumpG
ELSE IF uploop THEN JumpL ELSE JumpG, toplabel];
P5U.OutJump[Jump, finlabel];
IF tempend THEN P5.ReleaseTempLex[LOOPHOLE[endlex, se Lexeme]];
IF tempindex THEN P5.ReleaseTempLex[indexlex];
END
ELSE
BEGIN
IF forseqloop THEN
BEGIN
WITH tb[rootnode].son[1] SELECT FROM
subtree =>
BEGIN
t3: Tree.Link ← tb[index].son[3];
IF bigforseq THEN P5.TTAssign[[symbol[indexlex.lexsei]], t3]
ELSE P5.PushRhs[t3!
P5.LogHeapFree => RESUME[FALSE, NullLex]];
END;
ENDCASE;
END;
P5U.OutJump[Jump, toplabel];
END;
Stack.Reset[];
-- now the labelled EXITs
P5.LabelList[tb[rootnode].son[5], endlabel];
P5.PopLabels[labelmark];
-- finally the FINISHED clause
P5U.InsertLabel[finlabel];
tb[rootnode].son[6] ← StatementTree[tb[rootnode].son[6]];
P5U.InsertLabel[endlabel];
RETURN
END;
CatchPhrase: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- process a catchphrase at procedure call
aroundlabel: LabelCCIndex ← P5U.LabelAlloc[];
savcfs: CARDINAL ← CPtr.cfs;
r: CodeCCIndex;
CPtr.catchcount ← CPtr.catchcount + 1;
P5U.Out1[qCATCH, 0];
r ← LOOPHOLE[CPtr.codeptr, CodeCCIndex];
P5U.OutJump[JumpA, aroundlabel];
SCatchPhrase[node];
cb[r].parameters[1] ← CPtr.cfs;
P5U.InsertLabel[aroundlabel];
CPtr.catchcount ← CPtr.catchcount - 1;
CPtr.cfs ← savcfs;
RETURN
END;
Enable: PROCEDURE [node: Tree.Index] =
BEGIN -- generate code for an ENABLE
aroundlabel: LabelCCIndex ← P5U.LabelAlloc[];
enablelabel: LabelCCIndex;
savactenable: LabelCCIndex ← CPtr.actenable;
savcfs: CARDINAL ← CPtr.cfs;
CPtr.catchcount ← CPtr.catchcount + 1;
P5U.Out0[FOpCodes.qNOOP]; -- to get a FGT entry on the jump around
P5U.OutJump[JumpA,aroundlabel];
enablelabel ← P5U.CreateLabel[];
WITH tb[node].son[1] SELECT FROM
subtree => SCatchPhrase[index];
ENDCASE;
P5U.InsertLabel[aroundlabel];
CPtr.actenable ← enablelabel;
CPtr.catchcount ← CPtr.catchcount -1;
tb[node].son[2] ← StatementTree[tb[node].son[2]];
CPtr.actenable ← savactenable;
CPtr.cfs ← savcfs;
RETURN
END;
SCatchPhrase: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- main subr for catchphrases and ENABLEs
saveCaseCVState: CaseCVState = CPtr.caseCVState;
endlabel: LabelCCIndex ← P5U.LabelAlloc[];
oldstkptr: StackIndex = Stack.New[];
msgtemp, sigtemp: se Lexeme;
saveactenable: LabelCCIndex = CPtr.actenable;
tempstate: TempStateRecord;
sscc: PROCEDURE [t: Tree.Link] =
BEGIN
fail: LabelCCIndex = P5U.LabelAlloc[];
WITH t SELECT FROM
subtree => [] ← CaseItem[
node:index, isexp:FALSE, isenable:TRUE,
tempsei: ISENull, faillabel: fail];
ENDCASE;
P5U.OutJump[Jump, endlabel];
P5U.InsertLabel[fail];
RETURN
END;
CPtr.curctxlvl ← CPtr.curctxlvl + 1;
P5.PushTempState[@tempstate, tb[node].info];
Stack.Incr[1]; -- signal code is on stack
IF CPtr.actenable # LabelCCNull THEN
BEGIN
sigtemp ← P5.GenAnonLex[1];
msgtemp ← P5.GenAnonLex[1];
P5U.Out1[qLL,ControlDefs.localbase+1];
P5.SAssign[msgtemp.lexsei];
P5.SAssign[sigtemp.lexsei];
P5.PushLex[sigtemp];
END;
CPtr.caseCVState ← singleLoaded;
CPtr.actenable ← LabelCCNull;
TreeOps.ScanList[tb[node].son[1], sscc];
IF tb[node].son[1] = Tree.Null THEN Stack.Pop[];
IF tb[node].son[2] # Tree.Null THEN
tb[node].son[2] ← StatementTree[tb[node].son[2]];
CPtr.actenable ← saveactenable;
P5U.InsertLabel[endlabel];
Stack.Off[];
IF CPtr.actenable # LabelCCNull THEN
BEGIN
P5.PushLex[sigtemp];
P5.PushLex[msgtemp];
P5U.Out1[qSL,ControlDefs.localbase+1];
P5U.OutJump[Jump,CPtr.actenable];
P5.ReleaseTempLex[msgtemp];
P5.ReleaseTempLex[sigtemp];
END
ELSE
BEGIN
P5U.PushLitVal[0];
P5U.Out0[qRET];
P5U.OutJump[JumpRet,LabelCCNull];
END;
Stack.On[];
CPtr.curctxlvl ← CPtr.curctxlvl-1;
CPtr.caseCVState ← saveCaseCVState;
BEGIN
fs: CARDINAL ← CPtr.framesz;
P5.PopTempState[@tempstate];
CPtr.cfs ← P5U.ComputeFrameSize[fs];
END;
IF bb[MPtr.bodyIndex].resident THEN
CPtr.cfs ← CPtr.cfs+ControlDefs.AllocationVectorSize;
Stack.Restore[oldstkptr];
RETURN
END;
Notify: PROCEDURE [node: Tree.Index] =
BEGIN
r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
P5U.Out0[IF P5L.LoadAddress[r].long THEN qNOTIFYL
ELSE qNOTIFY];
END;
Broadcast: PROCEDURE [node: Tree.Index] =
BEGIN
r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
P5U.Out0[IF P5L.LoadAddress[r].long THEN qBCASTL
ELSE qBCAST];
END;
END..