Flow:
PROGRAM
IMPORTS CPtr: Code, CodeDefs, P5U, P5, TreeOps
EXPORTS CodeDefs, P5, P5S = BEGIN OPEN IntCodeDefs, CodeDefs;
imported definitions
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];
shorten => l ← Shorten[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;
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;
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
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];
RETURN[NIL];
END;
END;
END.