RewriteEnables:
PUBLIC
PROC
[node: Node, genTemp: GenTemp, genLabel: GenLabel]
RETURNS [Node] = {
VisitScope:
PROC [label: Label, scope: NodeList, newState: LambdaState] = {
oldState: LambdaState = state;
oldParentLabel: Label = parentLabel;
state ¬ newState;
WITH label.node
SELECT
FROM
lambda: LambdaNode => {
IF lambda.parent = NIL THEN lambda.parent ¬ parentLabel;
parentLabel ¬ label;
IF lambda.formalArgs #
NIL
THEN
IntCodeUtils.MapVarList[lambda.formalArgs, FixVarLocation];
};
ENDCASE => SIGNAL CantHappen;
IntCodeUtils.MapNodeList[scope, DefineLabels];
IntCodeUtils.MapNodeList[scope, AssignCodes];
state ¬ oldState;
parentLabel ¬ oldParentLabel;
};
DefineLabels: IntCodeUtils.Visitor = {
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
WITH node
SELECT
FROM
decl: DeclNode =>
Since this variable might be nested differently, redefine its parent.
[] ¬ FixVarLocation[decl.var];
labNode: LabelNode => {
label: Label = labNode.label;
WITH label.node
SELECT
FROM
lambda: LambdaNode =>
RETURN [node];
Don't need this label, since it can't be the target of a go to
Cutoff at this level, we will visit this later
ENDCASE => [] ¬ DefineEntry[label, 0, parentLabel];
Define the label here
};
lambda: REF NodeRep.lambda => ERROR CantHappen;
apply:
REF NodeRep.apply => {
WITH apply.proc
SELECT
FROM
opNode:
REF NodeRep.oper =>
WITH opNode.oper
SELECT
FROM
mesa:
REF OperRep.mesa =>
SELECT mesa.mesa
FROM
unwind => {
label: Label ¬ PeelLabel[apply.args.first];
IF label = NIL THEN ERROR CantHappen;
RETURN [z.NEW[NodeRep.goto ¬ [0, goto[label]]]];
};
ENDCASE;
ENDCASE;
ENDCASE;
apply.proc ¬ DefineLabels[apply.proc];
IntCodeUtils.MapNodeList[apply.args, DefineLabels];
RETURN [node];
};
enable:
REF NodeRep.enable => {
scope: NodeList = enable.scope;
IF scope = NIL THEN RETURN [NIL];
RETURN [node];
Cutoff at this level, we will visit this later
};
ENDCASE;
IntCodeUtils.MapNode[node, DefineLabels];
RETURN [node];
};
FixVarLocation: IntCodeUtils.Visitor = {
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
local: REF LocationRep.localVar => local.parent ¬ parentLabel;
ENDCASE =>
IF var.location =
NIL
THEN {
loc: Location = z.NEW[LocationRep.localVar ¬ [localVar[0, parentLabel]]];
var.location ¬ loc;
};
ENDCASE;
RETURN [node];
};
AssignCodes: IntCodeUtils.Visitor = {
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
This procedure assigns upLevel codes to labels and substitutes for all upLevel gotos (as well as upLevel returns).
WITH node
SELECT
FROM
decl:
REF NodeRep.decl => {
We may have to redefine the parent for each variable defined, or, in a few case, we may have to promote the declaration outside of the artificial lambda.
var: Var = decl.var;
WITH var.location
SELECT
FROM
local:
REF LocationRep.localVar => {
IF var.flags[upLevel]
AND state = artificial
THEN {
Sigh, we have to move the declaration up the stack so it won't appear inside of an artificial lambda.
init: Node = decl.init;
IF init #
NIL
THEN node ¬ GenAssign[var, AssignCodes[init]]
ELSE node ¬ NIL;
promotedVars ¬ VarListCons[var, promotedVars];
RETURN [node];
};
};
ENDCASE;
[] ¬ FixVarLocation[var];
};
goto:
REF NodeRep.goto => {
label: Label = goto.dest;
IF definedTab = NIL THEN SIGNAL CantHappen;
WITH IntCodeUtils.Fetch[definedTab, label.id]
SELECT
FROM
entry: LabelEntry => {
IF entry.parent # parentLabel
THEN {
This is an uplevel goto, so we need to transform it into a return
rets: NodeList ¬ NIL;
IF entry.code = 0
THEN {
This is the first time encountered, so assign a code
labelCode ¬ labelCode + 1;
entry.code ¬ labelCode;
};
rets ¬ NodeListCons[GenConst[entry.code, bitsPerWord]];
SELECT state
FROM
artificial => {};
In a newly created lambda for the protected block
handler =>
In a lambda for the handler, so prepend an additional code
rets ¬ NodeListCons[upLevelCode, rets];
ENDCASE => SIGNAL CantHappen;
upLevelList ¬ InsertEntry[upLevelList, entry];
RETURN [GenReturn[rets]];
};
};
ENDCASE => SIGNAL CantHappen;
};
return:
REF NodeRep.return =>
SELECT state
FROM
normal => {};
No problem with this return; it is in a normal procedure
artificial => {
This return node must be transformed into an assignment to return temporaries (if necessary), and converted to a special return.
head: VarList ¬ returnVars;
retNode: Node ¬ GenReturn[NodeListCons[returnCode]];
IF returnLabelNode =
NIL
THEN {
In this case this is the first return we have seen for the enclosing normal lambda, so we have to define the return label.
labelNode: LabelNode = genLabel[NIL];
label: Label = labelNode.label;
entry: LabelEntry = DefineEntry[label, retLabelCounter, lambdaLabel];
upLevelList ¬ InsertEntry[upLevelList, entry];
returnLabelNode ¬ labelNode;
IF head =
NIL
THEN {
We need to create variables to match the return values
tail: VarList ¬ NIL;
FOR each: NodeList ¬ return.rets, each.rest
WHILE each #
NIL
DO
generate a temporary (in same order as the return list)
var: Var ¬ genTemp[lambdaLabel, each.first.bits];
new: VarList ¬ VarListCons[var];
IF tail = NIL THEN head ¬ new ELSE tail.rest ¬ new;
tail ¬ new;
ENDLOOP;
returnVars ¬ head;
};
};
IF return.rets #
NIL
THEN {
Add in the assignment to the return vars (as necessary)
retList: NodeList ¬ NodeListCons[retNode];
assigns: NodeList ¬ NIL;
IF head = NIL THEN SIGNAL CantHappen;
IntCodeUtils.MapNodeList[return.rets, AssignCodes];
Make sure that the returned values have been visited first!
Generate the assignments (in reverse order)
FOR each: NodeList ¬ return.rets, each.rest
WHILE each #
NIL
DO
append an assignment
val: Node = each.first;
var: Var ¬ NIL;
IF head = NIL THEN SIGNAL CantHappen;
var ¬ head.first;
IF val.bits # var.bits THEN SIGNAL CantHappen;
assigns ¬ NodeListCons[GenAssign[var, val, 0], assigns];
head ¬ head.rest;
ENDLOOP;
IF head #
NIL
THEN
SIGNAL CantHappen;
Append the assignments (now in correct order)
WHILE assigns #
NIL
DO
rest: NodeList = assigns.rest;
assigns.rest ¬ retList;
retList ¬ assigns;
assigns ¬ rest;
ENDLOOP;
Form the resulting block
retNode ¬ GenBlock[retList, 0];
};
RETURN [retNode];
};
ENDCASE => SIGNAL CantHappen;
labNode: LabelNode => {
label: Label = labNode.label;
WITH label.node
SELECT
FROM
lambda:
REF NodeRep.lambda => {
body: NodeList ¬ lambda.body;
oldLambdaLabel: Label = lambdaLabel;
oldReturnLabelNode: LabelNode = returnLabelNode;
oldReturnVars: VarList = returnVars;
returnLabelNode ¬ NIL;
returnVars ¬ NIL;
lambdaLabel ¬ label;
VisitScope[label, body, normal];
IF returnLabelNode #
NIL
THEN {
Sigh, we have to append the returnLabelNode and actually return the temps
retNodeList: NodeList ¬ NIL;
tail: NodeList ¬ NIL;
FOR each: VarList ¬ returnVars, each.rest
WHILE each #
NIL
DO
var: Var = each.first;
new: NodeList ¬ NodeListCons[var];
IF tail = NIL THEN retNodeList ¬ new ELSE tail.rest ¬ new;
tail ¬ new;
body ¬ NodeListCons[GenDecl[var,
NIL], body];
We have to declare this variable as well
ENDLOOP;
tail ¬ NodeListTail[body];
tail.rest ¬ NodeListCons2[returnLabelNode, GenReturn[retNodeList]];
lambda.body ¬ body;
};
returnLabelNode ¬ oldReturnLabelNode;
returnVars ¬ oldReturnVars;
lambdaLabel ¬ oldLambdaLabel;
RETURN [node];
};
ENDCASE;
};
apply:
REF NodeRep.apply =>
IF apply.handler #
NIL
THEN {
This call is protected by a handler. The cute question is: does the argument evaluation need further protection? Should this have been handled earlier in the compiler? For now we generate no additional code here.
bits: INT = apply.bits;
handler: Handler = apply.handler;
declHead: NodeList ¬ NIL;
declTail: NodeList ¬ NIL;
apply.handler ¬ NIL;
FOR each: NodeList ¬ apply.args, each.rest
WHILE each #
NIL
DO
arg: Node ¬ each.first;
IF
NOT IntCodeUtils.SideEffectFree[arg,
TRUE]
THEN {
temp: Var = genTemp[parentLabel, arg.bits];
new: NodeList ¬ NodeListCons[GenDecl[temp, arg]];
IF declTail = NIL THEN declHead ¬ new ELSE declTail.rest ¬ new;
declTail ¬ new;
each.first ¬ temp;
};
ENDLOOP;
IF
NOT IntCodeUtils.SideEffectFree[apply.proc,
TRUE]
THEN {
temp: Var = genTemp[parentLabel, apply.proc.bits];
new: NodeList ¬ NodeListCons[GenDecl[temp, apply.proc]];
IF declTail = NIL THEN declHead ¬ new ELSE declTail.rest ¬ new;
declTail ¬ new;
apply.proc ¬ temp;
};
node ¬ GenApply[apply.proc, apply.args, bits];
Note: TransformHandler will visit the scope, so we don't have to visit the arguments here!
IF bits = 0
THEN node ¬ TransformHandler[NodeListCons[node], handler, mostRecentSource]
No bits returned => No temporary needed
ELSE {
Sigh, need another temporary for the return
temp: Var = genTemp[parentLabel, bits];
scope: NodeList = NodeListCons[GenAssign[temp, node]];
node ¬ TransformHandler[scope, handler, mostRecentSource];
node ¬ GenBlock[NodeListCons3[GenDecl[temp, NIL], node, temp], bits];
};
IF declHead #
NIL
THEN {
We need a block to evaluate the declarations of temporaries
declTail.rest ¬ NodeListCons[node];
node ¬ GenBlock[declHead, bits];
};
RETURN [node];
};
enable:
REF NodeRep.enable => {
handler: Handler = enable.handle;
node ¬ TransformHandler[enable.scope, enable.handle, NIL];
RETURN [node];
};
source:
REF NodeRep.source => {
oldRecentSource: Node ¬ mostRecentSource;
mostRecentSource ¬ source;
FOR each: NodeList ¬ source.nodes, each.rest
WHILE each #
NIL
DO
each.first ¬ AssignCodes[each.first];
ENDLOOP;
mostRecentSource ¬ oldRecentSource;
RETURN [node];
};
module:
REF NodeRep.module => {
head: NodeList ¬ NIL;
tail: NodeList ¬ NIL;
MarkUpLevel[node];
We have to make sure that all upLevel references to variables are properly marked
FOR each: NodeList ¬ module.procs, each.rest
WHILE each #
NIL
DO
new: NodeList ¬ NodeListCons[AssignCodes[each.first]];
IF tail = NIL THEN head ¬ new ELSE tail.rest ¬ new;
tail ¬ new;
WHILE innerBlockList #
NIL
DO
next: NodeList ¬ innerBlockList.rest;
tail ¬ tail.rest ¬ innerBlockList;
innerBlockList ¬ next;
ENDLOOP;
ENDLOOP;
WHILE handlersList #
NIL
DO
next: NodeList ¬ handlersList.rest;
tail ¬ tail.rest ¬ handlersList;
handlersList ¬ next;
ENDLOOP;
module.procs ¬ head;
RETURN [node];
};
ENDCASE;
IntCodeUtils.MapNode[node, AssignCodes];
RETURN [node];
};
TransformHandler:
PROC
[scope: NodeList, handler: Handler, recentSource: Node]
RETURNS [Node] = {
Transform the scope into a nested procedure that returns a code (default 0) to indicate which up-level label to go to. Replace all RETURN nodes by assignment to the return temp followed by up-level go to nodes. Replace all GO TO nodes by returning assigned codes.
handleContext: Node = handler.context;
handleProc: Node = handler.proc;
scopeLambda: LambdaNode = z.
NEW[NodeRep.lambda ¬ [0, lambda[
parent: parentLabel,
descBody: NIL,
kind: scope,
bitsOut: bitsPerWord,
formalArgs: NIL,
body: scope]]];
applyNode: ApplyNode =
GenApply[
xrEnable,
NIL,
bitsPerWord];
procNode: LabelNode = genLabel[scopeLambda];
scopeLabel: Label = procNode.label;
retList: NodeList ¬ NIL;
assignNode: Node ¬ NIL;
oldUpLevelList: LabelsList ¬ upLevelList;
oldPromotedVars: VarList ¬ promotedVars;
IF state = normal THEN upLevelList ¬ NIL;
promotedVars ¬ NIL;
Recursively process the enabled scope
VisitScope[scopeLabel, scope, artificial];
scope ¬ NodeListTail[scope];
scope.rest ¬ NodeListCons[GenReturn[NodeListCons[zeroCode]]];
Finish things off with a return[0] for the normal case
WITH recentSource
SELECT
FROM
rs:
REF NodeRep.source => {
Put in a new source node to make the debugger happy
newSource: Node ¬ z.NEW[NodeRep.source
¬ [0, source[rs.source, scopeLambda.body]]];
scopeLambda.body ¬ NodeListCons[newSource];
};
ENDCASE;
Recursively process the handler
WITH handleProc
SELECT
FROM
labNode: LabelNode => {
label: Label = labNode.label;
loc: Location ¬ z.
NEW[LocationRep.stack ¬ [stack[0]]];
Special encoding for offset 0 in the frameExtension
applyNode.args ¬ NodeListCons3[
GenLabelAddress[scopeLabel, FALSE],
GenLabelAddress[label, FALSE],
GenAddr[GenAnonVar[0, loc]]];
IF label #
NIL
THEN
WITH label.node
SELECT
FROM
lambda:
REF NodeRep.lambda => {
lambda.parent ¬ parentLabel;
lambda.bitsOut ¬ 2*bitsPerWord;
VisitScope[label, lambda.body, handler];
};
ENDCASE => SIGNAL CantHappen;
};
ENDCASE => SIGNAL CantHappen;
IF upLevelList =
NIL
THEN {
No used levels, so no dispatch (unusual case?)
temp: Var ¬ GenDummy[bitsPerWord];
assignNode ¬ GenAssign[temp, applyNode];
}
ELSE {
We have to generate a case list
temp: Var ¬ genTemp[parentLabel, bitsPerWord];
cases: CaseList ¬ NIL;
cond: Node = CondFromLabelsList[temp, upLevelList];
IF cond # NIL THEN retList ¬ NodeListCons[cond, retList];
assignNode ¬ GenDecl[temp, applyNode];
FOR each: LabelsList ¬ upLevelList, each.rest
WHILE each #
NIL
DO
Retain the upLevel labels that refer to levels less than (above) this one.
entry: LabelEntry = each.first;
IF entry.parent # parentLabel
THEN
oldUpLevelList ¬ InsertEntry[oldUpLevelList, entry];
ENDLOOP;
};
retList ¬ NodeListCons[assignNode, retList];
handlersList ¬ NodeListCons[handleProc, handlersList];
innerBlockList ¬ NodeListCons[procNode, innerBlockList];
upLevelList ¬ oldUpLevelList;
IF promotedVars #
NIL
AND state # artificial
THEN {
This is the right place to promote the upLevel variables to, since we are outside of artificially induced procedures.
FOR each: VarList ¬ promotedVars, each.rest
WHILE each #
NIL
DO
var: Var ¬ NARROW[FixVarLocation[each.first]];
retList ¬ NodeListCons[GenDecl[var, NIL], retList];
ENDLOOP;
promotedVars ¬ NIL;
};
FOR each: VarList ¬ promotedVars, each.rest
WHILE each #
NIL
DO
oldPromotedVars ¬ VarListCons[each.first, oldPromotedVars];
ENDLOOP;
promotedVars ¬ oldPromotedVars;
RETURN [GenBlock[retList]];
};
DefineEntry:
PROC [label: Label, code:
INT, parentLabel: Label]
RETURNS [LabelEntry] = {
new: LabelEntry = z.NEW[LabelEntryRep ¬ [label, parentLabel, code]];
IF definedTab = NIL THEN definedTab ¬ IntCodeUtils.NewIdTab[];
IF parentLabel = NIL THEN SIGNAL CantHappen;
IF IntCodeUtils.Store[definedTab, label.id, new] # NIL THEN SIGNAL CantHappen;
RETURN [new];
};
CondFromLabelsList:
PROC [temp: Var, list: LabelsList]
RETURNS [Node] = {
cases: CaseList ¬ NIL;
WHILE list #
NIL
DO
entry: LabelEntry = list.first;
code: INTEGER = entry.code;
tests: NodeList = NodeListCons[GenEqTest[temp, entry.code]];
IF code > 0
THEN {
body: Node ¬ NIL;
IF entry.parent = parentLabel
THEN
The label is reachable at this level
body ¬ GenGoTo[entry.label]
ELSE {
We have to pass this return up at least one level
retList: NodeList ¬ NodeListCons[GenConst[code, bitsPerWord]];
SELECT state
FROM
artificial => {};
handler => retList ¬ NodeListCons[upLevelCode, retList];
ENDCASE => GO TO vanishedLabel;
body ¬ GenReturn[retList];
};
cases ¬ z.NEW[CaseListRep ¬ [tests: tests, body: body, rest: cases]];
EXITS vanishedLabel => {
This label has been propagated to this level, but cannot be reached, so we ignore it. This used to be impossible, but can now happen since we are more conservative about throwing away labels.
};
};
list ¬ list.rest;
ENDLOOP;
IF cases = NIL THEN RETURN [NIL];
RETURN [z.NEW[NodeRep.cond ¬ [0, cond[cases]]]];
};
MakeConst:
PROC [const:
INT]
RETURNS [Node] = {
SELECT const
FROM
0 => RETURN [zeroCode];
1 => RETURN [oneCode];
2 => RETURN [twoCode];
3 => RETURN [threeCode];
ENDCASE => RETURN [GenConst[const, bitsPerWord]];
};
Variables & constants global to RewriteEnables
definedTab: IntCodeUtils.IdTab ¬ NIL;
parentLabel: Label ¬ NIL;
labelCode:
INT ¬ initLabelCounter;
initLabelCounter: NAT = 1;
retLabelCounter: NAT = 1;
Return code
< 0 => illegal
0 => normal termination, flow through
1 => return temp rets
other => go to label coded
upLevelList: LabelsList ¬ NIL;
state: LambdaState ¬ none;
zeroCode: Node = GenConst[0, bitsPerWord];
oneCode: Node = GenConst[1, bitsPerWord];
twoCode: Node = GenConst[2, bitsPerWord];
threeCode: Node = GenConst[3, bitsPerWord];
returnCode: Node = MakeConst[retLabelCounter];
upLevelCode: Node = MakeConst[2];
lambdaLabel: Label ¬ NIL;
returnLabelNode: LabelNode ¬ NIL;
returnVars: VarList ¬ NIL;
xrEnable: Node = z.NEW[NodeRep.machineCode ¬ [0, machineCode["XR𡤎nable"]]];
innerBlockList: NodeList ¬ NIL;
handlersList: NodeList ¬ NIL;
promotedVars: VarList ¬ NIL;
mostRecentSource: Node ¬ NIL;
node ¬ AssignCodes[node];
RETURN [node];
};