
DIRECTORY
Basics32 USING [BITXOR],
IntCodeDefs USING [ApplyNode, AssignNode, BlockNode, CaseList, CommentNode, CompositeLocation, ConstNode, DeclNode, DerefLocation, EnableNode, EscapeLocation, FieldLocation, GlobalVarLocation, GotoNode, Handler, HandlerRep, IndexedLocation, Label, LabelNode, LabelRep, LambdaNode, LocalVarLocation, Location, LocationRep, LogicalId, MachineCodeNode, ModuleNode, Node, NodeList, NodeRep, nullVariableId, OperNode, OperRep, ReturnNode, SourceNode, Var, VariableFlags, VarList, WordConstNode],
IntCodeEnables USING [GenLabel, GenTemp, RewriteEnables],
IntCodeOpt USING [CleanupLambda, GenAnonLocal, SimplifyValueBlocks],
IntCodeStuff USING [addrOperNode, allocOperNode, BitsForArgList, constant0, constant1, constant2, CopyVar, defaultNIL, emptyReturn, freeOperNode, GenAddr, GenAnonVar, GenApply, GenAssign, GenBlock, GenComment, GenComposite, GenConst, GenDecl, GenDeref, GenDummy, GenField, GenFieldLoc, GenXFieldLoc, GenFieldLocOfVar, GenFieldOfDeref, GenFree, GenGoTo, GenLabelAddress, GenLargeReturn, GenReturn, GenUpLevel, globalLinkInit, MarkAddressed, MarkAssigned, MarkUsed, NodeContains, NodeListCons2, NodeListCons3, NodeListCons5, PadComposite, StripNilCheck, subOperNode],
IntCodeTarget USING [bitsPerAU, bitsPerGlobal, bitsPerLink, bitsPerLocal, directGlobals, firstGlobalOffset, lastRegister, lastStack, logBitsPerGlobal, logBitsPerLocal, logMinBitsPerArgument, logMinBitsPerReturn, maxBitsArgumentRecord, maxBitsReturnRecord, minBitsPerArgument, minBitsPerReturn, ToBits, ToUnits],
IntCodeTwig USING [BaseModel, BaseModelRep, DeclsFetch, DeclsSize, DeclsStore, Duplicate, LabelsFetch, LabelsSize, LabelsStore, LambdaModel, LambdaModelRep, ModelsFetch, ModelsStore, Switches],
IntCodeUtils USING [IdTab, LabelVisitor, MapNode, MapNodeList, NewIdTab, NodeListCons, NodeListTail, SideEffectFree, SimplyEqual, VarListCons, VarListTail, VisitLabels, Visitor, WordToCard, WordToInt, zone],
IO USING [PutF1, PutFR, PutFR1, STREAM],
ProcessProps USING [GetProp],
Rope USING [ROPE],
Target: TYPE MachineParms USING [AlignmentIndex, Alignments, bitsPerProc, bitsPerWord, bitsPerProcess];
IntCodeTwigImpl: CEDAR PROGRAM
IMPORTS Basics32, IntCodeEnables, IntCodeOpt, IntCodeStuff, IntCodeTarget, IntCodeTwig, IntCodeUtils, IO, ProcessProps
EXPORTS IntCodeTwig
= BEGIN OPEN IntCodeDefs, IntCodeEnables, IntCodeStuff, IntCodeTarget, IntCodeTwig, IntCodeUtils, Rope;

IdTab: TYPE = IntCodeUtils.IdTab;


smallExceptions: BOOL Ź FALSE;
simplifyValueBlocks: BOOL Ź TRUE;
useMemoryFromHandlers: BOOL = TRUE;
heapAllocFX: BOOL = FALSE;
cleanupCode: BOOL Ź TRUE;

indexedImpliesAddressedLimit: INT Ź LAST[INT];
localVarRegisterLimit: INT Ź LAST[INT];
firstMappedOffset: INT Ź 8*LONG[1024]*IntCodeTarget.bitsPerAU;

worst: NAT = Target.Alignments[Target.AlignmentIndex.LAST];
staticLinkOffset: NAT = 0;
firstLocalOffsetLinks: NAT = 4;
firstLocalOffset: NAT = firstLocalOffsetLinks*bitsPerLink;

z: ZONE Ź IntCodeUtils.zone;

rewriteEnables: PROC
[node: Node, genTemp: GenTemp, genLabel: GenLabel] RETURNS [Node] Ź NIL;

Duplicate: PUBLIC SIGNAL = CODE;

CantHappen: SIGNAL = CODE;

NotYetImplemented: SIGNAL = CODE;

DoModule: PUBLIC PROC [module: Node, switches: Switches] RETURNS [BaseModel] = {
ENABLE
CantHappen => IF switches['i] THEN {
RESUME;
};
RETURN [DoModuleInner[module, switches]];
};

DoModuleInner: PROC [module: Node, switches: Switches] RETURNS [BaseModel] = {
base: BaseModel Ź z.NEW[BaseModelRep Ź [
module: module,
labels: IntCodeUtils.NewIdTab[],
decls: IntCodeUtils.NewIdTab[],
models: IntCodeUtils.NewIdTab[]
]];

IF switches['h] OR rewriteEnables # NIL THEN {
genTemp: GenTemp = {
RETURN [IntCodeOpt.GenAnonLocal[base, parent, bits]];
};
genLabel: GenLabel = {
RETURN [GenAnonLabelNode[base, node]];
};
IF rewriteEnables # NIL
THEN module Ź rewriteEnables[module, genTemp, genLabel]
ELSE module Ź IntCodeEnables.RewriteEnables[module, genTemp, genLabel];
};

InitModels[base, module, NIL];
CanonVars[base, module, NIL];

FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
MarkUplevelLocals[base, m, m.lambda];
ENDLOOP;

IF simplifyValueBlocks THEN
FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
IntCodeOpt.SimplifyValueBlocks[base, m, m.lambda];
ENDLOOP;

IF lastStack # 0 THEN
FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
CheckStackDepth[base, m, m.lambda];
ENDLOOP;

FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
AllocMemLocals[base, m, m.lambda];
ENDLOOP;

FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
SubstUplevelLocals[base, m, m.lambda];
ENDLOOP;

FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
SubstLocals[base, m, m.lambda];
ENDLOOP;

IF cleanupCode THEN
FOR m: LambdaModel Ź base.first, m.next WHILE m # NIL DO
rtnPtr: Var Ź NIL;
IF m.returnVar # NIL THEN
WITH m.returnVar.location SELECT FROM
deref: REF LocationRep.deref =>
WITH deref.addr SELECT FROM
v: Var => rtnPtr Ź v;
ENDCASE;
ENDCASE;
IntCodeOpt.CleanupLambda[base, m, m.lambda, rtnPtr];
ENDLOOP;

WITH module SELECT FROM
m: ModuleNode => {
tail: NodeList Ź m.procs Ź NIL;
FOR lm: LambdaModel Ź base.first, lm.next WHILE lm # NIL DO
labelNode: LabelNode Ź z.NEW[NodeRep.label Ź [0, label[lm.label]]];
list: NodeList Ź NodeListCons[labelNode];
IF tail = NIL THEN m.procs Ź list ELSE tail.rest Ź list;
tail Ź list;
ENDLOOP;
};
ENDCASE;

RETURN [base];
};

InitModels: PROC [base: BaseModel, node: Node, model: LambdaModel] = {
inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
const: ConstNode => RETURN [node];
var: Var =>
WITH var.location SELECT FROM
local: LocalVarLocation => RETURN [node];
global: GlobalVarLocation => RETURN [node];
ENDCASE;
decl: DeclNode =>
AddVar[decl.var, model];
label: LabelNode => {
lab: Label Ź label.label;
IF lab # NIL THEN {
id: LogicalId Ź lab.id;
IF LabelsFetch[base, id] # lab THEN LabelsStore[base, id, lab];
WITH lab.node SELECT FROM
lambda: LambdaNode => {
newModel: LambdaModel Ź z.NEW[LambdaModelRep Ź [
label: lab,
lambda: lambda,
parentModel: NIL,
parentLabel: lambda.parent,
nesting: 0,
forceLong: id = 0]];
IF lambda.parent # NIL
AND lambda.descBody = NIL
AND lambda.formalArgs # NIL THEN
newModel.isCatch Ź TRUE;
ModelsStore[base, id, newModel];
IF base.tail = NIL
THEN base.first Ź newModel
ELSE base.tail.next Ź newModel;
base.tail Ź newModel;
InitModels[base, lambda, newModel];
RETURN [node];
};
ENDCASE;
};
};
lambda: LambdaNode => {
units: INT Ź 0;

model.returnBits Ź lambda.bitsOut;

FOR each: VarList Ź lambda.formalArgs, each.rest WHILE each # NIL DO
arg: Var Ź each.first;
IF arg # NIL THEN
units Ź units + ToUnits[arg.bits, minBitsPerArgument, logMinBitsPerArgument];
ENDLOOP;
model.argumentBits Ź ToBits[units, logMinBitsPerArgument];

IF model.forceLong OR model.argumentBits > maxBitsArgumentRecord
THEN {
oldArgList: VarList Ź lambda.formalArgs;
argPtr: Var Ź GenAnonVar[bitsPerLink];
argTemp: Var Ź GenDeref[argPtr, MAX[model.argumentBits, bitsPerLink], worst];
units: INT Ź 0;
model.argumentBits Ź bitsPerLink;
FOR each: VarList Ź oldArgList, each.rest WHILE each # NIL DO
arg: Var Ź each.first;
IF arg # NIL THEN {
bits: INT Ź ToBits[units, logMinBitsPerArgument];
arg.location Ź GenFieldLocOfVar[argTemp, bits];
AddVar[arg, model];
units Ź units + ToUnits[arg.bits, minBitsPerArgument, logMinBitsPerArgument];
};
ENDLOOP;
lambda.formalArgs Ź VarListCons[argPtr];
model.argVar Ź argTemp;
AddVar[argPtr, model];
}
ELSE {
FOR each: VarList Ź lambda.formalArgs, each.rest WHILE each # NIL DO
AddVar[each.first, model];
ENDLOOP;
};

IntCodeUtils.MapNodeList[lambda.body, inner];

IF model.returnVar # NIL OR HasLongReturnVar[model, model.returnBits] THEN
WITH model.returnVar.location SELECT FROM
deref: REF LocationRep.deref =>
WITH deref.addr SELECT FROM
rtnPtr: Var => {
AddVar[rtnPtr, model];
lambda.formalArgs Ź VarListCons[rtnPtr, lambda.formalArgs];
lambda.bitsOut Ź 0;
};
ENDCASE => SIGNAL CantHappen;
ENDCASE => SIGNAL CantHappen;

RETURN [node];
};
goto: GotoNode => {
label: Label = goto.dest;
SELECT TRUE FROM
label = NIL => {};
NOT label.used OR NOT label.jumpedTo => {};
goto.backwards AND NOT label.backTarget => {};
ENDCASE => RETURN [node];
SIGNAL CantHappen;
RETURN [node];
};
apply: ApplyNode => {
retBits: INT Ź apply.bits;
argBits: INT Ź BitsForArgList[apply.args];
units: INT Ź ToUnits[argBits, minBitsPerArgument, logMinBitsPerArgument];
tail: NodeList Ź NIL;
useLargeArgs: BOOL Ź argBits > maxBitsArgumentRecord;
useLargeRets: BOOL Ź retBits > minBitsPerReturn;
IntCodeUtils.MapNode[apply, inner];
WITH apply.proc SELECT FROM
mc: MachineCodeNode => RETURN [node];
oper: OperNode => {
args: NodeList Ź apply.args;
WITH oper.oper SELECT FROM
code: REF OperRep.code => {
IF code.label = NIL OR NOT code.label.used THEN SIGNAL CantHappen;
};
mesa: REF OperRep.mesa => {
SELECT mesa.mesa FROM
signal, error => IF apply.args = NIL THEN SIGNAL CantHappen ELSE {
first: Node Ź args.first;
rest: NodeList Ź args.rest;
nArgs: INT Ź 0;

FOR each: NodeList Ź rest, each.rest WHILE each # NIL DO
nArgs Ź nArgs + 1;
ENDLOOP;

IF smallExceptions THEN {
name: ROPE Ź NIL;
SELECT mesa.mesa FROM
error => SELECT nArgs FROM
0 => name Ź "XR_Error0";
1 => name Ź "XR_Error1";
2 => name Ź "XR_Error2";
ENDCASE => GO TO notSmall;
signal => {
IF retBits # 0 THEN GO TO notSmall;
SELECT nArgs FROM
0 => name Ź "XR_Signal0";
1 => name Ź "XR_Signal1";
2 => name Ź "XR_Signal2";
ENDCASE => GO TO notSmall;
};
ENDCASE => ERROR;
apply.proc Ź z.NEW[NodeRep.machineCode Ź
[bits: 0, details: machineCode[name]]];
GO TO ret;
EXITS notSmall => {};
};

IF rest = NIL
THEN rest Ź NodeListCons[defaultNIL]
ELSE {
apply.args Ź rest;
node Ź GenLargeArgs[base, apply, model];
rest Ź apply.args;
};
SELECT TRUE FROM
mesa.mesa = error => {};
retBits = 0 =>
rest Ź NodeListCons[defaultNIL, rest];
ENDCASE => {
addr: Node Ź NIL;
[new: node, addr: addr]
Ź GenLargeRets[base, model, node, retBits];
rest Ź NodeListCons[addr, rest];
};
apply.args Ź NodeListCons[first, rest];
GO TO ret;
};
fork => {
node Ź TransformFork[base, model, apply];
GO TO ret;
};
join => {
rtnBits: INT Ź node.bits;
node.bits Ź bitsPerLink;
IF rtnBits # 0 THEN {
result: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, rtnBits];
rtnPtr: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, bitsPerLink];
rtnSrc: Node Ź GenDeref[rtnPtr, rtnBits, worst];
head: NodeList Ź NodeListCons[GenDecl[result, NIL]];
tail: NodeList Ź head;
tail Ź tail.rest Ź NodeListCons[GenDecl[rtnPtr, node]];
tail Ź tail.rest Ź NodeListCons[GenAssign[result, rtnSrc]];
tail Ź tail.rest Ź NodeListCons[GenFree[rtnPtr]];
tail Ź tail.rest Ź NodeListCons[result];
RETURN [GenBlock[head, rtnBits]];
};
RETURN [GenAssign[GenDummy[bitsPerLink], node]];
};
resume, reject, unwind => {
[] Ź HasLongReturnVar[model, minBitsPerArgument*2];
GO TO checkArgs;
};
startGlobal => {
prog: Node Ź apply.args.first;
rest: NodeList Ź apply.args Ź apply.args.rest;
IF rest # NIL
THEN node Ź GenLargeArgs[base, apply, model]
ELSE apply.args Ź NodeListCons[defaultNIL];
apply.args Ź NodeListCons[prog, apply.args];
IF retBits = 0
THEN apply.args Ź NodeListCons[defaultNIL, apply.args]
ELSE {
addr: Node Ź NIL;
[node, addr] Ź GenLargeRets[base, model, node, retBits];
apply.args Ź NodeListCons[addr, apply.args];
};
GO TO ret;
};
addr => apply.proc Ź addrOperNode;
free => apply.proc Ź freeOperNode;
alloc => apply.proc Ź allocOperNode;
ENDCASE;
GO TO ret;
};
ENDCASE => GO TO ret;
EXITS checkArgs => {};
};
ENDCASE;
IF useLargeArgs THEN
node Ź GenLargeArgs[base, apply, model];
IF useLargeRets THEN {
addr: Node Ź NIL;
[node, addr] Ź GenLargeRets[base, model, node, retBits];
apply.args Ź NodeListCons[addr, apply.args];
};
GO TO ret;
EXITS ret => RETURN [node];
};
return: ReturnNode => {
IF return.rets = NIL THEN RETURN [emptyReturn];
IntCodeUtils.MapNode[node, inner];
node Ź CanonReturn[return, model];
RETURN [node];
};
module: ModuleNode => {
offset: INT Ź IntCodeTarget.firstGlobalOffset;
FOR each: VarList Ź module.vars, each.rest WHILE each # NIL DO
var: Var Ź each.first;
IF var # NIL THEN {
bits: INT Ź var.bits;
units: INT Ź ToUnits[bits, IntCodeTarget.bitsPerGlobal, IntCodeTarget.logBitsPerGlobal];
round: INT Ź ToBits[units, IntCodeTarget.logMinBitsPerArgument];
loc: Location Ź z.NEW[LocationRep.globalVar Ź [globalVar[offset]]];
var.location Ź loc;
DeclsStore[base, var.id, var];
offset Ź offset + round;
};
ENDLOOP;
};
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
AddVar: PROC [var: Var, model: LambdaModel] = {
IF var # NIL AND model # NIL AND DeclsFetch[base, var.id] = NIL THEN {
IF var.id = nullVariableId THEN
var.id Ź -DeclsSize[base]-1;
IF var.location = NIL THEN
var.location Ź z.NEW[LocationRep.localVar Ź [localVar[var.id, model.label]]];
DeclsStore[base, var.id, var];
};
};
canonLabels: IntCodeUtils.LabelVisitor = {
IF NOT define THEN {
new: Label Ź LabelsFetch[base, label.id];
IF new # NIL THEN RETURN [new];
};
RETURN [label];
};
[] Ź inner[node];
IF model = NIL THEN
IntCodeUtils.VisitLabels[node: node, visitor: canonLabels, fullTree: TRUE, visitNIL: FALSE];
};

CanonVars: PROC [base: BaseModel, node: Node, model: LambdaModel] = {
inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
var: Var => {
canon: Var Ź DeclsFetch[base, var.id];
IF canon # NIL THEN {
WITH canon.location SELECT FROM
local: LocalVarLocation => {
parent: Label Ź IF model = NIL THEN NIL ELSE model.label;
IF local.parent # parent THEN canon.flags[upLevel] Ź TRUE;
};
global: GlobalVarLocation => IF NOT IntCodeTarget.directGlobals THEN {
IF model # NIL AND model.globalLink = NIL THEN
model.globalLink Ź IntCodeOpt.GenAnonLocal[base, model.label, bitsPerLink];
};
ENDCASE;
var Ź canon;
};
WITH var.location SELECT FROM
local: LocalVarLocation => {
IF var.bits > localVarRegisterLimit THEN
MarkAddressed[var];
};
indexed: IndexedLocation => {
base: Node Ź indexed.base Ź inner[indexed.base];
index: Node Ź indexed.index Ź inner[indexed.index];
WITH index SELECT FROM
const: WordConstNode => {
val: INT Ź IntCodeUtils.WordToInt[const.word];
var.location Ź GenFieldLoc[base, val*var.bits];
};
ENDCASE =>
IF base # NIL AND base.bits > indexedImpliesAddressedLimit THEN
MarkAddressed[base];
};
ENDCASE => IntCodeUtils.MapNode[var, inner];
RETURN [var];
};
decl: DeclNode => {
var: Var Ź DeclsFetch[base, decl.var.id];
decl.init Ź inner[decl.init];
RETURN [node];
};
labelNode: LabelNode => {
label: Label = labelNode.label;
IF label # NIL THEN {
id: LogicalId Ź label.id;
WITH label.node SELECT FROM
lambda: LambdaNode => {
newModel: LambdaModel Ź ModelsFetch[base, id];
lambda.descBody Ź NARROW[inner[lambda.descBody]];
CanonLambda[base, newModel, lambda];
IF newModel.isCatch THEN
[] Ź GetHandlerArgs[newModel];
RETURN [node];
};
ENDCASE;
};
};
enable: EnableNode => {
handler: Handler Ź enable.handle;
IF handler # NIL THEN {
proc: Node Ź handler.proc;
handler.proc Ź MarkCatch[base, proc];
[] Ź inner[proc];
};
};
assign: AssignNode => {
IntCodeUtils.MapNode[node, inner];
IF assign.lhs # NIL AND assign.lhs.id # nullVariableId THEN
assign.lhs.flags[assigned] Ź TRUE;
RETURN [node];
};
apply: ApplyNode => {
handler: Handler Ź apply.handler;
IF handler # NIL THEN {
proc: Node Ź handler.proc;
handler.proc Ź MarkCatch[base, proc];
[] Ź inner[proc];
};
IntCodeUtils.MapNode[node, inner];
WITH apply.proc SELECT FROM
oper: OperNode => {
WITH oper.oper SELECT FROM
mesa: REF OperRep.mesa =>
SELECT mesa.mesa FROM
addr => {
args: NodeList Ź apply.args;
IF args # NIL THEN MarkAddressed[args.first];
};
ENDCASE;
ENDCASE;
};
ENDCASE;
RETURN [node];
};
block: BlockNode => {
list: NodeList Ź block.nodes;
count: INT Ź 0;
decl0: DeclNode Ź NIL;
assign1: AssignNode Ź NIL;
var1: Var Ź NIL;
var2: Var Ź NIL;
FOR each: NodeList Ź list, each.rest WHILE each # NIL DO
WITH each.first SELECT FROM
decl: DeclNode =>
IF count = 0 THEN decl0 Ź decl ELSE decl0 Ź NIL;
assign: AssignNode =>
IF count = 1 THEN assign1 Ź assign ELSE assign1 Ź NIL;
var: Var => {
IF count = 1 THEN var1 Ź var ELSE var1 Ź NIL;
IF count = 2 THEN var2 Ź var ELSE var2 Ź NIL;
};
ENDCASE;
count Ź count + 1;
IF count > 3 THEN EXIT;
ENDLOOP;
SELECT count FROM
1 => IF decl0 = NIL THEN
RETURN [inner[list.first]];
2 => IF decl0 # NIL AND decl0.var = var1 THEN
RETURN [inner[decl0.init]];
3 => IF decl0 # NIL AND decl0.var = var2 AND decl0.init = NIL
AND assign1 # NIL AND assign1.lhs = var2 THEN
IF NOT NodeContains[assign1.rhs, var2] THEN
RETURN [inner[assign1.rhs]];
ENDCASE;
};
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
[] Ź inner[node];
};

DetermineNesting: PROC [base: BaseModel, model: LambdaModel] = {
parent: Label Ź model.parentLabel;
IF parent # NIL AND model.nesting = 0 THEN {
parentModel: LambdaModel Ź ModelsFetch[base, parent.id];
IF parentModel # NIL THEN {
DetermineNesting[base, parentModel];
model.parentModel Ź parentModel;
model.parentLabel Ź parentModel.label;
model.nesting Ź parentModel.nesting + 1;
};
};
};

CanonLambda: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
IF model # NIL AND model.parentLabel # NIL AND model.parentModel = NIL THEN
DetermineNesting[base, model];
CanonVars[base, lambda, model];

SELECT TRUE FROM
model.isCatch => {
model.staticLink Ź GetHandlerArgs[model].regsPtr;
model.returnBits Ź 2*bitsPerLink;
};
lambda.parent # NIL => {
static: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, bitsPerLink];
staticList: VarList Ź VarListCons[static];
model.staticLink Ź static;
IF lambda.formalArgs = NIL
THEN lambda.formalArgs Ź staticList
ELSE VarListTail[lambda.formalArgs].rest Ź staticList;
};
ENDCASE;

IF model.globalLink # NIL THEN {
decl: Node Ź GenDecl[model.globalLink, globalLinkInit];
model.globalLink.flags[frequent] Ź TRUE;
lambda.body Ź NodeListCons[decl, lambda.body];
};
};

CheckStackDepth: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
inner: IntCodeUtils.Visitor = {
oldDepth: INT Ź depth;
IF depth > lastStack THEN ERROR CantHappen;
IF node = NIL OR CanSimplyPush[node, depth] THEN RETURN [node];
WITH node SELECT FROM
decl: DeclNode => {
var: Var Ź decl.var;
IF var # NIL AND NOT var.flags[notRegister] THEN
WITH var.location SELECT FROM
local: LocalVarLocation => {
units: INT Ź ToUnits[var.bits, bitsPerLocal, logBitsPerLocal];
next: INT Ź depth+units;
IF next > lastRegister
THEN {
var.flags[notRegister] Ź TRUE;
}
ELSE {
depth Ź next;
IF depth > max THEN max Ź depth;
};
};
ENDCASE;
decl.init Ź inner[decl.init];
RETURN [node];
};
apply: ApplyNode => {
args: NodeList Ź apply.args;
argsUnits: INT Ź ToUnits[BitsForArgList[args], bitsPerLocal, logBitsPerLocal];
tail: NodeList Ź NIL;
lastTemp: INT Ź lastStack-maxBitsArgumentRecord/bitsPerLocal;
PutArgInMemory: PROC [arg: Node] RETURNS [Var] = {
var: Var Ź GenMemTemp[base, arg.bits, model];
new: NodeList Ź NodeListCons[GenDecl[var, inner[arg]]];
var.flags[constant] Ź TRUE;
IF tail = NIL
THEN {
new.rest Ź NodeListCons[apply];
node Ź GenBlock[new, apply.bits];
}
ELSE {
new.rest Ź tail.rest;
tail.rest Ź new;
};
tail Ź new;
RETURN [var];
};

IF NOT CanSimplyPush[apply.proc, depth+argsUnits] THEN
apply.proc Ź PutArgInMemory[apply.proc];

SELECT TRUE FROM
args = NIL =>
GO TO commonExit;
args.rest = NIL => {
args.first Ź inner[args.first];
GO TO commonExit;
};
ENDCASE;
WITH apply.proc SELECT FROM
oper: OperNode => {
WITH oper.oper SELECT FROM
code: REF OperRep.code => GO TO useProcApply;
mesa: REF OperRep.mesa =>
SELECT mesa.mesa FROM
addr, equal, notEqual => GO TO useAddrs;
ENDCASE;
ENDCASE;
FOR each: NodeList Ź args, each.rest WHILE each # NIL DO
arg: Node Ź each.first;
units: INT Ź ToUnits[arg.bits, minBitsPerArgument, logMinBitsPerArgument];
SELECT TRUE FROM
depth <= lastTemp, CanSimplyPush[arg, depth+argsUnits] =>
each.first Ź inner[arg];
ENDCASE =>
each.first Ź PutArgInMemory[arg];
ENDLOOP;
GO TO commonExit;
EXITS
useProcApply => {};
useAddrs => {
localsPerLink: NAT = bitsPerLink/bitsPerLocal;
FOR each: NodeList Ź args, each.rest WHILE each # NIL DO
depth Ź depth + localsPerLink;
ENDLOOP;
FOR each: NodeList Ź args, each.rest WHILE each # NIL DO
each.first Ź inner[each.first];
ENDLOOP;
GO TO commonExit;
};
};
ENDCASE;
FOR each: NodeList Ź args, each.rest WHILE each # NIL DO
arg: Node Ź each.first;
units: INT Ź ToUnits[arg.bits, minBitsPerArgument, logMinBitsPerArgument];
next: INT Ź units+depth;
SELECT TRUE FROM
next <= lastTemp => {
depth Ź next;
each.first Ź inner[arg];
};
CanSimplyPush[arg, depth] =>
each.first Ź inner[arg];
ENDCASE =>
each.first Ź PutArgInMemory[arg];
ENDLOOP;
GO TO commonExit;
EXITS commonExit => {
depth Ź oldDepth;
RETURN [node];
};
};
lambda: LambdaNode => RETURN [node];
source: SourceNode => {
FOR each: NodeList Ź source.nodes, each.rest WHILE each # NIL DO
each.first Ź inner[each.first];
ENDLOOP;
RETURN [node];
};
ENDCASE;
IntCodeUtils.MapNode[node, inner];
depth Ź oldDepth;
RETURN [node];
};
depth: INT Ź ToUnits[model.argumentBits, minBitsPerArgument, logMinBitsPerArgument];
max: INT Ź depth;
localsPerLink: NAT = bitsPerLink/bitsPerLocal;
IF model.returnVar # NIL THEN depth Ź depth+localsPerLink;
IF model.globalLink # NIL THEN depth Ź depth+localsPerLink;
IntCodeUtils.MapNode[lambda, inner];
};

MarkUplevelLocals: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
var: Var => {
WITH var.location SELECT FROM
local: LocalVarLocation => {
IF model # NIL AND var.flags[upLevel] THEN {
target: Label = local.parent;
IF target # NIL AND target # model.label THEN {
notRegister: BOOL Ź var.flags[notRegister];
FOR mod: LambdaModel Ź model, mod.parentModel DO
SELECT TRUE FROM
mod = NIL => {
VarCantHappen[var, "ref to non-enclosing lambda"];
EXIT};
mod.label = target => {
var.flags[notRegister] Ź notRegister;
RETURN [CopyVar[var]];
};
mod.staticLink = NIL => {
VarCantHappen[var, "can't find static link"];
EXIT};
ENDCASE;
IF useMemoryFromHandlers OR NOT mod.isCatch THEN
notRegister Ź TRUE;
ENDLOOP;
};
};
RETURN [node];
};
deref: DerefLocation => {
old: Node Ź deref.addr;
IF old # NIL THEN {
new: Node Ź inner[old];
IF new # old THEN {
nVar: Var Ź CopyVar[var];
nVar.location Ź z.NEW[LocationRep.deref Ź [deref[new, deref.align]]];
RETURN [nVar];
};
};
RETURN [var];
};
field: FieldLocation => {
old: Node Ź field.base;
IF old # NIL THEN {
new: Node Ź inner[old];
IF new # old THEN {
nVar: Var Ź CopyVar[var];
IF field.cross 
THEN nVar.location Ź GenXFieldLoc[new, field.start] --ChJ, May 4, 1993
ELSE nVar.location Ź GenFieldLoc[new, field.start];
RETURN [nVar];
};
};
RETURN [var];
};
indexed: IndexedLocation => {
base: Node Ź indexed.base;
index: Node Ź indexed.index;
IF base # NIL THEN base Ź inner[base];
IF index # NIL THEN index Ź inner[index];
IF base # indexed.base OR index # indexed.index THEN {
nVar: Var Ź CopyVar[var];
nVar.location Ź z.NEW[LocationRep.indexed Ź [indexed[base, index]]];
RETURN [nVar];
};
RETURN [var];
};
composite: CompositeLocation => {
FOR each: NodeList Ź composite.parts, each.rest WHILE each # NIL DO
old: Node Ź each.first;
IF old # NIL THEN {
new: Node Ź inner[old];
IF old # new THEN {
nVar: Var Ź CopyVar[var];
head: NodeList Ź NIL;
tail: NodeList Ź NIL;
nLoc: REF LocationRep.composite
Ź z.NEW[LocationRep.composite Ź [composite[NIL]]];
FOR lead: NodeList Ź composite.parts, lead.rest WHILE lead # each DO
copy: NodeList Ź NodeListCons[lead.first];
IF tail = NIL THEN nLoc.parts Ź copy ELSE tail.rest Ź copy;
tail Ź copy;
ENDLOOP;
IF tail = NIL
THEN tail Ź nLoc.parts Ź NodeListCons[new]
ELSE tail Ź tail.rest Ź NodeListCons[new];
FOR lead: NodeList Ź each.rest, lead.rest WHILE lead # NIL DO
copy: NodeList Ź NodeListCons[old Ź lead.first];
IF old # NIL THEN copy.first Ź inner[old];
tail Ź tail.rest Ź copy;
ENDLOOP;
nVar.location Ź nLoc;
RETURN [nVar];
};
};
ENDLOOP;
RETURN [var];
};
escape: EscapeLocation => {
base: Node Ź escape.base;
IF base # NIL THEN {
base Ź inner[base];
IF base # escape.base THEN {
nVar: Var Ź CopyVar[var];
nVar.location Ź z.NEW[LocationRep.escape
Ź [escape[id: escape.id, base: base, offset: escape.offset]]];
RETURN [nVar];
};
};
RETURN [var];
};
ENDCASE;
};
return: ReturnNode =>
node Ź CanonReturn[return, model];
apply: ApplyNode => {
WITH apply.proc SELECT FROM
oper: OperNode => {
args: NodeList Ź apply.args;
WITH oper.oper SELECT FROM
mesa: REF OperRep.mesa => {
SELECT mesa.mesa FROM
reject => {
rets: NodeList Ź NodeListCons[constant0, NodeListCons[constant0]];
node Ź GenReturn[rets];
GO TO fixReturn;
};
resume => {
rets: NodeList Ź NodeListCons[constant1, NodeListCons[constant0]];
node Ź GenReturn[rets];
IF args # NIL THEN {
comp: Node Ź PadComposite[args, logMinBitsPerReturn];
dest: Var Ź GenDeref[
GetHandlerArgs[model].rtnPtr, comp.bits, worst];
assign: Node Ź GenAssign[dest, comp];
node Ź GenBlock[NodeListCons2[assign, node]];
};
GO TO fixReturn;
};
unwind => {
rets: NodeList Ź NodeListCons[constant2, args];
node Ź GenReturn[rets];
GO TO fixReturn;
};
ENDCASE;
EXITS fixReturn => RETURN [inner[node]];
};
ENDCASE;
};
ENDCASE;
};
lambda: LambdaNode => RETURN [node];
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
IntCodeUtils.MapNode[lambda, inner];
};

AllocMemLocals: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
var: Var => WITH var.location SELECT FROM
stack: REF LocationRep.stack => forceExtension Ź TRUE;
ENDCASE;
decl: DeclNode => CountVar[decl.var];
block: BlockNode => {
oldDepth: INT Ź model.memDepth;
IntCodeUtils.MapNode[node, inner];
model.memDepth Ź oldDepth;
RETURN [node];
};
enable: EnableNode => IF enable.handle # NIL THEN forceExtension Ź TRUE;
apply: ApplyNode => IF apply.handler # NIL THEN forceExtension Ź TRUE;
lambda: LambdaNode => RETURN [node];
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
CountVar: PROC [var: Var] = {
WITH var.location SELECT FROM
local: LocalVarLocation =>
SELECT TRUE FROM
NOT var.flags[notRegister] => {};
NOT heapAllocFX AND NOT var.flags[upLevel] => {};
ENDCASE => {
units: INT Ź ToUnits[var.bits, bitsPerLocal, logBitsPerLocal];
depth: INT Ź model.memDepth;
IF local.parent # model.label THEN {
varId: Rope.ROPE = IF local.parent = NIL
THEN "??"
ELSE IO.PutFR1["%g", [integer[local.parent.id]] ];
modelId: Rope.ROPE = IF model.label = NIL
THEN "??"
ELSE IO.PutFR1["%g", [integer[model.label.id]] ];
VarCantHappen[var, IO.PutFR["%g # %g", [rope[varId]], [rope[modelId]] ]];
};
local.id Ź depth;
IF (model.memDepth Ź depth + units) > model.memMax THEN
model.memMax Ź model.memDepth;
};
stack: REF LocationRep.stack => forceExtension Ź TRUE;
ENDCASE => VarCantHappen[var, "location not stack, not local"];
};
forceExtension: BOOL Ź FALSE;
model.memDepth Ź model.memMax Ź firstLocalOffsetLinks;
FOR each: VarList Ź lambda.formalArgs, each.rest WHILE each # NIL DO
CountVar[each.first];
ENDLOOP;
IntCodeUtils.MapNode[lambda, inner];
IF model.memMax = firstLocalOffsetLinks AND NOT forceExtension
THEN
model.memDepth Ź model.memMax Ź 0
ELSE {
memBits: INT Ź ToBits[model.memMax, logBitsPerLocal];
fxLink: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, bitsPerLink];
fxSpace: Var Ź model.frameExtension Ź IF heapAllocFX
THEN GenDeref[fxLink, memBits, worst]
ELSE IntCodeOpt.GenAnonLocal[base, model.label, memBits];
fxLink.flags[frequent] Ź TRUE;
IF model.staticLink # NIL THEN
lambda.body Ź NodeListCons[
GenAssign[
lhs: GenField[fxSpace, staticLinkOffset, bitsPerLink],
rhs: model.staticLink],
lambda.body];
IF heapAllocFX
THEN {
model.memoryLink Ź fxLink;
AddFrameExtension[base, model, lambda];
}
ELSE {
IF lambda.body = NIL THEN
lambda.body Ź NodeListCons[GenComment["entry point"]];
model.entryPoint Ź lambda.body;
IF NOT useMemoryFromHandlers THEN {
model.memoryLink Ź fxLink;
lambda.body Ź NodeListCons[
GenDecl[var: fxLink, init: GenAddr[fxSpace]],
lambda.body];
};
lambda.body Ź NodeListCons[
GenDecl[var: fxSpace, init: NIL],
lambda.body];
fxSpace.flags[notRegister] Ź FALSE;
};
};
};

AddFrameExtension: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
link: Var Ź model.memoryLink;
ext: Var Ź model.frameExtension;

bits: INT Ź ext.bits;
units: INT Ź ToUnits[bits, minBitsPerArgument, logMinBitsPerArgument];
alloc: Node Ź GenDecl[link, GenApply[allocOperNode,
NodeListCons[GenConst[units, minBitsPerArgument]]]];
free: Node Ź GenFree[link];
freeExit: LabelNode Ź SELECT model.returnBits FROM
0, > maxBitsReturnRecord => GenAnonLabelNode[base, free],
ENDCASE => NIL;

inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
return: ReturnNode => {
IF freeExit # NIL THEN
RETURN [GenGoTo[freeExit.label]];
IF return.rets = NIL
THEN SIGNAL CantHappen
ELSE {
clean: NodeList Ź NodeListCons[free];
NodeListTail[return.rets].rest Ź clean;
};
RETURN [node];
};
lambda: LambdaNode => RETURN [node];
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};

lambda.body Ź NodeListCons[
alloc,
model.entryPoint Ź NodeListCons[
z.NEW[NodeRep.enable Ź [0, enable[
handle: z.NEW[HandlerRep Ź [context: link, proc: NIL]],
scope: lambda.body]]],
IF freeExit # NIL THEN NodeListCons[freeExit] ELSE NIL
]];

IntCodeUtils.MapNode[lambda, inner];
};

SubstUplevelLocals: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
var: Var => {
WITH var.location SELECT FROM
local: LocalVarLocation => {
target: Label = local.parent;
SELECT target FROM
model.label => {
};
# NIL => {
link: Var Ź model.staticLink;
mod: LambdaModel Ź model;
fromCatch: BOOL Ź mod.isCatch;
DO
parentModel: LambdaModel Ź mod.parentModel;
SELECT TRUE FROM
target = mod.parentLabel => {
inRegister: BOOL Ź NOT var.flags[notRegister];
offset: INT Ź ToBits[local.id, logBitsPerLocal];
bits: INT Ź var.bits;
SELECT TRUE FROM
fromCatch AND NOT useMemoryFromHandlers => {
IF inRegister THEN RETURN [GenUpLevel[link, var]];
link Ź GenUpLevel[link, mod.parentModel.memoryLink];
};
parentModel # NIL AND parentModel.staticLink = var => {
link Ź mod.staticLink;
offset Ź staticLinkOffset;
};
inRegister => VarCantHappen[var, "SubstUplevelLocals"];
ENDCASE;
IF link = NIL
THEN VarCantHappen[var, "SubstUplevelLocals"]
ELSE RETURN [GenFieldOfDeref[link, offset, bits]];
};
ENDCASE => {
next: LambdaModel Ź mod.parentModel;
IF next = NIL OR next.staticLink = NIL THEN {
VarCantHappen[var, "SubstUplevelLocals"];
EXIT;
};
SELECT TRUE FROM
useMemoryFromHandlers OR NOT fromCatch =>
link Ź GenFieldOfDeref[link, staticLinkOffset, bitsPerLink];
ENDCASE =>
link Ź GenUpLevel[link, next.staticLink];
fromCatch Ź mod.isCatch;
mod Ź next;
};
ENDLOOP;
};
ENDCASE => VarCantHappen[var, "SubstUplevelLocals"];
RETURN [node];
};
global: GlobalVarLocation => IF NOT IntCodeTarget.directGlobals THEN
IF model.globalLink # NIL THEN {
gVar: Var Ź GenFieldOfDeref[model.globalLink, global.id, var.bits];
gVar.id Ź var.id;
RETURN [gVar];
};
stack: REF LocationRep.stack => {
ext: Var = model.frameExtension;
new: Node Ź ext;
IF ext = NIL THEN ERROR CantHappen;
new Ź GenField[new, stack.offset*IntCodeTarget.bitsPerAU, node.bits];
RETURN [new];
};
ENDCASE;
};
lambda: LambdaNode => RETURN [node];
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
IntCodeUtils.MapNode[lambda, inner];
};

SubstLocals: PROC [base: BaseModel, model: LambdaModel, lambda: LambdaNode] = {
innerVar: PROC [var: Var] RETURNS [Var] = {
IF var # NIL THEN {
loc: Location Ź var.location;
WITH loc SELECT FROM
local: LocalVarLocation => {
SELECT TRUE FROM
NOT var.flags[notRegister] => {};
NOT heapAllocFX AND NOT var.flags[upLevel] => {};
var = model.frameExtension => {};
ENDCASE => {
target: Label = local.parent;
SELECT target FROM
model.label => {
ext: Var Ź model.frameExtension;
IF ext = NIL
THEN VarCantHappen[var, "SubstLocals"]
ELSE var.location Ź
GenFieldLocOfVar[ext, ToBits[local.id, logBitsPerLocal]];
};
ENDCASE => SIGNAL CantHappen;
};
};
field: FieldLocation => {
base: Node Ź field.base Ź inner[field.base];
WITH base SELECT FROM
fv: Var => WITH fv.location SELECT FROM
ff: FieldLocation => {
IF ff.cross#field.cross 
THEN {
IF fv.bits >= Target.bitsPerWord 
THEN { 
-- we should test if the basefield.start is a multiple of words LAI
field.start _ field.start + ff.start;
}
ELSE {
field.start _ field.start + Basics32.BITXOR[ff.start + fv.bits-1, Target.bitsPerWord-1]
};
}
ELSE {
field.start Ź field.start + ff.start;
};
field.base Ź ff.base;
};
fd: DerefLocation => IF NOT var.flags[addressed] THEN {
addr: Node Ź StripNilCheck[fd.addr];
IF addr # fd.addr THEN {
IF field.start < firstMappedOffset
THEN fd.addr Ź addr
ELSE addr Ź fd.addr;
};
};
ENDCASE;
ENDCASE;
};
indexed: IndexedLocation => {
derefLoc: DerefLocation Ź NIL;
WITH indexed.base SELECT FROM
var: Var => WITH var.location SELECT FROM
field: FieldLocation => IF field.start < firstMappedOffset THEN
WITH field.base SELECT FROM
fv: Var => WITH fv.location SELECT FROM
deref: DerefLocation => derefLoc Ź deref;
ENDCASE;
ENDCASE;
deref: DerefLocation => derefLoc Ź deref;
ENDCASE;
ENDCASE;
IF derefLoc # NIL THEN {
derefAddr: Node Ź derefLoc.addr;
stripped: Node Ź StripNilCheck[derefAddr];
index: Node Ź indexed.index;
IF stripped # derefAddr
AND IntCodeUtils.SideEffectFree[stripped, FALSE]
AND IntCodeUtils.SideEffectFree[index, FALSE] THEN {
scanner: IntCodeUtils.Visitor = {
IF derefAddr # NIL THEN {
WITH node SELECT FROM
var: Var => WITH var.location SELECT FROM
deref: DerefLocation => {
ds: Node Ź StripNilCheck[deref.addr];
IF ds = stripped THEN GO TO noMap;
IF IntCodeUtils.SimplyEqual[ds, stripped] THEN GO TO noMap;
};
ENDCASE;
ENDCASE;
IntCodeUtils.MapNode[node, scanner];
EXITS noMap => {derefAddr Ź NIL};
};
RETURN [node];
};

WITH index SELECT FROM
wc: WordConstNode => {
x: CARD Ź IntCodeUtils.WordToCard[wc.word];
sz: CARD Ź var.bits;
IF x < CARD[firstMappedOffset]/sz THEN derefAddr Ź NIL;
};
ENDCASE => {
[] Ź scanner[index];
};
IF derefAddr = NIL THEN
derefLoc.addr Ź stripped;
};
};
};
ENDCASE => IF loc = NIL THEN VarCantHappen[var, "SubstLocals"];
};
RETURN [var];
};
inner: IntCodeUtils.Visitor = {
WITH node SELECT FROM
var: Var => {
var Ź innerVar[var];
MarkUsed[var];
};
decl: DeclNode => {
decl.var Ź innerVar[decl.var];
decl.init Ź inner[decl.init];
RETURN [node];
};
assign: AssignNode => {
MarkAssigned[assign.lhs];
};
lambda: LambdaNode => RETURN [node];
apply: ApplyNode =>
IF apply.handler # NIL THEN
IF apply.handler.context = NIL AND model.frameExtension # NIL THEN
apply.handler.context Ź GenAddr[model.frameExtension];
enable: EnableNode =>
IF enable.handle # NIL THEN
IF enable.handle.context = NIL AND model.frameExtension # NIL THEN
enable.handle.context Ź GenAddr[model.frameExtension];
ENDCASE;
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
IntCodeUtils.MapNode[lambda, inner];
IF model.frameExtension # NIL AND lambda.formalArgs # NIL THEN {
tail: NodeList Ź NIL;
head: NodeList Ź NIL;
lag: NodeList Ź NIL;
FOR each: VarList Ź lambda.formalArgs, each.rest WHILE each # NIL DO
var: Var Ź each.first;
WITH var.location SELECT FROM
local: LocalVarLocation => {};
register: REF LocationRep.register => {};
ENDCASE => {
anon: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, var.bits];
assign: NodeList Ź NodeListCons[GenDecl[var, anon]];
each.first Ź anon;
IF tail = NIL THEN head Ź assign ELSE tail.rest Ź assign;
tail Ź assign;
};
ENDLOOP;
IF tail # NIL THEN {
FOR each: NodeList Ź lambda.body, each.rest WHILE each # NIL DO
IF each = model.entryPoint THEN {
tail.rest Ź each;
IF lag = NIL THEN SIGNAL CantHappen;
lag.rest Ź head;
EXIT;
};
lag Ź each;
ENDLOOP;
};
};
{
parent: Label Ź lambda.parent;
descBody: Var Ź lambda.descBody;
lambda.descBody Ź NIL;
IF descBody # NIL AND NOT model.isCatch THEN {
staticLink: Var Ź model.staticLink;
IF staticLink # NIL THEN {
WITH descBody.location SELECT FROM
field: FieldLocation => {
units: INT Ź field.start / bitsPerAU;
IF field.cross THEN ERROR; -- cross record here??? LAI
IF units # 0 THEN {
args: NodeList Ź NodeListCons[staticLink,
NodeListCons[GenConst[units, minBitsPerArgument]]];
assign: Node Ź GenAssign[staticLink, GenApply[subOperNode, args]];
lambda.body Ź NodeListCons[assign, lambda.body];
};
};
ENDCASE;
};
};
};
};

TransformFork: PROC [base: BaseModel, model: LambdaModel, apply: ApplyNode]
RETURNS [Node] = {
args: NodeList Ź apply.args;
procToFork: Node = args.first;
retBits: INT Ź IntCodeUtils.WordToInt[
NARROW[args.rest.first, IntCodeDefs.WordConstNode].word];
nRets: INT Ź ToUnits[retBits, minBitsPerArgument, logMinBitsPerArgument];
argsToCallWith: NodeList = args.rest.rest;
argBits: INT Ź BitsForArgList[argsToCallWith];
nArgs: INT Ź ToUnits[argBits, minBitsPerArgument, logMinBitsPerArgument];
helperNode: LabelNode Ź GenAnonLabelNode[base, NIL];
helperLabel: Label Ź helperNode.label;
helperAddr: Node Ź GenLabelAddress[helperLabel, FALSE];
tempVar: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, bitsPerLink];
newArgs: NodeList Ź NodeListCons[helperAddr, NodeListCons[constant0, args]];
bogusBits: INT Ź BitsForArgList[newArgs];
nBogus: INT Ź ToUnits[bogusBits, minBitsPerArgument, logMinBitsPerArgument];
rtnVar: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, Target.bitsPerProcess];
rtnDecl: DeclNode Ź GenDecl[rtnVar, NIL];
tempDecl: DeclNode Ź GenDecl[tempVar,
GenApply[allocOperNode, NodeListCons[GenConst[nBogus, minBitsPerArgument]]]];
assignNode: Node Ź GenAssign[
GenDeref[tempVar, bogusBits, worst],
GenComposite[newArgs, bogusBits]];

apply.args Ź NodeListCons2[GenAddr[rtnVar], tempVar];
apply.bits Ź 0;

{

formal: Var Ź IntCodeOpt.GenAnonLocal[base, helperLabel, bitsPerLink];
actualProc: Var Ź IntCodeOpt.GenAnonLocal[base, helperLabel, Target.bitsPerProc];
actualProcDecl: Node Ź GenDecl[actualProc,
GenFieldOfDeref[formal, 2*minBitsPerArgument, Target.bitsPerProc]];
applyNode: ApplyNode Ź GenApply[actualProc, NIL, retBits];
applyListNode: NodeList Ź NodeListCons[applyNode];
tail: NodeList Ź applyListNode;
head: NodeList Ź NodeListCons[
actualProcDecl,
NodeListCons[GenFree[formal], applyListNode]];
result: Node Ź defaultNIL;
newProc: LambdaNode Ź z.NEW[NodeRep.lambda Ź [0, lambda[
parent: NIL,
descBody: NIL,
kind: fork,
bitsOut: bitsPerLink,
formalArgs: VarListCons[formal],
body: NIL]]];

IF argBits # 0 THEN {
actualArgs: Var Ź IntCodeOpt.GenAnonLocal[base, helperLabel, argBits];
actualArgsDecl: Node Ź GenDecl[
actualArgs,
GenFieldOfDeref[formal, 4*minBitsPerArgument, argBits]];
argsTail: NodeList Ź NIL;
offset: INT Ź 0;
FOR each: NodeList Ź argsToCallWith, each.rest WHILE each # NIL DO
bits: INT Ź IF each.first = NIL THEN 0 ELSE each.first.bits;
IF bits # 0 THEN {
new: NodeList Ź NodeListCons[GenField[actualArgs, offset, bits]];
IF argsTail = NIL THEN applyNode.args Ź new ELSE argsTail.rest Ź new;
argsTail Ź new;
};
offset Ź offset + bits;
ENDLOOP;
head Ź NodeListCons[actualArgsDecl, head];
};

IF nRets # 0 THEN {
retTemp: Var Ź IntCodeOpt.GenAnonLocal[base, helperLabel, bitsPerLink];
retDecl: DeclNode Ź GenDecl[retTemp, GenApply[allocOperNode, NodeListCons[GenConst[nRets, minBitsPerArgument]]]];
applyListNode.first Ź GenAssign[GenDeref[retTemp, retBits, worst], applyNode];
head Ź NodeListCons[retDecl, head];
result Ź retTemp;
};

tail Ź tail.rest Ź NodeListCons[GenReturn[NodeListCons[result]]];

head Ź NodeListCons[
GenComment[IO.PutFR[
"intermediary proc for a FORK, nArgs: %g, nRets: %g",
[integer[nArgs]], [integer[nRets]] ]],
head];
newProc.body Ź head;
helperLabel.node Ź newProc;
WITH base.module SELECT FROM
module: ModuleNode =>
NodeListTail[module.procs].rest Ź NodeListCons[helperNode];
ENDCASE => ERROR;
};
RETURN [GenBlock[
NodeListCons5[rtnDecl, tempDecl, assignNode, apply, rtnVar],
Target.bitsPerProcess]];
};

CanonReturn: PROC [return: ReturnNode, model: LambdaModel] RETURNS [node: Node] = {
IF return.rets # NIL THEN {
units: INT Ź 0;
bits: INT Ź 0;
FOR each: NodeList Ź return.rets, each.rest WHILE each # NIL DO
ret: Node Ź each.first;
IF ret # NIL THEN
units Ź units + ToUnits[ret.bits, minBitsPerReturn, logMinBitsPerReturn];
ENDLOOP;
bits Ź ToBits[units, logMinBitsPerReturn];
SELECT TRUE FROM
bits # model.returnBits => SIGNAL CantHappen;
HasLongReturnVar[model, bits] => {
rets: NodeList Ź return.rets;
IF bits = 0 THEN RETURN [emptyReturn];
RETURN [GenLargeReturn[rets, model.returnVar]];
};
ENDCASE;
};
RETURN [return];
};

HasLongReturnVar: PROC [model: LambdaModel, bits: INT] RETURNS [BOOL] = {
IF model.forceLong OR bits > maxBitsReturnRecord THEN {
rtnVar: Var Ź model.returnVar;
IF bits = 0 THEN bits Ź bitsPerLink;
IF rtnVar = NIL THEN {
rtnPtr: Var Ź GenAnonVar[bitsPerLink];
rtnVar Ź GenDeref[rtnPtr, bits, worst];
model.returnVar Ź rtnVar;
};
IF rtnVar.bits # bits THEN SIGNAL CantHappen;
RETURN [TRUE];
};
RETURN [FALSE];
};

GenLargeArgs: PROC
[base: BaseModel, apply: ApplyNode, model: LambdaModel] RETURNS [Node] = {
comp: Node Ź PadComposite[apply.args, logMinBitsPerArgument];
IF comp # NIL THEN {
var: Var Ź GenMemTemp[base, comp.bits, model];
var.flags[constant] Ź TRUE;
apply.args Ź NodeListCons[GenAddr[var]];
RETURN [GenBlock[bits: apply.bits, nodes: NodeListCons2[GenDecl[var, comp], apply]]];
};
apply.args Ź NIL;
RETURN [apply];
};

GenLargeRets: PROC
[base: BaseModel, model: LambdaModel, node: Node, bits: INT]
RETURNS [new: Node, addr: Node] = {
WITH node SELECT FROM
apply: ApplyNode => {
temp: Var Ź GenMemTemp[base, bits, model];
temp.flags[constant] Ź TRUE;
addr Ź GenAddr[temp];
apply.bits Ź 0;
new Ź GenBlock[bits: bits, nodes: NodeListCons3[GenDecl[temp, NIL], node, temp]];
RETURN;
};
block: BlockNode =>
FOR each: NodeList Ź block.nodes, each.rest WHILE each # NIL DO
WITH each.first SELECT FROM
apply: ApplyNode => {
[each.first, addr] Ź GenLargeRets[base, model, apply, bits];
new Ź node;
RETURN;
};
ENDCASE;
ENDLOOP;
ENDCASE;
SIGNAL CantHappen;
new Ź node;
addr Ź NIL;
};

GenAnonLabelNode: PROC [base: BaseModel, node: Node]
RETURNS [LabelNode] = {
next: LogicalId Ź -LabelsSize[base]-1;
label: Label Ź z.NEW[LabelRep Ź [
id: next, node: node, backTarget: FALSE, jumpedTo: FALSE, used: FALSE]];
LabelsStore[base, next, label];
RETURN [z.NEW[NodeRep.label Ź [0, label[label]]]];
};

GenMemTemp: PROC
[base: BaseModel, bits: INT, model: LambdaModel]
RETURNS [Var] = {
var: Var Ź IntCodeOpt.GenAnonLocal[base, model.label, bits];
model.memTemps Ź VarListCons[var, model.memTemps];
RETURN [var];
};

CanSimplyPush: PROC [arg: Node, depth: INT] RETURNS [BOOL] = {
IF arg = NIL
THEN RETURN [TRUE]
ELSE {
DO
units: INT Ź ToUnits[arg.bits, bitsPerLocal, logBitsPerLocal];
IF depth+units > lastStack THEN RETURN [FALSE];
WITH arg SELECT FROM
var: Var =>
WITH var.location SELECT FROM
deref: REF LocationRep.deref => {arg Ź deref.addr; LOOP};
indexed: REF LocationRep.indexed => {
index: Node Ź indexed.index;
IF CanSimplyPush[index, depth] THEN {
indexUnits: INT Ź ToUnits[index.bits, bitsPerLocal, logBitsPerLocal];
depth Ź depth + indexUnits;
arg Ź indexed.base;
LOOP;
};
};
field: REF LocationRep.field => {arg Ź field.base; LOOP};
upLevel: REF LocationRep.upLevel => {arg Ź upLevel.link; LOOP};
composite: REF LocationRep.composite => {
bitDepth: INT Ź ToBits[depth, logBitsPerLocal];
FOR each: NodeList Ź composite.parts, each.rest WHILE each # NIL DO
eachBits: INT Ź each.first.bits;
unitDepth: INT Ź ToUnits[bitDepth, bitsPerLocal, logBitsPerLocal];
IF NOT CanSimplyPush[each.first, unitDepth] THEN RETURN [FALSE];
IF eachBits > bitsPerLocal THEN {
eachUnits: INT Ź ToUnits[eachBits, bitsPerLocal, logBitsPerLocal];
IF unitDepth+eachUnits > lastRegister THEN {
alignedBits: INT Ź ToBits[unitDepth, logBitsPerLocal];
IF alignedBits # bitDepth THEN RETURN [FALSE];
};
};
bitDepth Ź bitDepth + eachBits;
ENDLOOP;
};
escape: REF LocationRep.escape => RETURN [FALSE];
ENDCASE => RETURN [TRUE];
const: ConstNode => RETURN [TRUE];
oper: OperNode => RETURN [TRUE];
machineCode: MachineCodeNode => RETURN [TRUE];
apply: ApplyNode => {
args: NodeList Ź apply.args;
IF args # NIL THEN {
WITH apply.proc SELECT FROM
oper: OperNode =>
WITH oper.oper SELECT FROM
mesa: REF OperRep.mesa =>
SELECT mesa.mesa FROM
addr => IF args # NIL THEN {arg Ź args.first; LOOP};
ENDCASE;
ENDCASE;
ENDCASE;
FOR each: NodeList Ź args, each.rest WHILE each # NIL DO
first: Node Ź each.first;
IF first # NIL THEN {
IF NOT CanSimplyPush[first, depth] THEN RETURN [FALSE];
depth Ź depth + ToUnits[first.bits, bitsPerLocal, logBitsPerLocal];
};
ENDLOOP;
};
arg Ź apply.proc;
LOOP;
};
ENDCASE;
EXIT;
ENDLOOP;
RETURN [FALSE];
};
};

MarkCatch: PROC [base: BaseModel, node: Node] RETURNS [Node] = {
WITH node SELECT FROM
labelNode: LabelNode => {
lab: Label Ź labelNode.label;
IF lab # NIL THEN {
handlerModel: LambdaModel Ź ModelsFetch[base, lab.id];
IF handlerModel = NIL
THEN SIGNAL CantHappen
ELSE handlerModel.isCatch Ź TRUE;
RETURN [GenGoTo[lab]];
};
};
ENDCASE;
IF node # NIL THEN SIGNAL CantHappen;
RETURN [node];
};

GetHandlerArgs: PROC
[model: LambdaModel] RETURNS [regsPtr, except, rtnPtr, argPtr: Var Ź NIL] = {
IF model.isCatch THEN {
args: VarList Ź model.lambda.formalArgs;
rtnVar: Var Ź model.returnVar;
IF args = NIL THEN GO TO noGood;
IF rtnVar # NIL THEN
WITH rtnVar.location SELECT FROM
deref: DerefLocation => IF deref.addr = args.first THEN {
args Ź args.rest;
IF args = NIL THEN GO TO noGood;
};
ENDCASE => GO TO noGood;
regsPtr Ź args.first;
IF (args Ź args.rest) = NIL THEN GO TO noGood;
except Ź args.first;
IF (args Ź args.rest) = NIL THEN GO TO noGood;
rtnPtr Ź args.first;
IF (args Ź args.rest) = NIL THEN GO TO noGood;
argPtr Ź args.first;
IF (args Ź args.rest) # NIL THEN GO TO noGood;
RETURN;
EXITS noGood => {};
};
SIGNAL CantHappen;
};

VarCantHappen: PROC [var: Var, msg: Rope.ROPE Ź NIL] = {
IF var # NIL THEN
WITH ProcessProps.GetProp[$StdOut] SELECT FROM
st: IO.STREAM => {
IO.PutF1[st, "\nBadVar[id: %g] ", [integer[var.id]] ];
IF msg # NIL THEN IO.PutF1[st, "(%g) ", [rope[msg]] ];
};
ENDCASE;
SIGNAL CantHappen;
};

END.


  ?ž  
IntCodeTwigImpl.mesa
Copyright Ó 1986, 1987, 1988, 1989, 1990, 1991, 1993 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) April 9, 1990 9:17:33 pm PDT
JKF July 27, 1988 8:00:10 am PDT
Christian Jacobi, May 4, 1993 8:30 pm PDT
Options
TRUE => use small exception raising
FALSE => use "normal" exception raising

TRUE => perform some simplifications of value-returning blocks
FALSE => no transformation of value-returning blocks

TRUE => uplevel use from catch phrase handlers force the target variable into memory
FALSE => uplevel use from catch phrase handlers can use registers

TRUE => use heap allocation for frame extensions
FALSE => declare the frame extension as a simple (addressed) variable

TRUE => call CleanupLambda to remove junk
FALSE => don't call CleanupLambda

Funny machine limitations (should be relocated some day)
for larger indexed bases they must be addressable
for larger local vars they must be addressable
This should be parameterized!

Statically known offsets in the frame extension
link to next enclosing frame extension (bits)
offset for first local variable (in words)
offset for first local variable (in bits)
The global zone
The (optional) pass to rewrite enables
Signals & Errors
Signalled when a duplicate condition is found
Signalled when something is simply not possible (according to our intentions, at least)
Signalled when something is not yet supported.
Public routines
Eventually do some debugging here and allow for resuming
Build the initial models for each procedure in the graph.
Canonicalize the variables for each procedure in the graph.
[[ This pass sets the upLevel and addressed (=> notRegister) variable flags ]]
Find and mark all of the local variables that are up-level referenced
[[ This pass sets the notRegister variable flag ]]
Run a pass to remove block exprs, since we only introduce simple locals
There is stack depth checking in force.  If lastStack = 0 then the stack is effectively unlimited (as is the case for translating into some higher-level language).
Allocate the memory for local variables that must be placed in memory locations (as opposed to registers).  This creates the frame extension.
Create the locations for up-level references to local variables in enclosing scopes
Create the locations for local variables that must be in memory
[[ This pass sets the used and assigned bits for variables ]]
Cleanup the world
[[ At this point we can rely on the used & assigned flags ]]
Place the final comment
Private routines
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
No components => no map
No components => no map
No components => no map
Note the test for id = 0
First, calculate the size of the argument record.
Now assign initial locations to the arguments.
This procedure has a large argument record, so replace it with an argument record pointer.  Also replace the locations of the formal arguments with field values.
reassign the location to be a field of the arg record
The arguments are all simple local variables.
Now map over the subsidiary nodes of the procedure.
At this point we have determined the number of bits that are to be returned.
The return variable is indirect from an argument!
Make long argument & return records into indirections.  Do the same for argument & resume records for signals & errors.  Don't do it for applications of machine code!
Map all of the pieces first
Don't transform this further, since we are being quite trusting here.
The first argument is the signal or error to be raised.  For a signal, the second argument is the pointer to the resume record (NIL if none).  The remaining argument is a pointer to the argument record (NIL if none).  The signaller does not need to know the size of the arguments.
No resume value possible for errors, none expected.  However, retBits need not be 0, as in the code for:
x _ IF P[...] THEN 4 ELSE ERROR
No resume value possible.  Pass in a NIL.
There may be a resume value passed back.  It always gets assigned through the memory pointer.
need to create a block with a temp large enough to contain the return value, then free the return record
The join primitive always returns a pointer
declare the result variable
gen the call to primitive JOIN and save the result pointer
assign from the result pointer to the actual result variable
free the temporary variable variable
the result is in the result variable
In the case of no return values we just ignore the result
We need to return two things
rets _ START module[args]
There is a large argument record, which must be placed in memory.  The argument list is then converted into passing a pointer to that temporary.
note: changes apply.args!
There is a large return record.  This means that the first argument for the procedure is really a pointer to the return record.
Assign global locations to the variables.
Generate a new id
[label: Label, node: Node, define: BOOL _ FALSE] RETURNS [Label]
Canonicalize the labels for the whole model
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
Canonicalize the variable
Any use of a local variable outside of its parent scope causes it to become addressed and marked as an upLevel variable.
A global variable, and we need a global link.
We have to have a global link, which looks like an anonymous local variable.
Any use of a local variable outside of its parent scope causes it to become addressed.
A local variable is addressable if it is large enough
If a constant index gets this far we can turn it into a field
An array is addressable if it is large enough and indexed
No processing necessary for a declared variable.
Process the initialization as a normal expression
For argument list verification.
Sometimes blocks get generated for no particularly good reason
This is a trivial block, so just use the first node
This is a nearly trivial block, so just use the decl0 initialization
This may be a trivial block, so check farther
How about that, the block is trivial!
Finally we can determine the parent model.
The static link is passed in via the regsPtr argument
This procedure always takes a static link, which appears as an extra argument.
This lambda uses global variables, so we add a global link.
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
This is simply not right!
Guaranteed to be simple enough to push without transformations.  This includes having no declarations, so no further transformations are needed.
Each decl that can be on the stack is assumed to be there.
Can't be an addressable register
Can be an addressable register
For complicated applications we may have to build some arguments in memory.
The first time through we turn the node into a block expression.  The tail is always the most recent thing to be made into a memory temporary.
Slip the new node in between the last thing made into a temporary and the apply node.
In the unlikely case that the procedure is really complicated, then put it into a temp first of all.  This keeps us from getting into trouble by putting all of the arguments on the stack before discovering disaster.
If there are 0 arguments or a single argument then no further temporary is necessary.
Single argument procedure.
Use normal application mechanism
Multi-argument operations get special treatment because the order of evaluation for the arguments is not always specified.  We make a very conservative estimate here, which can be worse (but not better) than the normal procedure call case.
No temporary needed
This is a complicated argument and the stack is pretty full, so evaluate the argument into memory.
We are actually using the addresses of the arguments, not the arguments themselves.  So we just calculate the number of words we need, then transform the arguments.
to allocate locals for a link
Push this argument
This can be generated as necessary, so we do not need to pre-evaluate it
This is a complicated argument and the stack is nearly full, so evaluate the argument into memory.
Source nodes must preserve any depth alterations
This routine walks the tree and marks all variables that are up-level referenced.  We also have to copy them because the locations will be altered when we assign memory & register locations to locals.
Also, this routine transforms reject, resume and unwind nodes into the appropriate return nodes.
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
This is an up-level reference to a local variable.
Up-level reference to a lambda that does not logically enclose!
This should have been done in CanonLambda!  Why not?
Must use memory locations for this variable
At this point we have to copy the current part of the list, then map the rest, and return the new variable.
Copy the head of the list up to the list node that differs
Now append the differing element
Now append the rest, mapping if not NIL
Just in case we changed things
Transform application of resume & unwind applications.
Return with code = 0.
The return values (if any) get assigned through the rtnPtr.
Then we return with code = 1.
Return with code = 2.
This routine allocates space in the frame extension for the various memory locals.
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
Refers to some offset in the frame extension
Any variable still marked as being possibly in a register is not in the FX.
If we are NOT heap allocating the FX, then only upLevel accessed variables are forced into the FX.
This variable must be in the FX.
Refers to some offset in the frame extension
No memory locals, so no memoryLink needed.
Make up the memory link & the frame extension
Just an approximation, perhaps we can do better some day
Make sure that the static link is in the first word of the frame extension.  Do NOT use the fxLink variable.
This is the simplest way to allocate space if the target is kind enough.
There must be something here
In this case we still need a "register" to point at the frame extension, since that is how we chain from handlers.
Despite the addressing, force this to be "register" based (not really a register)
Note: at this point model.frameExtension # NIL indicates that there is a frame extension to hold addressed variables and variables that are too large.  However, model.memoryLink # NIL indicates that there is a separate variable to hold onto the address of the extension, something that we only need when (heapAllocFX OR NOT useMemoryFromHandlers).
The idea here is to add the allocation, freeing, and unwind code associated with managing frame extensions.  Allocation is handled at the start of the procedure (is the size constant?), then we start an enables node to deal with the UNWIND and the need to free the extension (this is also used to deal with RETURN WITH ERROR).  After the enables scope we have an explict unwind before the return.  For frames with extensions the return nodes must be transformed into goto nodes which transfer to the extension freeing code.
First, generate the code to deal with the frame extension.  This includes the allocation, the enables block, and the freeing code.  This involves replacing body with:
{decl {var link} {apply {oper mesa alloc} {const word size}}}
{enable {} body}
A NIL handle is used to indicate that the signaller should get rid of the frame extension.
 
{apply {oper mesa free} {var link}}
Note: alloc expects units quantized to min arg size
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
This simple version ignores conflicts between return values and memory temporaries.  We have to fix this sometime!
We can go to a common label for empty returns.
The cleanup is done by a dummy return value.
This routine walks the tree and substitutes memory-based locations for local variables that cannot be in registers and are referenced upLevel.  Note that we have to make completely new variables for these transformations to avoid aliasing problems we would get into if we just replaced the locations.
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
This is local to the enclosing lambda, and cannot be transformed yet
This is an up-level reference to a local variable for another lambda.
found it!
Direct reference to a register
Must chase the memory link register
Can chase through static links even though marked as being in registers
We are chasing through the frame extension
Catch phrase, and can use registers
Substitute a dereference for the global variable
Refers to some offset in the frame extension
This routine walks the tree and substitutes memory-based locations for local variables that cannot be in registers.  We can go ahead and clobber the locations, because upLevel uses have already been transformed (it says here).
This variable is not in the FX
This variable is not in the FX
Don't try to nest the FX inside itself!
This is a local variable in memory.
This is an up-level reference to a local variable for another lambda.  We should have transformed all of these already!
This stuff is to simplify field descriptions.
If a nested field gets this far we collapse the locations
--Lifted from little endian compiler without understanding, ChJ, May 4, 1993
There is a NIL check in here that we might discard
At this point we may be performing a gratuitous NIL check
A constant offset that may be within the unmapped region
We must scan over the index expression to find other derefs of the expression
We can eliminate the NIL check, since the indexing node will fault first if there really is a problem.
[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]
Transform all of the local variables that must be in memory
At this point we may have moved some of the arguments into memory.  We need to generate assignments from the incoming `registers' into the eventual memory locations.
This variable is in memory (sigh), and must be transformed.
We should not be missing the allocation for the memory!
This code deals with inserting the initial subtraction that converts a procedure descriptor into a static link.  The idea is that the variable describing the procedure descriptor has been planted in the lambda node, and that variable has a field location if the offset # 0.  After all of this is over, only nested procedures that are NOT catch phrases will have lambda.parent # NIL (for later use).
There is a static link, which must be adjusted.
Big Utilities
To allow a runtime routine to deal with constant types for the forked routine we construct an intermediary routine of a constant type (takes an argument that points at the actual proc and arguments, returns one result that points at the actual return values).  This is the routine that is fed to the runtime, while the routine that we really wanted to call is called from the specially constructed intermediary.
Prefix the arg list with a proc desc body!
[pc, 0, proc, nRets, args...]
The arguments to the FORK primitive are the address of the rtnVar and the args.
No bits are returned (but rtnVar is modified).
Now generate the bogus procedure that we need to intermediate the forking call
Start list with the proc decl, the formal free, and the actual application.
We also need to declare (and initialize) the actual arguments.  To make the C code turn out correctly over various implementations, we have to declare the arguments with the same number and sizes that the actual argument list has.
There are some returns to process
Finally return the newly allocated return record
Splice the new proc at the tail
Little Utilities
Whenever there is a return node we have to look at the return bits.  If we have a long return record then we transform the return node into an assignment followed by a return of nothing.
A large return record
At this point we have to assign the current rets to the return value.  The transformed return does not return anything at all.
A large return record
Time to have a new large variable
This is very conservative right now.  It is meant to return TRUE if the given argument can be pushed onto the stack only using the given number of available stack locations.
Special case for things like the default counted zone (not really pushed anyway)
This is a big (more than 1 local reg) value
What's worse, the value can't be easily addressed!
Sigh, the big value isn't aligned, so we can't simply push!
Whenever we fall through we have a case more complicated than we want to handle.
There is a return var in front of the "normal" arguments
ĘEâ  NewlineDelimiter
(cedarcode) style headIcode
ĎeU`L0L L) Ďk		L	LŮęL%9L4DLŁľL¤ˇL°ÁL˝ĎL(LLLHgL_vLL[gL L!L L2.5 in tabStops 2.5 in tabStopsL2.5 in tabStops#L2.5 in tabStops"'L2.5 in tabStops 2.5 in tabStops!L2.5 in tabStops:>L2.5 in tabStops/4L2.5 in tabStops 2.5 in tabStops#L2.5 in tabStopsPTL2.5 in tabStops<AL2.5 in tabStops 2.5 in tabStopsL2.5 in tabStops,0L2.5 in tabStops@EL2.5 in tabStops 2.5 in tabStopsL2.5 in tabStops%)L2.5 in tabStops!L2.5 in tabStops L 2.5 in tabStops82.5 in tabStops.L2.5 in tabStops12.5 in tabStops'L2.5 in tabStops.2.5 in tabStops>L2.5 in tabStopsL2.5 in tabStops 2.5 in tabStops+;L2.5 in tabStops 2.5 in tabStops//2.5 in tabStopsL2.5 in tabStops--2.5 in tabStopsL2.5 in tabStops**2.5 in tabStops%:L2.5 in tabStops))L2.5 in tabStops LL &L4
]L head22.5 in tabStops L--L LWWL !L..L Ďn$P$L8LLL#)LL $N(LL  LLLL .L/5LL &LL37LCGLL L9L;LNNL EL22%8L%%LL LG%8L22LLStartOfExpansion7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node] LŁ%8L##LL7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node] L%8L""LL LS%8L&&LL ?L=7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]%8LLL L<7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]%8L%LLLL44LL LL7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]';L'CL))L8LLLLL LLL 
6F7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]LĐck33"L)L+LLLLLL?
0LLLLLLQLL  LLLL##LLLLLLL L""L L11.DLLMMLL::L L..+@LĄĄL((L&&L *MLL!!'=L55LL(1L//LLMMLLL((LLLL--.DLLLL L33L--L LLL+JL1)LL;;LLLLL LLLLL+L.LLLLLŚŚL	L	*L?ILL
5L
0##L%LEL	LBLBLLLLL "8LLL L	LLLL
L
#LLLL
LLL>PL
LLL L $LL((LLhhLL%)L&&L]]LLCCL  LL''L
L	L))L
L	LhL	L+LBBLFFL00.4LL77L:;;L<11L$((L$L!L*0L9LLL33LLLLL..L(,L'+L,,L26LL88L,,LL
LL""L""L$$LL
LLLLLL((LLLL88L,,LL
LLL/L""L""LLL))L#.(>LLLNXL6@L.CLLLLLLLL""LL#/	FLLL9MLLL**L#@L))LLL	LL	L++LE\LL 	6E7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]L 33LL&&	LxxL	9L:LFL--		.LLLLKKLLLLLVV"(L5LLL00L33L=L&.L//L
*?L9LLL%,LL))L0L1LLL	LL..L1L$$LLLLLLLL!!LL%%LLLL"" ;L"LLL!!LL%%LLL""		LL-LLLLLLLL>LLLLLL"8L	0L6L-L-LLLLL	L3L	-LDDL	kL--!+L%LLLLL""LLLLL *@L""
,L88L$$L  L&&L((LLLL >O	KL**LLL L55L11L!!LLNNLFFL**LL#L26LLL  L;;L77L#(L..LLL >S7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]L 33L
	+L
?LL::L	0L4>LL  LLLLL LLLLLLLKKLL@NLL
0=
2L--L77LLLL!!LLUULLLLLLL ,6L××L((L LUULLLLLL-L  L
(LLLďď"8LL@J99LL
LbbL!!LLLL¤¤.L"8LL"8LLLLLL"8LL@JLLLLLLHHL
LbbL!!LLLLLLL$L0*@LLLLLL""LLLLJTL	L.L:L;L$$LL >ULČČL``7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]L 33	,L
/L22L++0L??L22LL%%LLL44L--LL0L+LLLLLLLLLL0ELLLLLLLLLBFL/3LLLLLLLL&L	)6LL/DLLLL!!-CLLLkLLLL$RL:-DL**L;LLL L&*L&*L''=L00L*LLLLLLLLLLLLLRgLLLLLLLLL"L66LLLBBLLLL;;LLBBLL55LFFL%%L--LLLLL//LLLLL(LLLLLL$LL""LLL$$LL >RLRR7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]L 33)'6L,LL%%L
L""LLLL	HL	FL$LL""LL!LHK1L
;bL L4>L$L+eL*eL4ILL17LL'6L,L8?LLL66.DLLL$$&>L**L!!L--L	)5LFF&4L!%L59L8Lll

L66LLLL''LLHLL66L#LrLL--LLL!L#LQLLŰŰLLL >ULLL  L ĎzŚLĄ'Ą=ĄInote\LĄ#L<FL33LhhL2L99LL L 33LrrL..L!LL,,L%%L''LLLL$LL""LLL L  L($qL	6LL L$$LL >VLŹŹ7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]L 33LLDDL
LEELLLL++L		L.L%0L
,2L44L##L"7LGLLLL77LL)-L'2LL$$
-L))LL)L**L<<
L#L))LLLLLL-4LLD L00LCCLLL!L,L  LL#LEELLLLL$LL""LLL$$LL >OLââ7 -- [node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]

+L!L1L!!L'LL##L  L"&LIMLLwwLLL--L,,'L9LL!LĎcCCL%LL%,WLLL%LLL7L$$L$2 "LLLLLLLL)!?'L))LLL))LLL  L**L'$}L09!)L%%L"L(;LLLL$$L!LLLL L8L$+LL7LLMLLLNfLLLLL#?LLLL 33LLLLLLLLLL$	BL66	BL66LL""LL$$L;;
@LĽĽLLL.DLLL
)L;;LAAL44LL9LLL)?!L$L77LLLLLLLLLL  L
.L#"L%L˘6L/L]]LBBL00LLLLLLLL 9^LLLL	3`L?IL*L	".L?IL/4L&&L07LGGLL*LL)LALLPPL$)LssLeeL 55L6OL..L LNL LFFLQQLnnL,:L22L]]LKKL8LL
LLL  LL LćLFFLddLL,BL<
LAALELLLLL**LL L!LGGLqqLNNL##LLL AAL0L LdqLLLLL;;LLLagLL *SLşşLL)?LLIILL**L-""LLL~~L
&L)/LLLL
LL 
I7LLL
$
L!!L&&L''LLL-LLLLL 8]L==L..LL((LOULLL	LL 8sL**LLLL>QLL)?L<<LLLLLLLLLLL LL&&L	0jLL%2LL 

SL<<L22LLL 
>L­­LPPL4>L/L)9	%L%L6ELLLLLL)9L	-?)L
"/-CL
 L4BL
&@!L+L4B$,L2L&6.L;LLLLLL1LL"L L .LL	4LLL"8L	L
7LCCLLLLLLLLPPLLLLLL 	@LL66LL!LLLLL%LLL )bL((LL
 
 9L8LL
 LLLL
.LL
.LL
.LL
.LLLLLL 8.L46L"6LLLLL LL L      ą¨  7H 