DIRECTORY
Alloc,
Basics,
Code,
CodeDefs,
FOpCodes,
IntCodeDefs,
P5,
P5S,
P5U,
PrincOps,
Symbols,
Tree,
TreeOps;

Flow: PROGRAM
IMPORTS CPtr: Code, CodeDefs, P5U, P5, TreeOps 
EXPORTS CodeDefs, P5, P5S = BEGIN OPEN IntCodeDefs, CodeDefs;


BitCount: TYPE = Symbols.BitCount;
HTIndex: TYPE = Symbols.HTIndex;

labelStack: LabelInfoIndex _ LabelInfoNull;

UndeclaredLabel: SIGNAL [HTIndex] = CODE;

tb: Tree.Base;		-- tree base (local copy)
cb: CodeDefs.Base;		-- code base (local copy)

CompForNodeName: PACKED ARRAY Tree.NodeName[relE..notin] OF Comparator _ [
relE:eq, relN:ne, relL:lt, relGE:ge, relG:gt, relLE:le, in: in, notin: out];

FlowNotify: PUBLIC Alloc.Notifier =
BEGIN  -- called by allocator whenever table area is repacked
tb _ base[Tree.treeType];
cb _ base[codeType];
END;

FlowExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] =
BEGIN -- generates code for a flow expression
SELECT tb[node].name FROM
ifx => l _ IfExp[node];
or => l _ Or[node];
and => l _ And[node];
not => l _ Not[node];
relE, relN, relL, relGE, relG, relLE, in, notin => l _ Rel[node];
abs => l _ Abs[node];
lengthen => l _ Lengthen[node];
min => l _ Min[node];
max => l _ Max[node];
istype => l _ Rel[node];
ENDCASE => {SIGNAL CPtr.CodeNotImplemented};
RETURN
END;


Abs: PROC [node: Tree.Index] RETURNS [Node] =
BEGIN -- generate code for ABS
op: Node _ P5U.ArithOpForTree[node, abs];
bits: BitCount _ P5U.BitsForType[tb[node].info];
val: Node _ P5.Exp[tb[node].son[1]];
RETURN [P5U.ApplyOp[op, P5U.MakeNodeList[val], bits]];
END;


Lengthen: PROC [node: Tree.Index] RETURNS [Node] =
BEGIN -- convert 16 bit to 32
signed: BOOL _ tb[node].attr3;
short: Node _ P5.Exp[tb[node].son[1]];
IF signed THEN RETURN [P5U.SignExtend[short]]
ELSE RETURN[P5U.ZeroExtend[short]];
END;


And: PROC [node: Tree.Index] RETURNS [l: Node] = 
BEGIN -- generate code for "AND"
e1: Node = P5.Exp[tb[node].son[1]];
e2: Node = P5.Exp[tb[node].son[2]];
else: CaseList = P5U.MakeCaseList[NIL, CPtr.falseNode];
then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[e1], e2, else];
l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
END;

Or: PROC [node: Tree.Index] RETURNS [l: Node] = 
BEGIN -- generate code for "OR"
e1: Node = P5.Exp[tb[node].son[1]];
e2: Node = P5.Exp[tb[node].son[2]];
else: CaseList = P5U.MakeCaseList[NIL, e2];
then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[e1], CPtr.trueNode, else];
l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
END;

Not: PROC [node: Tree.Index] RETURNS [l: Node] =
BEGIN -- generate code for "NOT"
e1: Node = P5.Exp[tb[node].son[1]];
else: CaseList = P5U.MakeCaseList[NIL, CPtr.trueNode];
then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[e1], CPtr.falseNode, else];
l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
END;

Rel: PROC [node: Tree.Index] RETURNS [l: Node] =
BEGIN -- produces code for relationals
e1: Node = P5.Exp[tb[node].son[1]];
e2: Node = P5.Exp[tb[node].son[2]];
ops: NodeList _ P5U.MakeNodeList[e1, P5U.MakeNodeList[e2]];
name: Tree.NodeName _ tb[node].name;
SELECT name FROM 
relE, relN, relL, relGE, relG, relLE, in, notin => 
l _ P5U.ApplyOp[oper: P5U.CompareOpForTree[node, CompForNodeName[name]],  args: ops, bits: 1];
istype => NULL; -- obviously needs work
ENDCASE;
END;

IfExp: PROC [node: Tree.Index] RETURNS [l: Node] =
BEGIN -- generates code for an IF expression
test: Node = P5.Exp[tb[node].son[1]];
e1: Node = P5.Exp[tb[node].son[2]];
e2: Node = P5.Exp[tb[node].son[3]];
else: CaseList = P5U.MakeCaseList[NIL, e2];
then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[test], e1, else];
l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
END;

Min: PROC [node: Tree.Index] RETURNS [l: Node] =
BEGIN -- generates code for "MAX[...]"
op: Node _ P5U.ArithOpForTree[node, min];
bits: BitCount _ P5U.BitsForType[tb[node].info];
l _ CMinMax[op, tb[node].son[1], bits];
END;


Max: PROC [node: Tree.Index] RETURNS [l: Node] =
BEGIN -- generates code for "MAX[...]"
op: Node _ P5U.ArithOpForTree[node, max];
bits: BitCount _ P5U.BitsForType[tb[node].info];
l _ CMinMax[op, tb[node].son[1], bits];
END;


CMinMax: PROC [mOp: Node, t: Tree.Link, bits: BitCount] RETURNS [l: Node] =
BEGIN -- common subroutine for Cmin and Cmax
args: NodeList _ P5.ExpList[t].head;
RETURN [P5U.ApplyOp[mOp, args, bits]];
END;
CatchMark: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
BEGIN -- process a CONTINUEd or RETRYed statement
cl: CodeList _ P5U.NewCodeList[];
l: LabelInfoIndex _ P5U.GetChunk[LabelInfoRecord.SIZE];
retry: Label = P5U.AllocLabel[];
continue: Label = P5U.AllocLabel[];
cb[l] _ [thread: labelStack, catchLevel: CPtr.catchcount, body:
stmt[retry: retry, continue: continue]];
labelStack _ l;
P5U.InsertLabel[cl, retry];
P5U.MoreCode[cl, P5.StatementTree[tb[node].son[1]]];
P5U.InsertLabel[cl, continue];
IF labelStack # l THEN ERROR;
labelStack _ cb[l].thread;
P5U.FreeChunk[l, LabelInfoRecord.SIZE];
RETURN[P5U.MakeBlock[cl]];
END;

LabelStmt: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
BEGIN -- process an exitable block
cl: CodeList _ P5U.NewCodeList[];
elabel: Label = P5U.AllocLabel[];
labelmark: LabelInfoIndex = labelStack;
TreeOps.ScanList[tb[node].son[2], LabelCreate];
P5U.MoreCode[cl, P5.StatementTree[tb[node].son[1]]];
P5U.Jump[cl, elabel];
LabelList[cl, tb[node].son[2], elabel, labelmark];
P5U.InsertLabel[cl, elabel];
RETURN[P5U.MakeBlock[cl]];
END;


GetLabelMark: PUBLIC PROC RETURNS [LabelInfoIndex] =
{RETURN [labelStack]};


PopLabels: PROC [first: LabelInfoIndex] =
BEGIN
oldl: LabelInfoIndex;
UNTIL first = LabelInfoNull DO
oldl _ first;
first _ cb[first].thread;
P5U.FreeChunk[oldl, LabelInfoRecord.SIZE];
ENDLOOP;
END;

ObscureLabels: PROC [mark: LabelInfoIndex] RETURNS [first: LabelInfoIndex] =
BEGIN
first _ labelStack;
UNTIL labelStack = LabelInfoNull OR  cb[labelStack].thread = mark DO 
labelStack _ cb[labelStack].thread;
ENDLOOP;
cb[labelStack].thread _ LabelInfoNull;
labelStack _ mark;
RETURN
END;

FindLabel: PROC [start: LabelInfoIndex, hti: HTIndex] RETURNS [NamedLabelInfoIndex] =
BEGIN
FOR l: LabelInfoIndex _ start, cb[l].thread UNTIL l = LabelInfoNull DO
WITH li: cb[l] SELECT FROM
named => IF li.hti = hti THEN RETURN [LOOPHOLE[l]];
ENDCASE;
ENDLOOP;
ERROR UndeclaredLabel[hti]
END;

LabelList: PUBLIC PROC [cl: CodeList, t: Tree.Link, elabel: Label, mark: LabelInfoIndex] =
BEGIN -- generates code for labels
toBind: LabelInfoIndex = ObscureLabels[mark];

PutLabel: PROC [t: Tree.Link] =
BEGIN
P5U.InsertLabel[cl, cb[FindLabel[toBind, TreeOps.GetHash[t]]].cci];
END;

CLabelItem: PROC [t: Tree.Link] =
BEGIN -- generates code for a labelitem
node: Tree.Index = TreeOps.GetNode[t];
TreeOps.ScanList[tb[node].son[1], PutLabel];
P5U.MoreCode[cl, P5.StatementTree[tb[node].son[2]]];
P5U.Jump[cl, elabel];
END;

TreeOps.ScanList[t, CLabelItem];
PopLabels[toBind];
END;



LabelCreate: PUBLIC PROC [t: Tree.Link] =
BEGIN -- sets up label cells for labels
node: Tree.Index = TreeOps.GetNode[t];
TreeOps.ScanList[tb[node].son[1], PushLabel];
END;


PushLabel: PROC [t: Tree.Link] =
BEGIN -- stacks a label for an EXIT clause
hti: Symbols.HTIndex = TreeOps.GetHash[t];
l: LabelInfoIndex = P5U.GetChunk[LabelInfoRecord.SIZE];
cb[l] _ [thread: labelStack, catchLevel: CPtr.catchcount, body:
named[hti: hti, cci: P5U.AllocLabel[LONG[LOOPHOLE[hti, CARDINAL]]]]];
labelStack _ l;
END;


MakeExitLabel: PUBLIC PROC RETURNS [exit, loop: Label] =
BEGIN -- sets up anonymous label for EXITs
l: LabelInfoIndex = P5U.GetChunk[LabelInfoRecord.SIZE];
exit _ P5U.AllocLabel[];
loop _ P5U.AllocLabel[];
cb[l] _ [thread: labelStack, catchLevel: CPtr.catchcount, body:
loop[exit: exit, loop: loop]];
labelStack _ l;
RETURN
END;


Retry: PUBLIC PROC RETURNS [Node] =
BEGIN -- process RETRY statement
FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
WITH li: cb[l] SELECT FROM
stmt => RETURN[ExplicitJump[li.catchLevel, li.retry]];
ENDCASE;
ENDLOOP;
ERROR
END;


Continue: PUBLIC PROC RETURNS [Node] =
BEGIN -- process CONTINUE statement
FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
WITH li: cb[l] SELECT FROM
stmt => RETURN[ExplicitJump[li.catchLevel, li.continue]];
ENDCASE;
ENDLOOP;
ERROR
END;


Exit: PUBLIC PROC RETURNS [Node] =
BEGIN  -- generate code for EXIT
FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
WITH li: cb[l] SELECT FROM
loop => RETURN[ExplicitJump[li.catchLevel, li.exit]];
ENDCASE;
ENDLOOP;
ERROR
END;

Loop: PUBLIC PROC RETURNS [Node] =
BEGIN  -- generate code for LOOP
FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
WITH li: cb[l] SELECT FROM
loop => RETURN[ExplicitJump[li.catchLevel, li.loop]];
ENDCASE;
ENDLOOP;
ERROR
END;


GoTo: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
BEGIN  -- generate code for GOTO
l: NamedLabelInfoIndex = FindLabel[labelStack, TreeOps.GetHash[tb[node].son[1]]];
RETURN[ExplicitJump[cb[l].catchLevel, cb[l].cci]];
END;


ExplicitJump: PROC [cc: CARDINAL, lc: Label] RETURNS [Node] =
BEGIN -- process EXIT/REPEAT/GOTO/etc. statement
IF CPtr.catchcount = cc THEN RETURN[z.NEW[NodeRep.goto _ [details: goto[lc]]]]
ELSE
BEGIN
RETURN[NIL];
END;
END;

END.

ΰFlow.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, May 31, 1986 9:49:07 pm PDT
Satterthwaite, April 17, 1986 11:29:24 am PST
Maxwell, August 11, 1983 9:12 am
Russ Atkinson (RRA) March 6, 1985 11:19:01 pm PST
imported definitions
shorten => l _ Shorten[node];
Shorten: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
P5.PushRhs[tb[node].son[1]];
IF ~tb[node].attr1 THEN P5U.Out0[qPOP]	-- no checking
ELSE IF tb[node].attr3 THEN
BEGIN
P5U.Out1[qLI, 100000b]; P5U.Out1[qLI, 0]; P5U.Out0[qDADD];
P5U.Out1[qLI, 1]; P5U.Out0[qBNDCK]; P5U.Out0[qPOP];
P5U.Out1[qLI, 100000b]; P5U.Out0[qXOR];
END
ELSE
BEGIN
P5U.Out1[qLI, 1]; P5U.Out0[qBNDCK]; P5U.Out0[qPOP];
END;	
RETURN [P5L.TOSLex[1]]
END;


var: VarComponent = [wSize: 1, space: frame[
wd: PrincOps.localbase,
level: CPtr.curctxlvl-(CPtr.catchcount-cc-1)]];
P5L.LoadComponent[var];
P5U.PushLitVal[-1];
P5U.Out1[FOpCodes.qLL, PrincOps.returnOffset];
P5U.Out0[FOpCodes.qSFC];
Stack.Decr[2];
P5U.OutJump[Jump, lc];
Κ@˜
codeš
œ	™	Kšœ
Οm
œ1™<Kš
œ"™"Kš
œ-™-K™ K™1—K˜š
Οk	˜	Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ	˜	K˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ˜Kš
œ˜Kš
œ˜K˜—šœž˜
Kšžœ(˜/Kšžœžœ˜=K˜Kš
œ™K˜Kšœ
žœ˜"Kšœ	žœ˜ K˜K˜+K˜Kšœžœ
žœ
˜)K˜KšœΟc˜)KšœŸ˜-K˜šœžœ
žœžœ˜JKš
œL˜LK˜—šœžœ˜#KšžœŸ6˜=K˜K˜Kšžœ
˜K˜—šΟnœžœ
žœžœ˜;Kšžœ
Ÿ'˜-šžœž˜K˜K˜K˜K˜Kš
œA˜AK˜K˜K™K˜K˜Kš
œ˜Kšžœžœ˜,—Kš
ž˜Kšžœ
˜K˜K˜—š œžœžœ	˜-Kšžœ
Ÿ˜K˜)K˜0Kš
œ$˜$Kšžœ0˜6Kšžœ
˜K˜K˜—š œžœžœ	˜2Kšžœ
Ÿ˜Kšœžœ˜K˜&Kšžœžœ
žœ˜-Kšžœ
žœ˜#Kšžœ
˜K˜K˜—š œžœžœ™3Kš
ž™K™KšžœžœŸ™5šžœ
žœž™Kš
ž™K™:K™3K™'Kš
ž™—š
ž™Kš
ž™K™3Kšžœ™—Kšžœ™Kšžœ
™K™K™—š œžœžœ
˜1Kšžœ
Ÿ˜ K˜#K˜#Kšœ"žœ˜7K˜BKšœžœ6˜?Kšžœ
˜K˜—š œžœžœ
˜0Kšžœ
Ÿ˜K˜#K˜#Kšœ"žœ˜+Kš
œM˜MKšœžœ6˜?Kšžœ
˜K˜—š œžœžœ˜0Kšžœ
Ÿ˜ K˜#Kšœ"žœ˜6Kš
œN˜NKšœžœ6˜?Kšžœ
˜K˜—š œžœžœ˜0Kšžœ
Ÿ ˜&K˜#K˜#K˜;Kš
œ$˜$šžœžœ
˜š
œ3˜3K˜^—Kšœ
žœŸ˜'Kšžœ
˜—Kšžœ
˜K˜—š œžœžœ˜2Kšžœ
Ÿ&˜,K˜%K˜#K˜#Kšœ"žœ˜+K˜DKšœžœ6˜?Kšžœ
˜K˜—š œžœžœ˜0Kšžœ
Ÿ ˜&K˜)K˜0K˜'Kšžœ
˜K˜K˜—š œžœžœ˜0Kšžœ
Ÿ ˜&K˜)K˜0K˜'Kšžœ
˜K˜K˜—š œžœ+žœ˜KKšžœ
Ÿ&˜,Kš
œ$˜$Kšžœ ˜&Kšžœ
˜—š 	œžœ
žœžœ	˜:Kšžœ
Ÿ+˜1K˜!Kšœ1žœ˜7K˜ K˜#˜?K˜(—K˜K˜K˜4K˜Kšžœžœ
žœ
˜K˜Kšœ!žœ˜'Kšžœ˜Kšžœ
˜K˜—š 	œžœ
žœžœ	˜:Kšžœ
Ÿ˜"K˜!K˜!K˜'K˜/K˜4K˜K˜2K˜Kšžœ˜Kšžœ
˜K˜K˜—š œžœ
žœ
žœ˜4Kšœ
žœ˜K˜K˜—š 	œžœ˜)Kš
ž˜K˜šžœž˜K˜
K˜Kšœ$žœ˜*Kšžœ
˜—Kšžœ
˜K˜—š 
œžœžœ˜LKš
ž˜K˜šžœžœžœ
˜EK˜#Kšžœ
˜—K˜&K˜Kš
ž˜Kšžœ
˜K˜—š 	œžœ'žœ˜UKš
ž˜šžœ)žœž˜Fšžœžœ
ž˜Kš	œ	žœžœ
žœžœ˜3Kšžœ
˜—Kšžœ
˜—Kšžœ˜Kšžœ
˜K˜—š 	œžœ
žœD˜ZKšžœ
Ÿ˜"K˜-K˜š œžœ˜Kš
ž˜K˜CKšžœ
˜K˜—š 
œžœ˜!Kšžœ
Ÿ!˜'K˜&K˜,K˜4K˜Kšžœ
˜K˜—K˜ K˜Kšžœ
˜K˜K˜K˜—š œžœ
žœ˜)Kšžœ
Ÿ!˜'K˜&K˜-Kšžœ
˜K˜K˜—š 	œžœ˜ Kšžœ
Ÿ$˜*Kš
œ*˜*Kšœ1žœ˜7˜?Kšœ$žœ
žœžœ˜E—K˜Kšžœ
˜K˜K˜—š 
œžœ
žœ
žœ˜8Kšžœ
Ÿ$˜*Kšœ1žœ˜7Kš
œ˜Kš
œ˜˜?K˜—K˜Kš
ž˜Kšžœ
˜K˜K˜—š œžœ
žœ
žœ	˜#Kšžœ
Ÿ˜ šžœ.žœž˜Kšžœžœ
ž˜Kšœžœ(˜6Kšžœ
˜—Kšžœ
˜—Kš
ž˜Kšžœ
˜K˜K˜—š œžœ
žœ
žœ	˜&Kšžœ
Ÿ˜#šžœ.žœž˜Kšžœžœ
ž˜Kšœžœ+˜9Kšžœ
˜—Kšžœ
˜—Kš
ž˜Kšžœ
˜K˜K˜—š œžœ
žœ
žœ	˜"KšžœŸ˜ šžœ.žœž˜Kšžœžœ
ž˜Kšœžœ'˜5Kšžœ
˜—Kšžœ
˜—Kš
ž˜Kšžœ
˜K˜—š œžœ
žœ
žœ	˜"KšžœŸ˜ šžœ.žœž˜Kšžœžœ
ž˜Kšœžœ'˜5Kšžœ
˜—Kšžœ
˜—Kš
ž˜Kšžœ
˜K˜K˜—š œžœ
žœžœ	˜5KšžœŸ˜ K˜QKšžœ,˜2Kšžœ
˜K˜K˜—š œžœžœ
žœ	˜=Kšžœ
Ÿ*˜0Kšžœžœ
žœžœ%˜Nš
ž˜Kš
ž˜™,K™K™/—K™K™K™.K™K™K™Kšžœ
žœ˜Kšžœ
˜—Kšžœ
˜K˜—Kšžœ
˜K˜——…—#Ί2Ϊ