[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>MimDriver.mesa

MimDriver.mesa

Sweet, June 1, 1986 9:01:50 pm PDT

Satterthwaite, November 26, 1985 1:40:30 pm PST

Russ Atkinson (RRA) February 21, 1990 1:02:54 pm PST

Willie-s, September 24, 1991 4:48 pm PDT

DIRECTORY

Alloc USING [AddNotify, Base, BaseSeq, DropNotify, Notifier],

Basics USING [LowHalf],

BasicTime USING [Now],

CardTab USING [Create, Ref, Store],

CompilerUtil USING [],

ConstArith USING [ToInt],

ConvertUnsafe USING [ToRope, SubString, SubStringToRope],

IntCodeDefs USING [BlockNode, ByteSequence, CaseList, Label, LabelNode, LambdaKind, LambdaNode, Location, LocationRep, MesaSelector, ModuleNode, Node, NodeList, NodeRep, RefLitKind, SourceNode, Var, VariableFlags, VarList],

IntCodeGen USING [CodeGenerator, GetCodeGenerator],

IntCodeStuff USING [NodeContains],

IntCodeTwig USING [BaseModel, DoModule, LambdaModel],

IntCodeUtils USING [MapNode, Visitor, zone],

IO USING [PutChar, PutF1, PutFR, PutRope, RopeFromROS, ROS, STREAM],

List USING [CompareProc, UniqueSort],

LiteralOps USING [StringValue],

Literals USING [Base, STIndex, stType],

MimBodyCorrect USING [FixBodies],

MimCommandUtil USING [GetRootName, SetExtension],

MimCode USING [BitCount, CodeList, StoreOptions],

MimData USING [bodyIndex, idATOM, idTEXT, mainCtx, nSigCodes, objectVersion, source, switches, table, textIndex, worstAlignment],

MimosaLog USING [ErrorRope],

MimP5 USING [DeclList, Exp, ExpList, StatementList, StatementTree, VarForSei, VisibalContextArray, WrapSource, WrapSourceBlock],

MimP5Install USING [GenInstallationProc],

MimP5S USING [ComAssign, ExtendValue, Temporize, WillEvalToConst],

MimP5U USING [Address, AllocLabel, AppendNodeList, ApplyOp, Assign, BitsForOperand, BitsForType, CgenUtilInit, CreateTemp, Declare, Deref, ExtractList, InsertLabel, Jump, LabelAddress, MakeArgList, MakeArgList2, MakeBlock, MakeComposite, MakeConstCard, MakeGoTo, MakeNodeList, MakeNodeList2, MakeReturn, MakeTemp, MakeVarList, MaybeBlock, MesaOpNode, MoreCode, NewCodeList, NextVar, OperandType, PadArgList, ProcessSafens, TakeField, TakeFieldVar, TreeLiteralValue, TypeForTree],

MimSysOps USING [Close, Open],

MobDefs USING [Link, ModuleIndex],

ParseIntCode USING [ToStream],

Rope USING [Concat, FromProc, ROPE],

SourceMap USING [Loc, nullLoc, Up],

SymbolOps USING [DecodeLink, EncodeBitAddr, EncodeInt, EnumerateBodies, MakeCtxSe, NameForSe, NextSe, own, ParentBti, RCType, SetCtxLevel, SubStringForName, TransferTypes, XferMode],

Symbols USING [Base, bodyType, BTIndex, BTNull, CBTIndex, CBTNull, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, ctxType, HTNull, ISEIndex, ISENull, lG, lL, Name, nullType, RecordSEIndex, RecordSENull, RootBti, SEIndex, SENull, seType, SpecialVarKind, Type, typeANY, VariableFlags],

TargetConversions USING [NewWriter, PutCard, PutChar, Writer, WriterContents],

Target: TYPE MachineParms USING [bitsPerAU, bitsPerByte, bitsPerChar, bitsPerLongWord, bitsPerRef, bitsPerSignal, bitsPerStringBound, bitsPerWord],

Tree USING [Base, Index, Link, LinkRep, Map, NodePtr, NodeName, Null, treeType],

TreeOps USING [GetTag, OpName, SearchList, UpdateLeaves];

MimDriver: PROGRAM

IMPORTS Alloc, Basics, BasicTime, CardTab, ConstArith, ConvertUnsafe, IntCodeGen, IntCodeStuff, IntCodeTwig, IntCodeUtils, IO, List, LiteralOps, MimBodyCorrect, MimCommandUtil, MimData, MimosaLog, MimP5, MimP5Install, MimP5S, MimP5U, MimSysOps, ParseIntCode, Rope, SourceMap, SymbolOps, TargetConversions, TreeOps

EXPORTS CompilerUtil, MimCode, MimP5, MimP5S = {

OPEN IntCodeDefs, MimCode, Target;

Options sometimes set from the interpreter

enableTypesFile: BOOL ¬ FALSE;

enableIntCodeTransforms: BOOL ¬ TRUE;

collectConstants: BOOL ¬ TRUE;

minCollectibleWords: NAT ¬ 4;

noCollectConstAssigns: BOOL ¬ TRUE;

maxMemoBits: INT ¬ LAST[INT];

Is this a good idea? Is there reason to have less?

minMemoBits: INT ¬ 3*LONG[bitsPerLongWord]+1;

Pretty arbitrary, really

Imported definitions

LORA: TYPE = LIST OF REF ANY;

ROPE: TYPE = Rope.ROPE;

STREAM: TYPE = IO.STREAM;

BTIndex: TYPE = Symbols.BTIndex;

CBTIndex: TYPE = Symbols.CBTIndex;

CTXIndex: TYPE = Symbols.CTXIndex;

CTXNull: CTXIndex = Symbols.CTXNull;

CSEIndex: TYPE = Symbols.CSEIndex;

CSENull: CSEIndex = Symbols.CSENull;

ISEIndex: TYPE = Symbols.ISEIndex;

ISENull: ISEIndex = Symbols.ISENull;

RecordSEIndex: TYPE = Symbols.RecordSEIndex;

RecordSENull: RecordSEIndex = Symbols.RecordSENull;

Type: TYPE = Symbols.Type;

nullType: Type = Symbols.nullType;

typeANY: Type = Symbols.typeANY;

bytesPerWord: NAT = Target.bitsPerWord / Target.bitsPerByte;

bitsPerPtr: NAT = Target.bitsPerRef;

bitsPerWord: NAT = Target.bitsPerWord;

bitsPerProcDesc: NAT = bitsPerPtr*2;

Stuff exported to MimCode

curctxlvl: PUBLIC Symbols.ContextLevel ¬ Symbols.lG;

bodyRetLabel, bodyComRetLabel: PUBLIC Label ¬ NIL;

bodyInRecord, bodyOutRecord: PUBLIC Symbols.RecordSEIndex ¬ RecordSENull;

mainBody: PUBLIC BOOL ¬ FALSE;

tailJumpOK: PUBLIC BOOL ¬ FALSE;

caseCV: PUBLIC Node ¬ NIL;

caseType: PUBLIC Symbols.Type ¬ nullType;

fileLoc, inlineFileLoc: PUBLIC SourceMap.Loc ¬ SourceMap.nullLoc;

catchcount: PUBLIC CARDINAL ¬ 0;

catchoutrecord: PUBLIC Symbols.RecordSEIndex ¬ RecordSENull;

tempcontext: PUBLIC Symbols.CTXIndex ¬ CTXNull;

xtracting: PUBLIC BOOL ¬ FALSE;

xtractNode: PUBLIC Node ¬ NIL;

xtractsei: PUBLIC Symbols.ISEIndex ¬ ISENull;

nC0, nC1: PUBLIC Node ¬ NIL;

initialized to 0 and 1 constants by CGenUtil

trueNode, falseNode: PUBLIC Node ¬ NIL;

initialized to TRUE and FALSE constants by CGenUtil

CodeNotImplemented: PUBLIC SIGNAL = CODE;

CodePassInconsistency: PUBLIC SIGNAL = CODE;

Bases & notifier

myBaseSeq: REF Alloc.BaseSeq ¬ NIL;

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

seb: Symbols.Base; -- semantic entry base (local copy)

ctxb: Symbols.Base; -- context entry base (local copy)

bb: Symbols.Base; -- body entry base (local copy)

stb: Literals.Base; -- string base (local copy)

DriverNotify: Alloc.Notifier = {

called by allocator whenever table area is repacked

myBaseSeq ¬ base;

seb ¬ base[Symbols.seType];

ctxb ¬ base[Symbols.ctxType];

bb ¬ base[Symbols.bodyType];

stb ¬ base[Literals.stType];

tb ¬ base[Tree.treeType];

FOR i: NAT IN [0..notifiers) DO

notifier: Alloc.Notifier ¬ notifierArray[i];

notifier[base];

ENDLOOP;

};

z: PUBLIC ZONE ¬ IntCodeUtils.zone;

notifiers: NAT ¬ 0;

notifierArray: REF NotifierArray ¬ z.NEW[NotifierArray ¬ ALL[NIL]];

NotifierArray: TYPE = ARRAY [0..32) OF Alloc.Notifier;

Variables & local types

inInline: PUBLIC BOOL ¬ FALSE;

localProcCodeList: CodeList ¬ NIL;

substState: REF SubstState ¬ NIL;

SubstState: TYPE = RECORD [

cl: CodeList ¬ NIL,

prefixCL: CodeList ¬ NIL,

postfixCL: CodeList ¬ NIL,

resultType: Type ¬ nullType,

resultVar: Var ¬ NIL,

exitLabel: IntCodeDefs.Label ¬ NIL,

lock: Tree.Link ¬ Tree.Null,

lastResult: Node ¬ NIL,

lastResultExpr: Node ¬ NIL,

lastResultGoTo: Node ¬ NIL,

nResults: INT ¬ 0

];

mLock: Tree.Link ¬ Tree.Null;

signalsVar: Var ¬ NIL;

procDescRoot: REF ProcDescEntry ¬ NIL;

ProcDescEntry: TYPE = RECORD [

rest: REF ProcDescEntry ¬ NIL, -- the next sibling (if any)

parent: REF ProcDescEntry ¬ NIL, -- the parent (if any)

child: REF ProcDescEntry ¬ NIL, -- the first child (if any)

label: Label ¬ NIL, -- the label for the proc

used: BOOL ¬ FALSE, -- TRUE if used as a proc desc

bti: CBTIndex ¬ Symbols.CBTNull, -- the bti for the proc

indirectEntry: Node ¬ NIL, -- the indirect entry point

directEntry: Node ¬ NIL, -- the direct entry point

body: Var ¬ NIL -- the variable for the proc desc body

];

maxBti: CBTIndex ¬ Symbols.RootBti;

The maximum bti seen (used for ease of verification)

modNode: ModuleNode ¬ NIL;

modVarsTail: VarList ¬ NIL;

The tail of the module variables list. Useful for adding global vars.

maxGlobalVarId: INT ¬ 0;

The maximum global variable id (generated from MimData.mainCtx)

ModuleIndex: TYPE = MobDefs.ModuleIndex;

linkToVarSeq: LinkVarSeq ¬ NIL;

LinkVarSeq: TYPE = REF LinkVarSeqRep;

LinkVarSeqRep: TYPE = RECORD [

length: ModuleIndex,

entries: SEQUENCE max: ModuleIndex OF Var

];

linkOverhead: NAT ¬ 4;

Number of refs in the overhead for interface records.

(This needs to be parameterized)

extraLinkDeref: BOOL ¬ FALSE;

TRUE if a link needs extra deref for vars.

(This needs to be parameterized)

Procedures exported to CompilerUtil

P5module: PUBLIC PROC = {

starts the code generation pass

moduleNode: Node = Module[];

nodeList: NodeList ¬ MimP5U.MakeNodeList[moduleNode];

root: ROPE ¬ MimCommandUtil.GetRootName[MimData.source.locator];

id: Symbols.Name ¬ seb[bb[Symbols.RootBti].id].hash;

ss: ConvertUnsafe.SubString = SymbolOps.SubStringForName[SymbolOps.own, id];

moduleName: ROPE ¬ ConvertUnsafe.SubStringToRope[ss];

namesFileName: ROPE ¬ MimCommandUtil.SetExtension[root, "names"];

nameStream: STREAM ¬ NIL;

err: ROPE ¬ NIL;

cg: IntCodeGen.CodeGenerator ¬ NIL;

cgd: REF ¬ NIL;

[cg: cg, data: cgd] ¬ IntCodeGen.GetCodeGenerator[];

IF MimData.switches['m] THEN cg ¬ NIL;

IF MimData.switches['i] THEN {

Make a names stream and (optionally) a types stream

[nameStream, err, ] ¬ MimSysOps.Open[namesFileName, $write];

IF err # NIL THEN {MimosaLog.ErrorRope[other, err]; RETURN};

IO.PutF1[nameStream, "-- %g \n", [rope[namesFileName]] ];

};

MimP5Install.GenInstallationProc[

FindProcDesc[Symbols.RootBti].name,

bb[Symbols.RootBti].type,

NARROW[modNode]];

IF enableIntCodeTransforms THEN {

There are simplifications necessary

model: IntCodeTwig.BaseModel ¬ IntCodeTwig.DoModule[modNode, MimData.switches];

lambda: IntCodeTwig.LambdaModel ¬ model.first;

nodeList ¬ MimP5U.MakeNodeList[model.module];

RewriteSymbols[model];

Now break open the cycles left in the models

WHILE lambda # NIL DO

next: IntCodeTwig.LambdaModel ¬ lambda.next;

lambda ¬ []; -- clobber the fields to the ground state

lambda ¬ next;

ENDLOOP;

model ¬ []; -- clobber the base model

};

{

cr: ROPE ¬ IO.PutFR["file: %g, module: %g, compiled at: %g",
[rope[root]], [rope[moduleName]], [time[BasicTime.Now[]]]];

cn: Node ¬ z.NEW[NodeRep.comment ¬ [bits: 0, details: comment[cr]]];

modNode.procs ¬ MimP5U.MakeNodeList[cn, modNode.procs];

};

MimBodyCorrect.FixBodies[modNode.procs];

make sure that there are BodyRecord objects for all procedures

IF MimData.switches['i] THEN {

Output to a simple stream (and icd extension)

tName: ROPE ¬ MimCommandUtil.SetExtension[root, "icd"];

st: STREAM ¬ NIL;

[st, err, ] ¬ MimSysOps.Open[tName, $write];

IF err # NIL THEN {MimosaLog.ErrorRope[other, err]; RETURN};

ParseIntCode.ToStream[st, nodeList];

[] ¬ MimSysOps.Close[st];

};

IF nameStream # NIL OR cg # NIL THEN {

There is either an external code generator or we need a names file

head: LORA ¬ NIL;

tail: LORA ¬ NIL;

inner: IntCodeUtils.Visitor = TRUSTED {

[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]

add: BOOL ¬ FALSE;

WITH node SELECT FROM

var: Var => add ¬ var.flags[named];

labelNode: LabelNode =>

WITH labelNode.label.node SELECT FROM

lambda: LambdaNode => add ¬ TRUE;

ENDCASE;

IF add THEN {

new: LORA ¬ LIST[node];

IF tail = NIL THEN head ¬ new ELSE tail.rest ¬ new;

tail ¬ new;

};

IntCodeUtils.MapNode[node, inner];

RETURN [node];

};

compare: List.CompareProc = TRUSTED {

delta: INT;

WITH ref1 SELECT FROM

var1: Var => WITH ref2 SELECT FROM

var2: Var => delta ¬ var1.id - var2.id;

labelNode2: LabelNode => RETURN [greater];

ENDCASE;

labelNode1: LabelNode => WITH ref2 SELECT FROM

var2: Var => RETURN [less];

labelNode2: LabelNode => delta ¬ labelNode1.label.id - labelNode2.label.id;

ENDCASE;

SELECT delta FROM

< 0 => RETURN [less];

> 0 => RETURN [greater];

ENDCASE => RETURN [equal];

};

table: CardTab.Ref ¬ NIL;

IntCodeUtils.MapNode[modNode, inner];

head ¬ List.UniqueSort[head, compare];

IF nameStream # NIL THEN {

We have been asked to generate a names file

FOR each: LORA ¬ head, each.rest WHILE each # NIL DO

WITH each.first SELECT FROM

var: Var => IF var.flags[named] THEN {

sei: Symbols.ISEIndex;

index: Tree.LinkRep ¬ LOOPHOLE[var.id];

index.tag ¬ VAL[0];

IO.PutF1[nameStream, "\n %g: ", [integer[LOOPHOLE[index]]] ];

index.tag ¬ symbol;

sei ¬ LOOPHOLE[index];

PrintSei[nameStream, sei];

};

labelNode: LabelNode => IF labelNode.label.id IN [0..100000) THEN {

bti: Symbols.BTIndex = LOOPHOLE[labelNode.label.id];

IO.PutF1[nameStream, "\n %%%g: ", [integer[LOOPHOLE[bti]]] ];

WITH b: bb[bti] SELECT FROM

Callable => PrintSei[nameStream, b.id];

ENDCASE => IO.PutRope[nameStream, "??"];

};

ENDCASE;

ENDLOOP;

IO.PutRope[nameStream, "\n\n"];

[] ¬ MimSysOps.Close[nameStream];

};

IF cg # NIL THEN {

There is an external code generator to call

msg: ROPE ¬ NIL;

namesTable: CardTab.Ref ¬ CardTab.Create[];

labelsTable: CardTab.Ref ¬ CardTab.Create[];

FOR each: LORA ¬ head, each.rest WHILE each # NIL DO

WITH each.first SELECT FROM

var: Var => IF var.flags[named] THEN {

sei: Symbols.ISEIndex;

index: Tree.LinkRep ¬ LOOPHOLE[var.id];

index.tag ¬ symbol;

sei ¬ LOOPHOLE[index];

[] ¬ CardTab.Store[namesTable, LOOPHOLE[var.id, CARD], RopeForSei[sei]];

};

labelNode: LabelNode => IF labelNode.label.id IN [0..100000) THEN {

bti: Symbols.BTIndex = LOOPHOLE[labelNode.label.id];

WITH b: bb[bti] SELECT FROM

Callable =>

[] ¬ CardTab.Store[labelsTable, LOOPHOLE[bti, CARD], RopeForSei[b.id]];

ENDCASE;

};

ENDCASE;

ENDLOOP;

msg ¬ cg[

fileName: root,

moduleName: moduleName,

versionStamp: IO.PutFR["[%g,%g]",
[cardinal[MimData.objectVersion[0]]],
[cardinal[MimData.objectVersion[1]]] ],
root: modNode,

names: namesTable,

labels: labelsTable,

data: cgd,

switches: MimData.switches];

IF msg # NIL THEN MimosaLog.ErrorRope[other, msg];

};

Cleanup

z.FREE[@linkToVarSeq];

(MimData.table).DropNotify[DriverNotify];

myBaseSeq ¬ NIL;

caseCV ¬ NIL;

xtractNode ¬ NIL;

mLock ¬ Tree.Null;

signalsVar ¬ NIL;

ClearProcDesc[procDescRoot];

procDescRoot ¬ NIL;

MimP5U.CgenUtilInit[NIL];

IntCodeUtils.MapNode[modNode, ClearNodes];

modNode ¬ NIL;

modVarsTail ¬ NIL;

};

Procedures exported to MimCode

RegisterNotifier: PUBLIC PROC [notifier: Alloc.Notifier] = {

notifierArray[notifiers] ¬ notifier;

notifiers ¬ notifiers + 1;

IF myBaseSeq # NIL THEN notifier[myBaseSeq];

};

Procedures exported to MimP5

visibleContext: PUBLIC REF MimP5.VisibalContextArray ¬ NIL;

MakeGlobal: PUBLIC PROC [bits: INT, type: Type ¬ typeANY]
RETURNS [v: Var, sei: ISEIndex] = {

oldTempCtx: Symbols.CTXIndex ¬ tempcontext;

new: VarList;

tempcontext ¬ MimData.mainCtx;

[v, sei] ¬ MimP5U.CreateTemp[bits: bits, type: type];

new ¬ MimP5U.MakeVarList[v];

SELECT TRUE FROM

modVarsTail # NIL => modVarsTail.rest ¬ new;

modNode.vars = NIL => modNode.vars ¬ new;

ENDCASE => ERROR;

modVarsTail ¬ new;

tempcontext ¬ oldTempCtx;

RETURN [v, sei];

};

P5Error: PUBLIC PROC [n: CARDINAL] = {

ERROR CodePassError[n];

};

ProcDescForBti: PUBLIC PROC [bti: CBTIndex, body: BOOL] RETURNS [Node] = {

new: REF ProcDescEntry ¬ FindProcDesc[bti];

node: Node ¬ new.body;

new.used ¬ TRUE;

IF node = NIL THEN ERROR;

IF NOT body THEN

node ¬ MimP5U.Address[node];

Don't cache this address, since it will cause trouble when transforming the nodes later on.

RETURN [node];

};

ProcLabelForBti: PUBLIC PROC [bti: CBTIndex, direct: BOOL] RETURNS [Node] = {

new: REF ProcDescEntry ¬ FindProcDesc[bti];

node: Node ¬ IF direct THEN new.directEntry ELSE new.indirectEntry;

new.used ¬ TRUE;

RETURN [node];

};

SignalForSei: PUBLIC PROC [sei: ISEIndex] RETURNS [Node] = {

SELECT SymbolOps.XferMode[SymbolOps.own, seb[sei].idType] FROM

signal, error => {

link: MobDefs.Link = SymbolOps.DecodeLink[seb[sei].idValue];

index: NAT = link.offset;

IF link.modIndex = 0 THEN {

This is a built-in signal or error like UNWIND or ABORTED.

sel: IntCodeDefs.MesaSelector =

SELECT index FROM

0 => unnamedError,

1 => unwindError,

2 => abortedError,

3 => uncaughtError,

4 => boundsError,

ENDCASE => ERROR;

RETURN [MimP5U.MesaOpNode[op: sel, bits: bitsPerSignal]];

};

RETURN [MimP5U.Address[MimP5U.TakeField[
signalsVar, index*bitsPerWord, bitsPerWord]]];

};

ENDCASE => ERROR;

};

VarForInterface: PUBLIC PROC [mod: MobDefs.ModuleIndex] RETURNS [Var] = {

Return a variable for the interface record

oldLen: ModuleIndex ¬ IF linkToVarSeq = NIL THEN 0 ELSE linkToVarSeq.length;

linkVar: Var ¬ NIL;

IF oldLen <= mod THEN {

newLen: ModuleIndex = MIN[MAX[mod+1, oldLen + oldLen/2 + 1], ModuleIndex.LAST];

newSeq: LinkVarSeq ¬ z.NEW[LinkVarSeqRep[newLen]];

newSeq.length ¬ mod+1;

IF linkToVarSeq # NIL THEN {

FOR i: ModuleIndex IN [0..oldLen) DO

newSeq[i] ¬ linkToVarSeq[i];

linkToVarSeq[i] ¬ NIL;

ENDLOOP;

z.FREE[@linkToVarSeq];

};

linkToVarSeq ¬ newSeq;

};

linkVar ¬ linkToVarSeq[mod];

IF linkVar = NIL THEN

Need to create a new link base

linkToVarSeq[mod] ¬ linkVar ¬ MakeGlobal[bitsPerPtr].v;

RETURN [linkVar];

};

VarForLink: PUBLIC PROC [link: MobDefs.Link, bits: INT] RETURNS [v: Var] = {

This comes to us from an interface or some other link

offset: CARD = Target.bitsPerRef * (link.offset + linkOverhead);

linkVar: Var ¬ VarForInterface[link.modIndex];

v ¬ MimP5U.TakeFieldVar[

MimP5U.Deref[linkVar, offset+bits, MimData.worstAlignment],

offset, bits];

};

Procedures exported to MimP5

Lock: PUBLIC PROC [node: Tree.Index] RETURNS [n: Node ¬ NIL] = {

saveLock: Tree.Link = mLock;

cl: CodeList ¬ MimP5U.NewCodeList[];

mLock ¬ tb[node].son[2];

substState.lock ¬ mLock;

SetLock[cl, mLock];

n ¬ MimP5U.MaybeBlock[cl, MimP5.StatementTree[tb[node].son[1]]];

mLock ¬ saveLock;

};

Result: PUBLIC PROC [node: Tree.Index] RETURNS [Node ¬ NIL] = {

generate code for RETURN inside of INLINE procs

cl: CodeList ¬ MimP5U.NewCodeList[];

resultVar: Var ¬ substState.resultVar;

monitored: BOOL ← tb[node].attr1;

returningNoGlobals: BOOL ← tb[node].attr2;

substState.lastResultExpr ¬ NIL;

substState.nResults ¬ substState.nResults + 1;

IF resultVar # NIL THEN {

returnOfAnotherCall: BOOL ¬ tb[node].attr3;

t1: Tree.Link ¬ tb[node].son[1];

dstType: Type = substState.resultType;

result: Node ¬ NIL;

IF returnOfAnotherCall

THEN result ¬ MimP5.Exp[t1]

ELSE {

list: NodeList ¬ MimP5.ExpList[t1, TRUE].head;

IF list.rest = NIL

THEN result ¬ list.first

ELSE result ¬ MimP5U.MakeComposite[list];

A compound variable

};

IF result # NIL AND result.bits # resultVar.bits THEN {

Similar code to that in ComAssign. Make it a common routine some day?

lbits: INT ¬ resultVar.bits;

rbits: INT ¬ result.bits;

SELECT lbits FROM

< rbits => {

We have to take a field of the value for the destination.

start: INT ¬ IF rbits <= bitsPerWord THEN rbits-lbits ELSE 0;

result ¬ MimP5U.TakeField[result, start, lbits];

};

> rbits => {

The destination is larger, so extend the value. If arithmetic or address extension, then use the conversion operators.

srcType: Type = SELECT TreeOps.OpName[t1] FROM

none, list => dstType,

ENDCASE => MimP5U.OperandType[t1];

result ¬ MimP5S.ExtendValue[result, dstType, srcType, lbits];

};

ENDCASE;

};

substState.lastResultExpr ¬ result;

MimP5U.MoreCode[cl, MimP5U.Assign[lhs: resultVar, rhs: result]];

};

IF substState.exitLabel = NIL THEN

We need a place to go to when we calculate a result

substState.exitLabel ¬ MimP5U.AllocLabel[];

IF substState.lastResultGoTo = NIL THEN

substState.lastResultGoTo ¬ MimP5U.MakeGoTo[substState.exitLabel];

substState.lastResult ¬ MimP5U.MaybeBlock[cl, substState.lastResultGoTo];

RETURN [substState.lastResult];

};

Resume: PUBLIC PROC [node: Tree.Index] RETURNS [Node ¬ NIL] = {

produce code for RESUME

returnOfAnotherCall: BOOL ¬ tb[node].attr3;

retvals: NodeList;

t1: Tree.Link ¬ tb[node].son[1];

totalBits: BitCount ¬ MimP5U.BitsForType[catchoutrecord];

IF returnOfAnotherCall

THEN retvals ¬ MimP5U.MakeNodeList[MimP5.Exp[t1]]

ELSE retvals ¬ MimP5.ExpList[t1, TRUE].head;

RETURN [MimP5U.ApplyOp[oper: MimP5U.MesaOpNode[resume], args: MimP5U.PadArgList[retvals]]];

};

Return: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = {

generate code for RETURN

cl: CodeList ¬ MimP5U.NewCodeList[];

monitored: BOOL ¬ tb[node].attr1;

returningNoGlobals: BOOL ← tb[node].attr2;

returnOfAnotherCall: BOOL ¬ tb[node].attr3;

retvals: NodeList;

t1: Tree.Link ¬ tb[node].son[1];

safend: Tree.Link ¬ t1;

totalBits: BitCount ¬ MimP5U.BitsForType[bodyOutRecord];

IF (Basics.LowHalf[totalBits] MOD bitsPerWord) # 0 THEN ERROR;

This catches some layout errors

IF CommonRet[t1] THEN {

The default return (or an explict return equivalent to the default return)

outCtx: CTXIndex =

IF bodyOutRecord = CSENull THEN CTXNull ELSE seb[bodyOutRecord].fieldCtx;

IF substState.exitLabel # NIL THEN {

There is a common return point that handles unlocking

MimP5U.Jump[cl, substState.exitLabel];

RETURN [MimP5U.MakeBlock[cl]];

};

IF monitored THEN LocalReleaseLock[cl, mLock];

RETURN [MimP5U.MaybeBlock[cl, MimP5U.MakeReturn[NodesForCtx[outCtx]]]];

};

IF monitored THEN safend ¬ MimP5U.ProcessSafens[cl: cl, t: t1];

Make the world safe (this may go away when we finish rethinking the whole safen issue).

IF returnOfAnotherCall

THEN retvals ¬ MimP5U.MakeNodeList[MimP5.Exp[safend]]

ELSE retvals ¬ MimP5.ExpList[safend, TRUE].head;

IF substState.exitLabel # NIL THEN {

There is a common return point that handles unlocking and returning

IF ListNeedsTemp[retvals] THEN MakeListNice[cl, retvals];

IF bodyOutRecord # RecordSENull THEN {

We need to assign to the return values

ctx: Symbols.CTXIndex = seb[bodyOutRecord].fieldCtx;

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

UNTIL sei = ISENull DO

var: Var ¬ MimP5.VarForSei[sei];

src: Node ¬ retvals.first;

IF returnOfAnotherCall

THEN {

retvals.first ¬ MimP5U.TakeField[src, var.bits, src.bits-var.bits];

src ¬ MimP5U.TakeField[src, 0, var.bits];

}

ELSE retvals ¬ retvals.rest;

MimP5U.MoreCode[cl, MimP5U.Assign[var, src]];

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

};

MimP5U.Jump[cl, substState.exitLabel];

RETURN [MimP5U.MakeBlock[cl]];

};

IF monitored THEN {

We have to evaluate these values into temporaries (sigh)

IF ListNeedsTemp[retvals] THEN MakeListNice[cl, retvals];

LocalReleaseLock[cl, mLock];

};

l ¬ MimP5U.MaybeBlock[cl, MimP5U.MakeReturn[retvals]];

};

RetWithError: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = {

generates code for procedure signal/error statement

In this procedure we do not try to generate optimal code. After all, this construct is used when semantics is paramount, rather than efficiency. Therefore, all exceptions & their arguments use temporaries.

The tricky (and important) part is to place the code that actually raisses the exception outside of the scope of any UNWIND that gets rid of the monitor lock.

cl: CodeList ¬ MimP5U.NewCodeList[];

psei: CSEIndex = MimP5U.OperandType[tb[node].son[1]];

sig: Node ¬ MimP5.Exp[tb[node].son[1]];

t2: Tree.Link ¬ tb[node].son[2];

monitored: BOOL ¬ tb[node].attr1;

exitLabel: Label ¬ MimP5U.AllocLabel[];

sigTemp: Var ¬ NIL;

argsList: NodeList ¬ NIL;

argsTemp: Var ¬ NIL;

prefixCL: CodeList ¬ substState.prefixCL;

postfixCL: CodeList ¬ substState.postfixCL;

Make sure that we have both prefix & postfix code lists

IF prefixCL = NIL THEN

We need a prefix code list

prefixCL ¬ substState.prefixCL ¬ MimP5U.NewCodeList[];

IF postfixCL = NIL THEN

We need a postfix code list

postfixCL ¬ substState.postfixCL ¬ MimP5U.NewCodeList[];

Process the safens first

t2 ¬ MimP5U.ProcessSafens[cl: cl, t: t2];

Evaluate the signal into a temporary

sigTemp ¬ MimP5U.MakeTemp[prefixCL, sig.bits].var;

MimP5U.MoreCode[cl, MimP5U.Assign[sigTemp, sig]];

Evaluate the arguments into a temporary (if there are any arguments)

argsList ¬ MimP5.ExpList[t2, TRUE].head;

IF argsList # NIL THEN {

argsVar: Var ¬ MimP5U.MakeComposite[MimP5U.PadArgList[argsList]];

argsTemp ¬ MimP5U.MakeTemp[prefixCL, argsVar.bits].var;

MimP5U.MoreCode[cl, MimP5U.Assign[argsTemp, argsVar]];

};

IF monitored THEN LocalReleaseLock[cl, mLock];

Monitored, so have to emit code to release the lock

Finally, emit the jump to get to the handler

MimP5U.Jump[cl, exitLabel];

Emit the code that actually raises the error (we emit this in the postfix to be in the right scope, which is outside the unwind for the monitor lock)

MimP5U.InsertLabel[postfixCL, exitLabel];

MimP5U.MoreCode[postfixCL,

MimP5.WrapSource[

node: MimP5U.ApplyOp[

oper: MimP5U.MesaOpNode[error],

args: IF argsTemp = NIL

THEN MimP5U.MakeArgList[sigTemp]

ELSE MimP5U.MakeArgList2[sigTemp, argsTemp]],

loc: LOOPHOLE[tb[node].info, SourceMap.Loc]

]

];

RETURN [MimP5U.MakeBlock[cl]];

};

MakeString: PUBLIC PROC [t: Tree.Link] RETURNS [Node] = {

WITH e: t SELECT TreeOps.GetTag[t] FROM

string => {

sti: Literals.STIndex ¬ e.index;

string: LONG STRING ¬ LiteralOps.StringValue[sti];

local: BOOL ¬ FALSE;

WITH s: stb[sti] SELECT FROM

heap => {

kind: IntCodeDefs.RefLitKind ¬ rope;

SELECT s.type FROM

MimData.idATOM => kind ¬ atom;

MimData.idTEXT => kind ¬ refText;

ENDCASE => kind ¬ rope;

RETURN [z.NEW[NodeRep.const.refLiteral ¬ [

bits: bitsPerPtr,

details: const[data: refLiteral[

litKind: kind,

contents: ConvertUnsafe.ToRope[string]]]]]];

};

copy => {sti ¬ s.link; local ¬ TRUE};

See Pass4Xb.Exp for this convention

master => {

align: NAT ¬ Target.bitsPerWord;

nchars: INT ¬ string.length;

extras: NAT ¬ bytesPerWord - (nchars MOD bytesPerWord);

bits: INT ¬ (nchars+extras)*bitsPerChar + 2*bitsPerStringBound;

init: Node ¬ z.NEW[NodeRep.const.bytes ¬ [

bits: bits,

details: const[bytes[align, RopeHoldingStringRep[string]]]]];

IF local THEN

Must make a local copy of the string

init ¬ MimP5U.MakeTemp[cl: localProcCodeList, bits: bits, init: init].var;

RETURN [MimP5U.Address[init]];

};

ENDCASE => ERROR;

ENDLOOP;

};

ENDCASE => ERROR;

};

RopeHoldingStringRep: PROC [string: LONG STRING] RETURNS [ByteSequence] = {

nchars: CARDINAL ¬ string.length;

writer: TargetConversions.Writer ¬ TargetConversions.NewWriter[];

extras: NAT ¬ bytesPerWord - (nchars MOD bytesPerWord);

TargetConversions.PutCard[writer, nchars, bitsPerStringBound];

TargetConversions.PutCard[writer, nchars+extras, bitsPerStringBound];

FOR i: CARDINAL IN [0..nchars) DO

TargetConversions.PutChar[writer, string[i]];

ENDLOOP;

THROUGH [0..extras) DO TargetConversions.PutChar[writer, 0C]; ENDLOOP;

For C we want strings to be null-terminated and padded out to a word

RETURN [TargetConversions.WriterContents[writer]];

};

StringInit: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = {

This generates the address of anonymous string bodies. Currently we always generate them in the local frame unless we are generating code for the initialization procedure, in which case the bodies are placed in the global frame.

cl: CodeList ¬ substState.cl;

nchars: INT = ConstArith.ToInt[MimP5U.TreeLiteralValue[tb[node].son[2]]];

bits: INT ¬ bitsPerChar*nchars + bitsPerStringBound*2;

bodyVar: Var ¬ IF mainBody
THEN MakeGlobal[bits].v
ELSE MimP5U.MakeTemp[cl, bits].var;

field: Var ¬ MimP5U.TakeFieldVar[bodyVar, 0, bitsPerStringBound*2];

list: NodeList ¬ MimP5U.MakeNodeList2[

MimP5U.MakeConstCard[0, bitsPerStringBound], -- length

MimP5U.MakeConstCard[nchars, bitsPerStringBound] -- max length

];

init: Node ¬ MimP5U.MakeComposite[list, bitsPerStringBound*2];

MimP5U.MoreCode[cl, MimP5U.Assign[lhs: field, rhs: init]];

RETURN [MimP5U.ApplyOp[
MimP5U.MesaOpNode[addr],
MimP5U.MakeNodeList[bodyVar], bitsPerPtr]];

};

Subst: PUBLIC PROC [node: Tree.Index, resultType: Type] RETURNS [result: Node ¬ NIL] = {

oldInInline: BOOL = inInline;

oldSubstState: SubstState = substState;

declCL: CodeList ¬ MimP5U.NewCodeList[];

cl: CodeList ¬ MimP5U.NewCodeList[];

bits: INT = MimP5U.BitsForType[resultType];

resultVar: Var =
IF resultType = nullType THEN NIL ELSE MimP5U.MakeTemp[declCL, bits].var;

argType: RecordSEIndex = SymbolOps.TransferTypes[SymbolOps.own, MimP5U.OperandType[tb[node].son[1]]].typeIn;

stmtList: Tree.Link = tb[node].son[2];

inInline ¬ TRUE;

substState ¬ [resultType: resultType, resultVar: resultVar, cl: cl];

{

stmtNode: Node ¬ MimP5.StatementTree[stmtList];

IF substState.lastResultGoTo # NIL THEN

IF NOT IntCodeStuff.NodeContains[stmtNode, substState.lastResultGoTo] THEN

substState.exitLabel ¬ NIL;

WITH stmtNode SELECT FROM

block: BlockNode => MimP5U.AppendNodeList[cl, block.nodes];

RRA: note that if a lock was declared in this block (due to an INLINE ENTRY PROC) that the node structure needs flattening so we can put the unlock within the scope of the declaration (sigh). In other cases the flattening certainly does not hurt.

ENDCASE => MimP5U.MoreCode[cl, stmtNode];

IF substState.exitLabel # NIL THEN

There is a label from some inner result

MimP5U.InsertLabel[cl, substState.exitLabel];

IF substState.lock # Tree.Null THEN

This is an INLINE ENTRY PROC

LocalReleaseLock[cl, substState.lock];

IF substState.postfixCL # NIL THEN

We have to wrap up this "procedure" due to RETURN WITH ERROR

cl ¬ ApplyPrefixAndPostfix[MimP5U.ExtractList[cl]];

IF resultType # nullType THEN {

There is a result variable, which should be outermost!

list: NodeList ¬ MimP5U.ExtractList[cl];

IF list # NIL AND list.rest = NIL THEN

The body was a single node

WITH StripSource[list.first] SELECT FROM

assign: REF NodeRep.assign =>

The body was a single assignment

IF assign.lhs = resultVar THEN {

The result of the INLINE is a simple expression!

result ¬ assign.rhs;

GO TO simple;

};

ENDCASE;

MimP5U.AppendNodeList[declCL, list];

cl ¬ declCL;

MimP5U.MoreCode[cl, resultVar];

};

result ¬ MimP5U.MakeBlock[cl, bits];

EXITS simple => {};

};

inInline ¬ oldInInline;

substState ¬ oldSubstState;

RETURN [result];

};

PushContext: PUBLIC PROC [label: Label, cl: CodeList, inner: PROC] = {

saveCaseCV: Node = caseCV;

saveCaseType: Symbols.Type = caseType;

oldInInline: BOOL = inInline;

oldProcCodeList: CodeList = localProcCodeList;

oldSubstState: SubstState = substState;

enclosingContext: Label ¬ visibleContext[curctxlvl];

curctxlvl ¬ curctxlvl + 1;

catchcount ¬ catchcount + 1;

visibleContext[curctxlvl] ¬ label;

substState ¬ [resultType: nullType, resultVar: NIL, cl: cl];

localProcCodeList ¬ cl;

inner[];

catchcount ¬ catchcount - 1;

curctxlvl ¬ curctxlvl - 1;

inInline ¬ oldInInline;

substState ¬ oldSubstState;

localProcCodeList ¬ oldProcCodeList;

caseCV ¬ saveCaseCV;

caseType ¬ saveCaseType;

};

Private procedures & signals

ApplyPrefixAndPostfix: PROC [list: NodeList] RETURNS [CodeList] = {

There is code that we must wrap around the procedure body to handle returning with error. The caller must ensure that substState.postfixCL # NIL.

prefixCL: CodeList = substState.prefixCL;

postfixCL: CodeList = substState.postfixCL;

afterLabel: Label = MimP5U.AllocLabel[];

MimP5U.AppendNodeList[prefixCL, list];

Emit the code we want wrapped

MimP5U.Jump[prefixCL, afterLabel];

In case control flows through to this point we must jump around the next code

MimP5U.AppendNodeList[prefixCL, MimP5U.ExtractList[postfixCL]];

Exceptional code is emitted here

MimP5U.InsertLabel[prefixCL, afterLabel];

Normal control resumes here

substState.prefixCL ¬ NIL;

substState.postfixCL ¬ NIL;

RETURN [prefixCL];

};

BlockTail: PROC [node: Node] RETURNS [NodeList] = {

nodes: NodeList ¬ NIL;

WITH node SELECT FROM

block: BlockNode => nodes ¬ block.nodes;

source: SourceNode => nodes ¬ source.nodes;

ENDCASE => RETURN [NIL];

WHILE nodes # NIL DO

next: NodeList ¬ nodes.rest;

IF next = NIL THEN

WITH nodes.first SELECT FROM

block: BlockNode => next ¬ block.nodes;

source: SourceNode => next ¬ source.nodes;

ENDCASE => RETURN [nodes];

nodes ¬ next;

ENDLOOP;

RETURN [NIL];

};

CodePassError: ERROR [n: CARDINAL] = CODE;

CollectConstants: PROC [cl: CodeList] = {

EachBody: PROC [bti: Symbols.BTIndex] RETURNS [stop: BOOL ¬ FALSE] = {

The first pass is just to setup the proc desc structure and collect constants that were not processed previously.

const: BOOL ¬ TRUE;

inAssign: BOOL ¬ FALSE;

Mapper: Tree.Map = {

[t: Tree.Link] RETURNS [v: Tree.Link]

v ¬ t;

WITH e: t SELECT TreeOps.GetTag[t] FROM

subtree => IF t # Tree.Null THEN {

node: Tree.Index = e.index;

oldConst: BOOL ¬ const;

needsMap: BOOL ¬ FALSE;

const ¬ TRUE;

SELECT name FROM

mwconst, construct, rowcons, all, union, cast, pad, lengthen, shorten => {

These are the collectible constants

const ¬ MimP5S.WillEvalToConst[t, TRUE];

IF const THEN {

bits: INT ¬ MimP5U.BitsForOperand[t];

IF inAssign AND noCollectConstAssigns THEN GO TO noCollect;

IF bits < minMemoBits OR bits > maxMemoBits THEN GO TO noCollect;

Too small or too large to worry about memoizing

FOR each: ConstList ¬ constListHead, each.rest WHILE each # NIL DO

IF each.bits # bits THEN LOOP;

IF each.name # name THEN LOOP;

IF TreeSame[t, each.tree] THEN {

The constant is already collected

v ¬ each.var;

each.uses¬ each.uses + 1;

const ¬ oldConst;

GO TO done;

};

ENDLOOP;

{

At this point we need to construct a new constant

node: Node ¬ MimP5.Exp[t];

lcl: CodeList = MimP5U.NewCodeList[];

type: Type ¬ MimP5U.TypeForTree[t];

temp: Var;

sei: ISEIndex;

[temp, sei] ¬ MakeGlobal[bits, MimP5U.TypeForTree[t]];

v ¬ [symbol[sei]];

constListHead ¬ z.NEW[ConstEntry ¬ [

rest: constListHead,

var: v,

bits: bits,

uses: 1,

tree: t

]];

node ¬ MimP5S.ComAssign[v, t, [
init: TRUE,
counted: SymbolOps.RCType[SymbolOps.own, type] # none,
skipZeros: TRUE]];

MimP5U.MoreCode[lcl, node];

MimP5U.MoreCode[cl, MimP5U.MakeBlock[lcl]];

seb[sei].immutable ¬ TRUE;

seb[sei].idDecl ¬ 2;

Indicate that this is a collected constant (see MimStore.WillEvalToConst & MimExpr.VarForSei)

};

const ¬ oldConst;

GO TO done;

};

ENDCASE;

SELECT name FROM

assign, assignx => {

We are in an assignment node

inAssign ¬ FALSE;

tb[node].son[1] ¬ Mapper[tb[node].son[1]];

inAssign ¬ TRUE;

tb[node].son[2] ¬ Mapper[tb[node].son[2]];

inAssign ¬ FALSE;

};

decl => {

We are in an declaration node (only map the init)

init: Tree.Link = tb[node].son[3];

IF init # Tree.Null THEN {

inAssign ¬ TRUE;

tb[node].son[3] ¬ Mapper[tb[node].son[3]];

inAssign ¬ FALSE;

};

new => {

We are in a NEW node

inAssign ¬ FALSE;

tb[node].son[1] ¬ Mapper[tb[node].son[1]];

tb[node].son[2] ¬ Mapper[tb[node].son[2]];

inAssign ¬ TRUE;

tb[node].son[3] ¬ Mapper[tb[node].son[3]];

inAssign ¬ FALSE;

};

construct, rowcons => {

Don't change the value of inAssign, only map the second son

tb[node].son[2] ¬ Mapper[tb[node].son[2]];

};

all, union, cast, pad, list, lengthen, shorten => {

Don't change the value of inAssign, map all sons

[] ¬ TreeOps.UpdateLeaves[e, Mapper];

};

ENDCASE => {

Indicate that we are NOT in an assignment

inAssign ¬ FALSE;

[] ¬ TreeOps.UpdateLeaves[e, Mapper];

};

GO TO noCollect;

EXITS

done => {};

noCollect => const ¬ FALSE;

};

symbol => {

const ¬ FALSE;

FOR each: ConstList ¬ constListHead, each.rest WHILE each # NIL DO

IF v = t THEN {const ¬ TRUE; EXIT};

ENDLOOP;

};

ENDCASE;

};

WITH body: bb[bti] SELECT FROM

Callable =>

IF ~body.inline AND body.hints.pad = 0 THEN

WITH bi: bb[bti].info SELECT FROM

Internal => {

bodyNode: Tree.Index ¬ bi.bodyTree;

[] ¬ TreeOps.UpdateLeaves[[subtree[bodyNode]], Mapper];

};

ENDCASE;

};

TreeSame: PROC [t1, t2: Tree.Link] RETURNS [BOOL] = {

IF t1 = t2 THEN RETURN [TRUE];

WITH e1: t1 SELECT TreeOps.GetTag[t1] FROM

subtree => {

tp1: Tree.NodePtr = @tb[e1.index];

WITH e2: t2 SELECT TreeOps.GetTag[t2] FROM

subtree => {

tp2: Tree.NodePtr = @tb[e2.index];

SELECT TRUE FROM

tp1.name # tp2.name => {};

tp1.nSons # tp2.nSons => {};

tp1.info # tp2.info => {};

tp1.subInfo # tp2.subInfo => {};

tp1.attr1 # tp2.attr1 => {};

tp1.attr2 # tp2.attr2 => {};

tp1.attr3 # tp2.attr3 => {};

ENDCASE => {

FOR i: NAT IN [1..tp1.nSons] DO

IF NOT TreeSame[tp1.son[i], tp2.son[i]] THEN RETURN [FALSE];

ENDLOOP;

RETURN [TRUE];

};

ENDCASE;

};

ENDCASE;

RETURN [FALSE];

};

ConstList: TYPE = REF ConstEntry;

ConstEntry: TYPE = RECORD [

rest: ConstList,

var: Tree.Link,

bits: INT,

uses: INT,

tree: Tree.Link];

constListHead: ConstList ¬ NIL;

[] ¬ SymbolOps.EnumerateBodies[SymbolOps.own, Symbols.RootBti, EachBody];

WHILE constListHead # NIL DO

next: ConstList ¬ constListHead.rest;

z.FREE[@constListHead];

constListHead ¬ next;

ENDLOOP;

};

CommonRet: PROC [t: Tree.Link] RETURNS [common: BOOL ¬ TRUE] = {

test if the returns list duplicats the returns declaration

sei: ISEIndex;

Item: PROC [t: Tree.Link] RETURNS [BOOL] = {

WITH t SELECT TreeOps.GetTag[t] FROM

symbol => common ¬ (sei = index);

literal, subtree => common ¬ FALSE;

ENDCASE;

IF sei # ISENull THEN sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

RETURN [~common]

};

IF t = Tree.Null THEN RETURN;

IF bodyOutRecord # CSENull

THEN sei ¬ MimP5U.NextVar[ctxb[seb[bodyOutRecord].fieldCtx].seList]

ELSE RETURN [FALSE];

TreeOps.SearchList[t, Item];

};

FindProcDesc: PROC [bti: CBTIndex] RETURNS [new: REF ProcDescEntry ¬ NIL] = {

This routine finds the existing proc desc data for the given bti, returning NIL if not such structure is present.

SELECT bb[bti].kind FROM

Outer => {

An outer level procedure (=> descriptor is in global frame)

new ¬ procDescRoot;

};

Inner => {

A nested procedure (we fill in the variable later)

pBti: Symbols.BTIndex ¬ bti;

pBti ¬ SymbolOps.ParentBti[SymbolOps.own, pBti];

WITH body: bb[pBti] SELECT FROM

Callable => IF NOT body.inline AND body.hints.pad = 0 THEN {

new ¬ MakeProcDesc[pBti].child;

EXIT;

};

ENDCASE;

ENDLOOP;

};

ENDCASE => ERROR;

A catch phrase !?!?

WHILE new # NIL DO

IF new.bti = bti THEN RETURN;

new ¬ new.rest;

ENDLOOP;

};

GetFormals: PROC [irecord: RecordSEIndex] RETURNS [VarList] = {

IF irecord = CSENull THEN RETURN [NIL];

RETURN [VarsForCtx[seb[irecord].fieldCtx]];

};

IsVarInCtx: PROC [sei: ISEIndex, ctx: CTXIndex] RETURNS [BOOL] = {

IF ctx # CTXNull THEN {

each: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

WHILE each # ISENull DO

IF sei = each THEN RETURN [TRUE];

each ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, each]];

ENDLOOP;

};

RETURN [FALSE];

};

ListNeedsTemp: PROC [nodeList: NodeList] RETURNS [BOOL] = {

FOR each: NodeList ¬ nodeList, each.rest WHILE each # NIL DO

IF NeedsTemp[each.first] THEN RETURN [TRUE];

ENDLOOP;

RETURN [FALSE];

};

LocalReleaseLock: PROC [cl: CodeList, lock: Tree.Link] = {

node: Node = MimP5.Exp[lock];

rel: Node = MimP5U.ApplyOp[
oper: MimP5U.MesaOpNode[monitorExit],
args: MimP5U.MakeArgList[MimP5U.Address[node]],
bits: 0];

MimP5U.MoreCode[cl, rel];

};

MakeListNice: PROC [cl: CodeList, nodeList: NodeList] = {

FOR each: NodeList ¬ nodeList, each.rest WHILE each # NIL DO

n: Node = each.first;

IF NeedsTemp[n] THEN each.first ¬ MimP5S.Temporize[cl, n];

ENDLOOP;

};

MakeProcDesc: PROC [bti: BTIndex] RETURNS [new: REF ProcDescEntry ¬ NIL] = {

If proc desc data exists for the given bti, this routine returns it (just like FindProcDesc). Otherwise this routine makes up new proc desc data for the given bti, properly linking it into the tree structure, but not initializing the descriptor variables.

parent: REF ProcDescEntry ¬ NIL;

IF bti = Symbols.BTNull THEN ERROR;

WITH body: bb[bti] SELECT FROM

Callable => {

IF body.inline THEN ERROR;

SELECT body.kind FROM

Outer =>

An outer level procedure (=> descriptor is in global frame)

new ¬ procDescRoot;

Inner => {

A nested procedure (=> descriptor is in local frame)

pBti: Symbols.BTIndex ¬ bti;

pBti ¬ SymbolOps.ParentBti[SymbolOps.own, pBti];

WITH bb[pBti] SELECT FROM

Callable => {

parent ¬ MakeProcDesc[pBti];

new ¬ parent.child;

EXIT;

};

ENDCASE;

ENDLOOP;

};

ENDCASE => ERROR;

A catch phrase !?!?

};

ENDCASE => ERROR;

I don't understand!

WHILE new # NIL DO

IF new.bti = bti THEN RETURN;

new ¬ new.rest;

ENDLOOP;

IF new = NIL THEN {

There was no previous entry, so make a new one. For each nested procedure we need to reserve a descriptor body. This consists of two words, where the first word contains the starting PC, and the second word contains 0 (for global variables) or 1 (for local variables). A procedure descriptor is then the address of the descriptor body.

label: Label = MimP5U.AllocLabel[id: LOOPHOLE[bti]];

directEntry: Node ¬ MimP5U.LabelAddress[label, TRUE];

indirectEntry: Node ¬ MimP5U.LabelAddress[label, FALSE];

new ¬ z.NEW[ProcDescEntry ¬ [
bti: LOOPHOLE[bti], parent: parent,
directEntry: directEntry, indirectEntry: indirectEntry, label: label]];

WITH b: bb[bti] SELECT FROM

Callable => {

out: STREAM ¬ IO.ROS[];

PrintSei[out, b.id];

new.name ¬ IO.RopeFromROS[out];

IF LOOPHOLE[bti, CARD] > LOOPHOLE[maxBti, CARD] THEN {

Maintain the maximum bti for bti verification

maxBti ¬ LOOPHOLE[bti];

};

ENDCASE;

IF parent = NIL

THEN {

An outer level procedure (=> descriptor is in global frame)

new.rest ¬ procDescRoot;

procDescRoot ¬ new;

}

ELSE {

A nested procedure (we fill in the variable later)

new.rest ¬ parent.child;

parent.child ¬ new;

};

Module: PROC RETURNS [Node] = {

main driver for code generation

bodies: CodeList ¬ MimP5U.NewCodeList[];

Body1: PROC [bti: Symbols.BTIndex] RETURNS [stop: BOOL ¬ FALSE] = {

The first pass is just to setup the proc desc structure and collect constants that were not processed previously.

WITH body: bb[bti] SELECT FROM

Callable => IF ~body.inline AND body.hints.pad = 0 THEN [] ¬ MakeProcDesc[bti];

ENDCASE;

};

Body2: PROC [bti: Symbols.BTIndex] RETURNS [stop: BOOL ¬ FALSE] = {

The second pass actually generates the code.

WITH body: bb[bti] SELECT FROM

Callable => IF ~body.inline AND body.hints.pad = 0 THEN

MimP5U.MoreCode[bodies, ProcBody[LOOPHOLE[bti]]];

ENDCASE;

};

(MimData.table).AddNotify[DriverNotify];

maxBti ¬ Symbols.RootBti;

procDescRoot ¬ NIL;

linkToVarSeq ¬ NIL;

inInline ¬ FALSE;

visibleContext ¬ z.NEW[MimP5.VisibalContextArray ¬ ALL[NIL]];

substState ¬ z.NEW[SubstState ¬ []];

{

modNode ¬ z.NEW[module NodeRep ¬ [details:
module[vars: VarsForCtx[MimData.mainCtx], procs: NIL]]];

fill in procs below

maxGlobalVarId ¬ 0;

FOR each: VarList ¬ modNode.vars, each.rest WHILE each # NIL DO

id: INT ¬ each.first.id;

IF id > maxGlobalVarId THEN maxGlobalVarId ¬ id;

ENDLOOP;

modVarsTail ¬ modNode.vars;

IF modVarsTail # NIL THEN

WHILE modVarsTail.rest # NIL DO modVarsTail ¬ modVarsTail.rest; ENDLOOP;

bodyInRecord ¬ bodyOutRecord ¬ RecordSENull;

MimP5U.CgenUtilInit[MimData.table];

inlineFileLoc ¬ SourceMap.nullLoc;

xtracting ¬ FALSE;

caseCV ¬ NIL;

catchoutrecord ¬ RecordSENull;

[] ¬ SymbolOps.EnumerateBodies[SymbolOps.own, Symbols.RootBti, Body1];

IF MimData.nSigCodes # 0 THEN

signalsVar ¬ MakeGlobal[MimData.nSigCodes*bitsPerWord].v;

[] ¬ SymbolOps.EnumerateBodies[SymbolOps.own, Symbols.RootBti, Body2];

modNode.procs ¬ bodies.head;

};

z.FREE[@visibleContext];

z.FREE[@substState];

RETURN [modNode]

};

NeedsTemp: PROC [node: Node] RETURNS [BOOL] = {

This routine tests for the node involving some quantity that could be monitor protected. As a basis, constants and constant variables are unprotected. Most compositions of unprotected nodes are also unprotected.

n: Node ¬ node;

WHILE n # NIL DO

list: NodeList ¬ NIL;

WITH n SELECT FROM

v: REF NodeRep.var => {

IF v.flags[constant] THEN EXIT;

WITH v.location SELECT FROM

local: REF LocationRep.localVar => RETURN [FALSE];

dummy: REF LocationRep.dummy => RETURN [FALSE];

field: REF LocationRep.field => {n ¬ field.base; LOOP};

indexed: REF LocationRep.indexed =>

IF NeedsTemp[indexed.base]
THEN RETURN [TRUE]
ELSE {n ¬ indexed.index; LOOP};

comp: REF LocationRep.composite => list ¬ comp.parts;

ENDCASE;

RETURN [TRUE];

};

c: REF NodeRep.const => EXIT;

block: REF NodeRep.block => list ¬ block.nodes;

decl: REF NodeRep.decl => {n ¬ decl.init; LOOP};

assign: REF NodeRep.assign =>

IF NeedsTemp[assign.lhs] THEN RETURN [TRUE] ELSE {n ¬ assign.rhs; LOOP};

cond: REF NodeRep.cond => {

FOR each: CaseList ¬ cond.cases, each.rest WHILE each # NIL DO

IF ListNeedsTemp[each.tests] THEN RETURN [TRUE];

IF NeedsTemp[each.body] THEN RETURN [TRUE];

ENDLOOP;

RETURN [FALSE];

};

label: REF NodeRep.label => {n ¬ label.label.node; LOOP};

apply: REF NodeRep.apply => {

WITH apply.proc SELECT FROM

oper: REF NodeRep.oper =>

SELECT oper.oper.kind FROM

arith, boolean, convert, check, compare, mesa, cedar => {

These operations do not have side effects on data that are monitor protected unless their arguments can be monitor protected.

IF apply.handler # NIL THEN RETURN [TRUE];

list ¬ apply.args;

};

ENDCASE => RETURN [TRUE];

};

source: REF NodeRep.source => list ¬ source.nodes;

ENDCASE => RETURN [TRUE];

WHILE list # NIL DO

IF NeedsTemp[list.first] THEN RETURN [TRUE];

list ¬ list.rest;

IF list = NIL THEN RETURN [FALSE];

ENDLOOP;

EXIT;

ENDLOOP;

RETURN [FALSE];

};

NodesForCtx: PROC [ctx: CTXIndex] RETURNS [vl: NodeList ¬ NIL] = {

IF ctx # CTXNull THEN {

tail: NodeList ¬ NIL;

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

UNTIL sei = ISENull DO

var: Var ¬ MimP5.VarForSei[sei];

this: NodeList ¬ MimP5U.MakeNodeList[var];

IF tail = NIL THEN vl ¬ this ELSE tail.rest ¬ this;

tail ¬ this;

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

};

PrintSei: PROC [st: STREAM, sei: Symbols.ISEIndex] = TRUSTED {

s: ConvertUnsafe.SubString ¬ SymbolOps.SubStringForName[SymbolOps.own, name];

FOR i: CARDINAL IN [s.offset..s.offset+s.length) DO

IO.PutChar[st, s.base[i]];

ENDLOOP;

};

RopeForSei: PROC [sei: Symbols.ISEIndex] RETURNS [ROPE] = TRUSTED {

s: ConvertUnsafe.SubString ¬ SymbolOps.SubStringForName[SymbolOps.own, name];

i: CARDINAL ¬ s.offset;

eachChar: SAFE PROC RETURNS [c: CHAR] = TRUSTED {

c ¬ s.base[i];

i ¬ i + 1;

};

RETURN [Rope.FromProc[len: s.length, p: eachChar]];

};

ProcBody: PROC [bti: Symbols.CBTIndex] RETURNS [Node] = {

produces code for body

oldSubstState: SubstState ¬ substState;

oldLocalProcList: CodeList ¬ localProcCodeList;

cl: CodeList ¬ MimP5U.NewCodeList[];

desc: REF ProcDescEntry ¬ FindProcDesc[bti];

procLabel: Label ¬ desc.label;

lambda: LambdaNode ¬ NIL;

enclosingContext: Label ¬ NIL;

substState ¬ [cl: cl, prefixCL: NIL, postfixCL: NIL];

localProcCodeList ¬ cl;

mainBody ¬ (bti = Symbols.RootBti);

MimData.bodyIndex ¬ bti;

MimData.textIndex ¬ SourceMap.Up[bb[bti].sourceIndex];

WITH bi: bb[bti].info SELECT FROM

Internal => {

bodyNode: Tree.Index ¬ bi.bodyTree;

kind: IntCodeDefs.LambdaKind ¬ outer;

curctxlvl ¬ bb[bti].level;

FOR pd: REF ProcDescEntry ¬ desc, pd.parent WHILE pd # NIL DO

Fill in the context stack

pBti: CBTIndex = pd.bti;

level: Symbols.ContextLevel ¬ bb[pBti].level;

visibleContext[level] ¬ pd.label;

ENDLOOP;

IF curctxlvl >= Symbols.lL THEN {

enclosingContext ¬ visibleContext[curctxlvl.PRED];

IF curctxlvl > Symbols.lL THEN kind ¬ inner;

};

IF mainBody THEN kind ¬ init;

set up input and output contexts

[bodyInRecord, bodyOutRecord] ¬
SymbolOps.TransferTypes[SymbolOps.own, bb[bti].ioType];

fileLoc ¬ SourceMap.Up[bb[bti].sourceIndex];

tailJumpOK ¬ TRUE;

SymbolOps.SetCtxLevel[tempcontext, curctxlvl];

lambda ¬ z.NEW[NodeRep.lambda ¬ [details: lambda[
parent: enclosingContext,
kind: kind,
descBody: NIL,
bitsOut: MimP5U.BitsForType[bodyOutRecord],
formalArgs: GetFormals[bodyInRecord], body: NIL]]];

will fill in body field soon

do type table and string literals

substState.resultType ¬ bodyOutRecord;

IF bodyOutRecord # RecordSENull THEN {

declare return variable(s)

ctx: Symbols.CTXIndex = seb[bodyOutRecord].fieldCtx;

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

IF MimP5U.BitsForType[bodyOutRecord] > bitsPerWord THEN {

substState.exitLabel ¬ MimP5U.AllocLabel[];

};

UNTIL sei = ISENull DO

MimP5U.Declare[cl: cl, var: MimP5.VarForSei[sei]];

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

};

initialize the proc descriptors

IF bti = Symbols.RootBti THEN {

Emit declarations for the descriptors for the main body procs.

FOR each: REF ProcDescEntry ¬ procDescRoot, each.rest WHILE each # NIL DO

For each procedure we need to reserve a descriptor body and the descriptor.

bodyVar: Var ¬ MakeGlobal[bitsPerProcDesc].v;

WITH bodyVar.location SELECT FROM

glob: REF LocationRep.globalVar =>

bb[each.bti].frameOffset ¬ glob.id / Target.bitsPerAU;

ENDCASE => ERROR;

each.body ¬ bodyVar;

bodyVar.flags[constant] ¬ TRUE;

ENDLOOP;

Collect constants into the global frame

IF collectConstants THEN CollectConstants[cl];

};

FOR each: REF ProcDescEntry ¬ desc.child, each.rest WHILE each # NIL DO

For each nested procedure we need to reserve a descriptor body and the descriptor.

init: Node ¬ MimP5U.MakeComposite[

MimP5U.MakeNodeList2[each.indirectEntry, MimP5U.MakeConstCard[1]],

bitsPerProcDesc];

each.body ¬ MimP5S.Temporize[cl, init];

ENDLOOP;

do initialization code and main body

mLock ¬ Tree.Null;

IF bb[bti].entry THEN {

IF substState.exitLabel # NIL THEN substState.exitLabel ¬ MimP5U.AllocLabel[];

mLock ¬ tb[bodyNode].son[4];

SetLock[cl, mLock];

};

generate code for declaration initializations and statements

MimP5.DeclList[cl, tb[bodyNode].son[2]];

MimP5.StatementList[cl, tb[bodyNode].son[3]];

IF substState.exitLabel # NIL THEN {

There is a common unlock point and a common return point

MimP5U.InsertLabel[cl, substState.exitLabel];

IF mLock # Tree.Null THEN LocalReleaseLock[cl, mLock];

IF bodyOutRecord # RecordSENull THEN {

ctx: Symbols.CTXIndex = seb[bodyOutRecord].fieldCtx;

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

head: NodeList ¬ NIL;

tail: NodeList ¬ NIL;

UNTIL sei = ISENull DO

new: NodeList ¬ MimP5U.MakeArgList[MimP5.VarForSei[sei]];

IF tail = NIL THEN head ¬ new ELSE tail.rest ¬ new;

tail ¬ new;

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

MimP5U.MoreCode[cl, MimP5U.MakeReturn[head]];

};

ENDCASE;

lambda.body ¬ MimP5U.MakeNodeList[MimP5.WrapSourceBlock[cl, bti, FALSE]];

Note that the lambda node takes care of scoping. WrapSourceBlock can be told to avoid emitting a block node.

IF substState.postfixCL # NIL THEN

We have to wrap up this procedure due to RETURN WITH ERROR

lambda.body ¬ MimP5U.ExtractList[ApplyPrefixAndPostfix[lambda.body]];

Put the name as a comment in the front

lambda.body ¬ MimP5U.MakeNodeList[

z.NEW[NodeRep.comment ¬ [details: comment[Rope.Concat[desc.name, ":"]]]],

lambda.body];

IF desc.parent # NIL THEN lambda.descBody ¬ desc.body;

procLabel.node ¬ lambda;

substState ¬ oldSubstState;

localProcCodeList ¬ oldLocalProcList;

RETURN [z.NEW[NodeRep.label ¬ [details: label[procLabel]]]];

};

SetLock: PROC [cl: CodeList, lock: Tree.Link] = {

node: Node ¬ MimP5.Exp[lock];

set: Node = MimP5U.ApplyOp[
oper: MimP5U.MesaOpNode[monitorEntry],
args: MimP5U.MakeArgList[MimP5U.Address[node]],
bits: 0];

MimP5U.MoreCode[cl, set];

};

StripExtraDecl: PROC [node: Node] RETURNS [Node] = {

For blocks of the form

{decl V; V ← E; V}

Transform them into simply E

WITH StripSource[node] SELECT FROM

block: REF NodeRep.block => {

list: NodeList ¬ block.nodes;

IF list # NIL THEN

WITH StripSource[list.first] SELECT FROM

decl: REF NodeRep.decl => IF decl.init = NIL THEN {

r1: NodeList ¬ list.rest;

IF r1 # NIL THEN {

var: Var ¬ decl.var;

IF var # NIL AND NOT var.flags[named] THEN {

A decl of an unnamed variable

n2: Node ¬ StripSource[r1.first];

WITH StripSource[r1.first] SELECT FROM

assign: REF NodeRep.assign => IF assign.lhs = var THEN {

Followed by an assignment to that variable

r2: NodeList ¬ r1.rest;

IF r2 # NIL AND r2.rest = NIL THEN

WITH StripSource[r2.first] SELECT FROM

rvar: Var => IF rvar = var THEN

Followed by a return of that variable

RETURN [assign.rhs];

ENDCASE;

};

ENDCASE;

};

ENDCASE;

};

ENDCASE;

RETURN [node];

};

StripSource: PROC [node: Node] RETURNS [Node] = {

WITH node SELECT FROM

source: SourceNode => {

nodes: NodeList ¬ source.nodes;

IF nodes # NIL AND nodes.rest = NIL THEN {node ¬ nodes.first; LOOP};

};

ENDCASE;

RETURN [node];

ENDLOOP;

};

ClearProcDesc: PROC [pd: REF ProcDescEntry] = {

WHILE pd # NIL DO

next: REF ProcDescEntry ¬ pd.rest;

ClearProcDesc[pd.child];

pd ¬ [];

pd ¬ next;

ENDLOOP;

};

ClearNodes: IntCodeUtils.Visitor = CHECKED {

[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]

IF node # NIL THEN IntCodeUtils.MapNode[node, ClearNodes];

RETURN [NIL];

};

VarsForCtx: PROC [ctx: CTXIndex] RETURNS [vl: VarList ¬ NIL] = {

IF ctx # CTXNull THEN {

tail: VarList ¬ NIL;

sei: ISEIndex ¬ MimP5U.NextVar[ctxb[ctx].seList];

UNTIL sei = ISENull DO

var: Var ¬ MimP5.VarForSei[sei];

this: VarList ¬ MimP5U.MakeVarList[var];

IF tail = NIL THEN vl ¬ this ELSE tail.rest ¬ this;

tail ¬ this;

sei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, sei]];

ENDLOOP;

};

Symbol Table Rewrite

RewriteSymbols: PROC [baseModel: IntCodeTwig.BaseModel] = {

This module takes the result of IntCodeTwig processing and rewrites portions of the symbol table to accomodate the derived information.

First take the offsets of the global variables and put them into the symbol table entries.

modNode: ModuleNode = NARROW[baseModel.module];

FOR each: VarList ¬ modNode.vars, each.rest WHILE each # NIL DO

var: Var ¬ each.first;

IF var # NIL THEN WITH var.location SELECT FROM

glob: REF LocationRep.globalVar => {

id: INT ¬ var.id;

IF id > 0 AND id <= maxGlobalVarId THEN {

This variable is (probably) from mainCtx

sei: Symbols.SEIndex ¬ Symbols.SENull + id;

WITH se: seb[sei] SELECT FROM

id => IF se.idCtx = MimData.mainCtx THEN

Definitely from mainCtx, so fill in the offset

se.idValue ¬ SymbolOps.EncodeBitAddr[[glob.id]];

ENDCASE;

CopyVarFlags[var];

};

ENDCASE;

ENDLOOP;

Now make up variables for each "special" variable

FOR lambda: IntCodeTwig.LambdaModel ¬ baseModel.first, lambda.next
WHILE lambda # NIL DO

label: Label = lambda.label;

IF label # NIL AND LOOPHOLE[label.id, CARD] <= LOOPHOLE[maxBti, CARD] THEN {

bti: CBTIndex = LOOPHOLE[label.id];

MakeSpecialVar: PROC [var: Var, kind: Symbols.SpecialVarKind] = {

IF var # NIL THEN WITH var.location SELECT FROM

local: REF LocationRep.localVar => {

bits: INT ¬ var.bits;

sei: ISEIndex ¬ SymbolOps.MakeCtxSe[Symbols.HTNull, Symbols.CTXNull];

ctx: CTXIndex = bb[bti].localCtx;

WITH se: seb[sei] SELECT FROM

linked => se.link ¬ ctxb[ctx].seList;

ENDCASE => ERROR;

seb[sei].idInfo ¬ SymbolOps.EncodeInt[bits];

seb[sei].idType ¬ typeANY;

seb[sei].special ¬ kind;

var.id ¬ LOOPHOLE[sei - Symbols.ISENull];

Since there should only be one instance of each special variable, shared from all places, this assignment should rename the variable globally.

ctxb[ctx].seList ¬ sei;

Remember to put this var into the context or all is for naught

};

ENDCASE;

};

MakeSpecialVar[lambda.frameExtension, frameExtension];

MakeSpecialVar[lambda.globalLink, globalLink];

MakeSpecialVar[lambda.staticLink, staticLink];

MakeSpecialVar[lambda.memoryLink, memoryLink];

MakeSpecialVar[lambda.returnVar, returnLink];

};

[] ¬ CopyFlags[lambda.lambda];

ENDLOOP;

};

CopyFlags: IntCodeUtils.Visitor = TRUSTED {

WITH node SELECT FROM

decl: REF NodeRep.decl =>

CopyVarFlags[decl.var];

lambda: REF NodeRep.lambda =>

FOR each: VarList ¬ lambda.formalArgs, each.rest WHILE each # NIL DO

CopyVarFlags[each.first];

ENDLOOP;

ENDCASE;

IntCodeUtils.MapNode[node, CopyFlags];

RETURN [node];

};

CopyVarFlags: PROC [var: Var] = {

IF var # NIL THEN {

These flags need copying into the symbol table

flags: IntCodeDefs.VariableFlags = var.flags;

IF flags[named] THEN {

sei: ISEIndex = Symbols.ISENull + CARD[var.id];

new: Symbols.VariableFlags ¬ seb[sei].flags;

IF flags[upLevel] THEN {

Copy not only the flags, but the offset

offset: INT ¬ 0;

new.upLevel ¬ new.valid ¬ TRUE;

WITH var.location SELECT FROM

field: REF LocationRep.field => offset ¬ field.start;

ENDCASE;

seb[sei].idValue ¬ SymbolOps.EncodeBitAddr[[offset]];

};

IF flags[addressed] THEN new.addressed ¬ new.valid ¬ TRUE;

IF flags[assigned] THEN new.assigned ¬ new.valid ¬ TRUE;

IF flags[used] THEN new.used ¬ new.valid ¬ TRUE;

IF flags[constant] THEN seb[sei].immutable ¬ TRUE;

seb[sei].flags ¬ new;

};