-- Flow.mesa last modified by Sweet, January 16, 1980 9:05 AM
DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
Code: FROM "code" USING [
caseCVState, catchcount, CodeNotImplemented, curctxlvl, dStar],
CodeDefs: FROM "codedefs" USING [
EXLabelRecord, EXLRIndex, EXLRNull, JumpType, LabelCCIndex, Lexeme,
NullLex, VarComponent, VarIndex],
ControlDefs: FROM "controldefs" USING [localbase, returnOffset],
FOpCodes: FROM "fopcodes" USING [
qDCOMP, qDUCOMP, qFCOMP, qLI, qLL, qLP, qOR, qPUSH, qSFC],
P5: FROM "p5" USING [
Exp, FreeHeapLex, GenAnonLex, LogHeapFree, PushLex, PushRhs,
StatementTree, SysCall],
P5L: FROM "p5l" USING [
EasilyLoadable, FieldOfVar, InCode, LoadAddress, LoadBoth, LoadComponent,
LongVarAddress, MakeComponent, ReusableCopies, VarAlignment, VarForLex, Words],
P5S: FROM "p5s",
P5U: FROM "p5u" USING [
FreeChunk, GetChunk, InsertLabel, LabelAlloc, Out0, Out1, OutJump,
PushLitVal, TreeLiteral, TreeLiteralValue],
SDDefs: FROM "sddefs" USING [sBLTE, sBLTEC, sBLTECL, sBLTEL],
Stack: FROM "stack" USING [Decr, Dump, Incr, Mark, Require],
Symbols: FROM "symbols" USING [
ContextLevel, CTXIndex, HTIndex, HTNull, ISEIndex, SEIndex, seType],
Table: FROM "table" USING [Base, Limit, Notifier],
Tree: FROM "tree" USING [Index, Link, NodeName, Null, treeType],
TreeOps: FROM "treeops" USING [ScanList];
Flow: PROGRAM
IMPORTS CPtr: Code, P5U, CodeDefs, P5L, P5, TreeOps, Stack
EXPORTS CodeDefs, P5, P5S =
BEGIN
OPEN CodeDefs;
-- imported definitions
BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;
charlength: CARDINAL = AltoDefs.charlength;
ContextLevel: TYPE = Symbols.ContextLevel;
CTXIndex: TYPE = Symbols.CTXIndex;
HTIndex: TYPE = Symbols.HTIndex;
HTNull: HTIndex = Symbols.HTNull;
ISEIndex: TYPE = Symbols.ISEIndex;
SEIndex: TYPE = Symbols.SEIndex;
CRLabelRecord: TYPE = RECORD [
free: BOOLEAN,
retrylabel, contlabel: LabelCCIndex,
crcc: CARDINAL];
CRLRIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO CRLabelRecord;
CRLRNull: CRLRIndex = LOOPHOLE[Table.Limit-1];
labelStack: EXLRIndex ← EXLRNull;
CRlabel: CRLRIndex ← CRLRNull;
UndeclaredLabel: SIGNAL[HTIndex] = CODE;
tb: Table.Base; -- tree base (local copy)
seb: Table.Base; -- semantic entry base (local copy)
cb: Table.Base; -- code base (local copy)
FlowNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
cb ← tb ← base[Tree.treeType];
RETURN
END;
JumpNN: PACKED ARRAY Tree.NodeName[relE..relLE] OF JumpType ← [
JumpE, JumpN, JumpL, JumpGE, JumpG, JumpLE];
UJumpNN: PACKED ARRAY Tree.NodeName[relE..relLE] OF JumpType ← [
JumpE, JumpN, UJumpL, UJumpGE, UJumpG, UJumpLE];
RNN: ARRAY Tree.NodeName[relE..relLE] OF Tree.NodeName = [
relE, relN, relG, relLE, relL, relGE];
CNN: ARRAY Tree.NodeName[relE..relLE] OF Tree.NodeName = [
relN, relE, relGE, relL, relLE, relG];
FlowTree: PUBLIC PROCEDURE [t: Tree.Link, tf: BOOLEAN, label: LabelCCIndex] =
BEGIN -- produces code to jump to label on condition tf
node: Tree.Index;
label1: LabelCCIndex;
sw: BOOLEAN;
WITH t SELECT FROM
symbol =>
BEGIN
l: se Lexeme;
IF ~CPtr.dStar THEN Stack.Dump[];
l ← [se[index]];
P5.PushLex[l];
P5U.PushLitVal[0];
P5U.OutJump[IF tf THEN JumpN ELSE JumpE, label];
RETURN
END;
subtree =>
BEGIN
node ← index;
SELECT tb[node].name FROM
and, or =>
BEGIN ENABLE P5.LogHeapFree => RESUME[FALSE, NullLex];
sw ← IF tb[node].name = and THEN tf ELSE ~tf;
IF sw THEN
BEGIN
label1←P5U.LabelAlloc[];
FlowTree[tb[node].son[1], ~tf, label1];
FlowTree[tb[node].son[2], tf, label];
P5U.InsertLabel[label1];
END
ELSE
BEGIN
FlowTree[tb[node].son[1], tf, label];
FlowTree[tb[node].son[2], tf, label];
END;
END;
not => FlowTree[tb[node].son[1], ~tf, label];
in => FlowIn[t, tf, label];
notin => FlowIn[t, ~tf, label];
relE, relN, relL, relGE, relG, relLE =>
SFRel[node, tf, label];
ENDCASE => -- must be a BOOLEAN expression
BEGIN
IF ~CPtr.dStar THEN
IF t = Tree.Null AND CPtr.caseCVState = singleLoaded THEN
Stack.Require[1]
ELSE Stack.Dump[];
P5.PushRhs[t];
P5U.PushLitVal[0];
P5U.OutJump[IF tf THEN JumpN ELSE JumpE, label];
END;
END;
literal =>
BEGIN
val: CARDINAL ← P5U.TreeLiteralValue[t];
IF tf = (val # 0) THEN P5U.OutJump[Jump, label];
END;
ENDCASE;
RETURN
END;
SFRel: PROCEDURE [node: Tree.Index, tf: BOOLEAN, label: LabelCCIndex] =
BEGIN -- main subroutine of Cflow for handling relationals
t1: Tree.Link ← tb[node].son[1];
t2: Tree.Link;
n: Tree.NodeName ← tb[node].name;
hLex1, hLex2: se Lexeme ← NullLex;
r1, r2: VarIndex;
IF ~CPtr.dStar THEN
IF t1 = Tree.Null AND CPtr.caseCVState = singleLoaded THEN
Stack.Require[1]
ELSE Stack.Dump[];
IF P5U.TreeLiteral[t1] THEN
BEGIN
n ← RNN[n];
t2 ← t1; t1 ← tb[node].son[2];
END
ELSE t2 ← tb[node].son[2];
IF ~tf THEN n ← CNN[n];
r1 ← P5L.VarForLex[P5.Exp[t1!P5.LogHeapFree =>
IF calltree = t1 THEN RESUME[TRUE, hLex1 ← P5.GenAnonLex[1]]]];
r2 ← P5L.VarForLex[P5.Exp[t2!P5.LogHeapFree =>
IF calltree = t2 THEN RESUME[TRUE, hLex2 ← P5.GenAnonLex[1]]]];
VarVarComp[
r1: r1, r2: r2, n: n,
real: tb[node].attr1, signed: tb[node].attr3,
hLex1: hLex1, hLex2: hLex2, label: label];
END;
VarVarComp: PUBLIC PROCEDURE [r1, r2: VarIndex, n: Tree.NodeName, real, signed: BOOLEAN, hLex1, hLex2: se Lexeme, label: LabelCCIndex] =
BEGIN -- if ~dStar, stack should be "empty" when called
wSize: CARDINAL;
bSize, bd1, bd2: [0..wordlength);
ws: CARDINAL;
FreeHeapNodes: PROCEDURE =
BEGIN
IF hLex1 # NullLex THEN P5.FreeHeapLex[hLex1];
IF hLex2 # NullLex THEN P5.FreeHeapLex[hLex2];
hLex1 ← hLex2 ← NullLex;
END;
[wSize: wSize, bSize: bSize, bd: bd1] ← P5L.VarAlignment[r1, load];
[bd: bd2] ← P5L.VarAlignment[r2, load];
ws ← P5L.Words[wSize, bSize]; -- r1 and r2 are same size if > 1
IF ws > 1 AND bd1 # bd2 THEN SIGNAL CPtr.CodeNotImplemented;
IF ws <= 2 THEN
BEGIN
c1: VarComponent ← P5L.MakeComponent[r1];
c2: VarComponent ← P5L.MakeComponent[r2];
BEGIN
IF n = relE OR n = relN THEN WITH c2 SELECT FROM
const => IF wSize = 2 AND bSize = 0 AND d1 = 0 AND d2 = 0 THEN
BEGIN
P5L.LoadComponent[c1];
P5U.Out0[FOpCodes.qOR];
GO TO double;
END;
ENDCASE;
P5L.LoadBoth[@c1, @c2, FALSE];
IF ws = 2 THEN
BEGIN
P5U.Out0[IF real THEN FOpCodes.qFCOMP
ELSE IF signed THEN FOpCodes.qDCOMP ELSE FOpCodes.qDUCOMP];
GO TO double;
END;
FreeHeapNodes[];
EXITS
double => BEGIN FreeHeapNodes[]; P5U.Out1[FOpCodes.qLI, 0] END;
END;
P5U.OutJump[IF signed OR ws = 2 THEN JumpNN[n] ELSE UJumpNN[n], label];
END
ELSE
BEGIN -- multiword quantities, n = relE or relN
IF bSize = 0 THEN
BEGIN
code: BOOLEAN ← FALSE;
long1, long2: BOOLEAN;
CompFn: ARRAY BOOLEAN OF ARRAY BOOLEAN OF BYTE = [
[SDDefs.sBLTE, SDDefs.sBLTEL], [SDDefs.sBLTEC, SDDefs.sBLTECL]];
Stack.Dump[]; Stack.Mark[]; -- so procedure call will work
IF P5L.InCode[r1] THEN
BEGIN tr: VarIndex = r1; r1 ← r2; r2 ← tr END;
IF P5L.InCode[r2] THEN code ← TRUE;
long2 ← P5L.LongVarAddress[r2];
long1 ← P5L.LoadAddress[r: r1, codeOk: FALSE];
IF ~long1 AND long2 THEN
BEGIN P5U.Out0[FOpCodes.qLP]; long1 ← TRUE END;
P5U.Out1[FOpCodes.qLI, ws];
[] ← P5L.LoadAddress[r: r2, codeOk: TRUE];
IF ~code AND long1 AND ~long2 THEN P5U.Out0[FOpCodes.qLP];
P5.SysCall[CompFn[code][long1]];
Stack.Incr[1];
FreeHeapNodes[];
P5U.Out1[FOpCodes.qLI, 0];
P5U.OutJump[IF n # relE THEN JumpE ELSE JumpN, label]
END
ELSE
BEGIN -- do in two pieces
r1a, r1b: VarIndex;
r2a, r2b: VarIndex;
firstEq, secondComp: LabelCCIndex;
[r1a, r1b] ← P5L.ReusableCopies[r1, load];
[r2a, r2b] ← P5L.ReusableCopies[r2, load];
IF bd1 # 0 THEN
BEGIN
P5L.FieldOfVar[r: r1b, bSize: bSize];
P5L.FieldOfVar[r: r1a, bd: bSize, wSize: wSize];
P5L.FieldOfVar[r: r2b, bSize: bSize];
P5L.FieldOfVar[r: r2a, bd: bSize, wSize: wSize];
END
ELSE
BEGIN
P5L.FieldOfVar[r: r1b, wSize: wSize];
P5L.FieldOfVar[r: r1a, wd: wSize, bSize: bSize];
P5L.FieldOfVar[r: r2b, wSize: wSize];
P5L.FieldOfVar[r: r2a, wd: wSize, bSize: bSize];
END;
secondComp ← P5U.LabelAlloc[];
IF n = relN THEN firstEq ← label
ELSE firstEq ← P5U.LabelAlloc[];
VarVarComp[
r1b, r2b, relE, real, signed, NullLex, NullLex, secondComp];
FreeHeapNodes[]; -- this looks awful here, but Final sorts it all out
P5U.OutJump[Jump, firstEq];
P5U.InsertLabel[secondComp];
VarVarComp[r1a, r2a, n, real, signed, hLex1, hLex2, label];
IF n # relN THEN P5U.InsertLabel[firstEq];
END;
END;
END;
FlowIn: PUBLIC PROCEDURE [t: Tree.Link, tf: BOOLEAN, label: LabelCCIndex] =
BEGIN -- generates code for IN expression in flow context
node: Tree.Index;
n: Tree.NodeName;
fail: LabelCCIndex ← P5U.LabelAlloc[];
jumpNN: POINTER TO PACKED ARRAY Tree.NodeName[relE..relLE] OF JumpType;
double, real: BOOLEAN;
signed: BOOLEAN;
r1: VarIndex;
var1: VarComponent;
t1: Tree.Link;
hLex: se Lexeme ← NullLex;
WITH t SELECT FROM
subtree =>
BEGIN
node ← index;
t1 ← tb[node].son[1];
WITH tb[node].son[2] SELECT FROM -- the interval node
subtree =>
BEGIN
inn: Tree.Index ← index;
real ← tb[inn].attr1;
double ← real OR tb[inn].attr2;
signed ← tb[inn].attr3;
END;
ENDCASE => ERROR;
IF real OR ~CPtr.dStar THEN
IF t = Tree.Null AND CPtr.caseCVState = singleLoaded THEN
Stack.Require[1]
ELSE Stack.Dump[];
r1 ← P5L.VarForLex[P5.Exp[t1 ! P5.LogHeapFree =>
IF calltree = t1 THEN RESUME[TRUE, hLex ← P5.GenAnonLex[1]]]];
var1 ← P5L.MakeComponent[r1];
IF double THEN var1 ← P5L.EasilyLoadable[var1, load];
P5L.LoadComponent[var1];
IF hLex # NullLex THEN
BEGIN P5.FreeHeapLex[hLex]; hLex ← NullLex END;
WITH tb[node].son[2] SELECT FROM
subtree =>
BEGIN
node ← index;
jumpNN ← IF double OR signed THEN @JumpNN ELSE @UJumpNN;
n ← tb[node].name;
P5.PushRhs[tb[node].son[1] ! P5.LogHeapFree =>
IF calltree = t1 THEN RESUME[TRUE, hLex ← P5.GenAnonLex[1]]];
IF double THEN
BEGIN
P5U.Out0[IF real THEN FOpCodes.qFCOMP
ELSE IF signed THEN FOpCodes.qDCOMP
ELSE FOpCodes.qDUCOMP];
P5U.PushLitVal[0];
END;
IF hLex # NullLex THEN
BEGIN P5.FreeHeapLex[hLex]; hLex ← NullLex END;
SELECT n FROM
intOO,intOC => P5U.OutJump[jumpNN[relLE],
IF tf THEN fail ELSE label];
intCO,intCC => P5U.OutJump[jumpNN[relL],
IF tf THEN fail ELSE label];
ENDCASE;
IF double THEN P5L.LoadComponent[var1]
ELSE P5U.Out0[FOpCodes.qPUSH];
P5.PushRhs[tb[node].son[2] ! P5.LogHeapFree =>
IF calltree = t1 THEN RESUME[TRUE, hLex ← P5.GenAnonLex[1]]];
IF double THEN
BEGIN
P5U.Out0[IF real THEN FOpCodes.qFCOMP
ELSE IF signed THEN FOpCodes.qDCOMP
ELSE FOpCodes.qDUCOMP];
P5U.PushLitVal[0];
END;
IF hLex # NullLex THEN P5.FreeHeapLex[hLex];
SELECT n FROM
intOO,intCO => P5U.OutJump[
IF tf THEN jumpNN[relL] ELSE jumpNN[relGE],label];
intOC,intCC => P5U.OutJump[
IF tf THEN jumpNN[relLE] ELSE jumpNN[relG],label];
ENDCASE;
P5U.InsertLabel[fail];
RETURN
END;
ENDCASE
END;
ENDCASE
END;
CatchMark: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- process a CONTINUEd or RETRYed statement
savCRlabel: CRLRIndex ← CRlabel;
l: CRLRIndex ← P5U.GetChunk[SIZE[CRLabelRecord]];
elabel: LabelCCIndex;
CRlabel ← l;
cb[l].free ← FALSE;
P5U.InsertLabel[cb[l].retrylabel ← P5U.LabelAlloc[]];
elabel ← cb[l].contlabel ← P5U.LabelAlloc[];
cb[l].crcc ← CPtr.catchcount;
tb[node].son[1] ← P5.StatementTree[tb[node].son[1]];
P5U.InsertLabel[elabel];
CRlabel ← savCRlabel;
P5U.FreeChunk[l, SIZE[CRLabelRecord]];
RETURN
END;
Label: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- process an exitable block
elabel: LabelCCIndex ← P5U.LabelAlloc[];
labelmark: EXLRIndex ← labelStack;
TreeOps.ScanList[tb[node].son[2], LabelCreate];
tb[node].son[1] ← P5.StatementTree[tb[node].son[1]];
P5U.OutJump[Jump, elabel];
LabelList[tb[node].son[2], elabel];
P5U.InsertLabel[elabel];
PopLabels[labelmark];
RETURN
END;
GetLabelMark: PUBLIC PROCEDURE RETURNS [EXLRIndex] =
BEGIN RETURN[labelStack] END;
PopLabels: PUBLIC PROCEDURE [labelmark: EXLRIndex] =
BEGIN
oldl: EXLRIndex;
UNTIL labelStack = labelmark DO
oldl ← labelStack;
labelStack ← cb[labelStack].thread;
P5U.FreeChunk[oldl, SIZE[EXLabelRecord]];
ENDLOOP;
RETURN
END;
LabelList: PUBLIC PROCEDURE [t: Tree.Link, elabel: LabelCCIndex] =
BEGIN -- generates code for labels
Clabelitem: PROCEDURE [t: Tree.Link] =
BEGIN -- generates code for a labelitem
WITH t SELECT FROM
subtree =>
BEGIN
TreeOps.ScanList[tb[index].son[1], PutLabel];
tb[index].son[2] ← P5.StatementTree[tb[index].son[2]];
P5U.OutJump[Jump, elabel];
RETURN
END;
ENDCASE
END;
TreeOps.ScanList[t, Clabelitem];
RETURN
END;
PutLabel: PROCEDURE [t: Tree.Link] =
BEGIN
WITH t SELECT FROM
hash => P5U.InsertLabel[cb[FindLabel[index]].labelcci];
ENDCASE;
RETURN
END;
LabelCreate: PUBLIC PROCEDURE [t: Tree.Link] =
BEGIN -- sets up label cells for labels
WITH t SELECT FROM
subtree => TreeOps.ScanList[tb[index].son[1], PushLabel];
ENDCASE;
RETURN
END;
PushLabel: PROCEDURE [t: Tree.Link] =
BEGIN -- stacks a label for an EXIT clause
l: EXLRIndex ← P5U.GetChunk[SIZE[EXLabelRecord]];
WITH t SELECT FROM
hash =>
BEGIN
cb[l] ←
EXLabelRecord[free: FALSE, thread: labelStack, labelhti: index,
labelcc: CPtr.catchcount, labelcci: P5U.LabelAlloc[]];
labelStack ← l;
RETURN;
END;
ENDCASE
END;
MakeExitLabel: PUBLIC PROCEDURE RETURNS [exit, loop: LabelCCIndex] =
BEGIN -- sets up anonymous label for EXITs
l: EXLRIndex ← P5U.GetChunk[SIZE[EXLabelRecord]];
exit ← P5U.LabelAlloc[];
loop ← P5U.LabelAlloc[];
cb[l] ←
EXLabelRecord[free: FALSE, thread: labelStack, labelhti: HTNull,
labelcc: CPtr.catchcount, labelcci: loop];
labelStack ← l;
l ← P5U.GetChunk[SIZE[EXLabelRecord]];
cb[l] ←
EXLabelRecord[free: FALSE, thread: labelStack, labelhti: HTNull,
labelcc: CPtr.catchcount, labelcci: exit];
labelStack ← l;
RETURN
END;
FindLabel: PROCEDURE [hti: HTIndex] RETURNS [c: EXLRIndex] =
BEGIN -- searches down label stack for label hti
FOR c ← labelStack, cb[c].thread UNTIL c = EXLRNull DO
IF cb[c].labelhti = hti THEN RETURN
ENDLOOP;
SIGNAL UndeclaredLabel[hti];
RETURN
END;
Retry: PUBLIC PROCEDURE =
BEGIN -- process RETRY statement
RetContExit[cb[CRlabel].crcc, cb[CRlabel].retrylabel];
RETURN
END;
Continue: PUBLIC PROCEDURE =
BEGIN -- process CONTINUE statement
RetContExit[cb[CRlabel].crcc, cb[CRlabel].contlabel];
RETURN
END;
Exit: PUBLIC PROCEDURE =
BEGIN -- generate code for EXIT
l: EXLRIndex ← FindLabel[HTNull];
RetContExit[cb[l].labelcc, cb[l].labelcci];
RETURN
END;
Loop: PUBLIC PROCEDURE =
BEGIN -- generate code for EXIT
l: EXLRIndex ← FindLabel[HTNull];
l ← cb[l].thread;
RetContExit[cb[l].labelcc, cb[l].labelcci];
RETURN
END;
GoTo: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- generate code for GOTO
l: EXLRIndex;
WITH tb[node].son[1] SELECT FROM
hash => l ← FindLabel[index];
ENDCASE;
RetContExit[cb[l].labelcc, cb[l].labelcci];
RETURN
END;
RetContExit: PROCEDURE [cc: CARDINAL, lc: LabelCCIndex] =
BEGIN -- process EXIT/REPEAT statement
IF CPtr.catchcount = cc THEN P5U.OutJump[Jump, lc]
ELSE
BEGIN
var: VarComponent ← [wSize: 1, space: frame[
wd: ControlDefs.localbase,
level: CPtr.curctxlvl-(CPtr.catchcount-cc-1)]];
P5L.LoadComponent[var];
P5U.PushLitVal[-1];
P5U.Out1[FOpCodes.qLL, ControlDefs.returnOffset];
P5U.Out0[FOpCodes.qSFC];
Stack.Decr[2];
P5U.OutJump[Jump, lc];
END;
RETURN
END;
END...