DIRECTORY
Alloc,
Code,
CodeDefs,
ComData,
FOpCodes,
IntCodeDefs,
IntCodeUtils,
LiteralOps,
P5,
P5U,
PackageSymbols,
PrincOps,
SourceMap,
SymbolOps,
Symbols,
Table,
Tree,
TreeOps;

CgenUtil: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, Alloc, CodeDefs, IntCodeUtils, LiteralOps, P5, SourceMap, SymbolOps, TreeOps 
EXPORTS P5U = BEGIN OPEN IntCodeDefs, SymbolOps, CodeDefs;

BitAddress: TYPE = Symbols.BitAddress;
CSEIndex: TYPE = Symbols.CSEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
SEIndex: TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
WordLength: CARDINAL = Symbols.WordLength;
BitCount: TYPE = INT; -- should it be Symbols.BitCount?
typeANY: CSEIndex = Symbols.typeANY;

table: Alloc.Handle _ NIL;

tb: Tree.Base;		-- tree base (local copy)
seb: Symbols.Base;		-- semantic entry base (local copy)
cb: CodeDefs.Base;		-- code base (local copy)
cstb: Table.Base;		-- constant table base (local copy)

CgenUtilNotify: PUBLIC Alloc.Notifier =
BEGIN  -- called by allocator whenever table area is repacked
seb _ base[Symbols.seType];
tb _ base[Tree.treeType];
cb _ base[codeType];
cstb _ base[PackageSymbols.constType];
END;

generatedLabel: LogicalId _ CARDINAL.LAST.LONG + 2;
AdjustLoc: PUBLIC PROC [vl: VLoc, rSei: Symbols.RecordSEIndex, fSei: Symbols.ISEIndex, tBits: BitCount] RETURNS [VLoc] =
BEGIN
length: BitCount = seb[rSei].length;
first: BOOL = (seb[fSei].idValue = 0);
delta: BitCount;
IF length < WordSize AND (delta _ tBits - length) # 0 THEN {
IF first THEN vl.size _ vl.size + delta
ELSE vl.disp _ vl.disp + delta};
RETURN[vl]
END;

AllocLabel: PUBLIC PROC [id: LogicalId _ 0] RETURNS [Label] = {
IF id = 0 THEN {id _ generatedLabel; generatedLabel _ generatedLabel + 1};
RETURN [z.NEW [LabelRep _ [id: id, node: NIL]]]};

ApplyOp: PUBLIC PROC [oper: Node, args: NodeList, bits: BitCount] RETURNS [l: ApplyNode] = {
l _ z.NEW[NodeRep.apply _ [bits: bits, details: apply[proc: oper, args: args]]]};

CachedArithOperRep: TYPE = ARRAY ArithTypeIndex OF ARRAY ArithSelector OF Node;
cachedArithOper: REF CachedArithOperRep _ NIL; -- *** reset if z goes away

arithClassValue: ARRAY ArithTypeIndex OF ArithClass = [
shortUnsigned: [unsigned, 16],
shortSigned: [signed, 16],
longUnsigned: [unsigned, 32],
longSigned: [signed, 32],
shortReal: [real, 32],
longReal: [real, 64]];


ArithTypeForTree: PUBLIC PROC [node: Tree.Index] RETURNS [ati: ArithTypeIndex] = {
RETURN[
IF tb[node].attr1 THEN shortReal
ELSE IF tb[node].attr3 THEN 
IF tb[node].attr2 THEN longSigned ELSE shortSigned 
ELSE IF tb[node].attr2 THEN longUnsigned ELSE shortUnsigned];
};


ArithOp: PUBLIC PROC [op: ArithSelector, ati: ArithTypeIndex] RETURNS [l: Node] = {
oper: IntCodeDefs.Oper;
IF cachedArithOper = NIL THEN cachedArithOper _ z.NEW[CachedArithOperRep] -- all NIL from allocator
ELSE IF (l _ cachedArithOper[ati][op]) # NIL THEN RETURN;
oper _ z.NEW[OperRep.arith _ [arith[class: arithClassValue[ati], select: op]]];
l _ z.NEW[NodeRep.oper _ [details: oper[oper]]];
cachedArithOper[ati][op] _ l;
};


ArithOpForTree: PUBLIC PROC [node: Tree.Index, op: ArithSelector] RETURNS [l: Node] = {
ati: ArithTypeIndex = ArithTypeForTree[node];
RETURN[ArithOp[op, ati]];
};


Bits: PUBLIC PROC [ba: BitAddress] RETURNS [INT] = {
RETURN[LONG[LOOPHOLE[ba, CARDINAL]]]};

BitsForOperand: PUBLIC PROC [t: Tree.Link] RETURNS [CARDINAL] =
BEGIN
RETURN [WITH t SELECT FROM
literal => WordLength,	-- not always TRUE, but good enough
ENDCASE => BitsForType[OperandType[t]]]
END;

BitsForType: PUBLIC PROC [sei: SEIndex] RETURNS [CARDINAL] =
BEGIN
csei: CSEIndex = UnderType[sei];
RETURN [WITH seb[csei] SELECT FROM
record => length,
ENDCASE => CARDINAL[WordsForType[csei]]*WordLength]
END;

boundCheckOp: Node _ NIL;	-- *** reset if z goes away
BoundsCheck: PUBLIC PROC [exp, bound: Node] RETURNS [Node] = {
IF boundCheckOp = NIL THEN { 
bo: Oper _ z.NEW[OperRep.check _ [check[class: [unsigned, WordSize], sense: lt]]];
boundCheckOp _ z.NEW[NodeRep.oper _ [details: oper[bo]]]};
RETURN[ApplyOp[boundCheckOp, MakeNodeList2[exp, bound], exp.bits]];
};

CachedCedarOperRep: TYPE = ARRAY CedarSelector OF Node;
cachedCedarOper: REF CachedCedarOperRep _ NIL; -- *** reset if z goes away
CedarOpNode: PUBLIC PROC [op: CedarSelector] RETURNS [l: Node] = {
oper: IntCodeDefs.Oper;
IF cachedCedarOper = NIL THEN cachedCedarOper _ z.NEW[CachedCedarOperRep] -- all NIL from allocator
ELSE IF (l _ cachedCedarOper[op]) # NIL THEN RETURN [l];
oper _ z.NEW[OperRep.cedar _ [cedar[cedar: op, info: 0]]];
l _ z.NEW[NodeRep.oper _ [details: oper[oper]]];
cachedCedarOper[op] _ l;
};


CgenUtilInit: PUBLIC PROC [ownTable: Alloc.Handle] =
BEGIN
table _ ownTable;
CPtr.tempcontext _ SymbolOps.NewCtx[Symbols.lZ];
CPtr.fileLoc _ SourceMap.Cons[0];
generatedLabel _ CARDINAL.LAST.LONG + 2;
cachedArithOper _ NIL;
boundCheckOp _ NIL;
cachedCedarOper _ NIL;
cachedConvertOper _ NIL;
generatedVar _ CARDINAL.LAST.LONG + 2;
cachedCodeList _ ALL[NIL];
cachedMesaOper _ NIL;
sExtendOp _ ALL[NIL];
zExtendOp _ ALL[NIL];
END;

CJump: PUBLIC PROC [cl: CodeList, test: Comparator, op1, op2: Node, ati: ArithTypeIndex, target: Label] = {
cn: Node = CompareOp[test, ati];
comp: Node = ApplyOp[oper: cn, args: MakeNodeList2[op1, op2], bits: 1];
goto: Node = z.NEW[NodeRep.goto _ [details: goto[target]]];
case: CaseList _ MakeCaseList[MakeNodeList[comp], goto];
cond: Node = z.NEW[NodeRep.cond _ [details: cond[case]]];
MoreCode[cl, cond]};

CachedCompareOperRep: TYPE = ARRAY ArithTypeIndex OF ARRAY Comparator OF Node;
cachedCompareOper: REF CachedCompareOperRep _ NIL; -- *** reset if z goes away

CompareOp: PUBLIC PROC [sense: Comparator, ati: ArithTypeIndex] RETURNS [l: Node] = {
oper: IntCodeDefs.Oper;
IF cachedCompareOper = NIL THEN cachedCompareOper _ z.NEW[CachedCompareOperRep] -- all NIL from allocator
ELSE IF (l _ cachedCompareOper[ati][sense]) # NIL THEN RETURN;
oper _ z.NEW[OperRep.compare _ [compare [class: arithClassValue[ati], sense: sense]]];
l _ z.NEW[NodeRep.oper _ [details: oper[oper]]];
cachedCompareOper[ati][sense] _ l;
};

CompareOpForTree: PUBLIC PROC [node: Tree.Index, sense: Comparator] RETURNS [l: Node] = {
ati: ArithTypeIndex = ArithTypeForTree[node];
RETURN[CompareOp[sense, ati]];
};

CachedConvertOperRep: TYPE = ARRAY ArithTypeIndex OF ARRAY ArithTypeIndex OF Node;
cachedConvertOper: REF CachedConvertOperRep _ NIL; -- *** reset if z goes away

ConvertOpNode: PUBLIC PROC [from, to: ArithTypeIndex] RETURNS [l: Node] = {
oper: IntCodeDefs.Oper;
IF cachedConvertOper = NIL THEN cachedConvertOper _ z.NEW[CachedConvertOperRep] -- all NIL from allocator
ELSE IF (l _ cachedConvertOper[from][to]) # NIL THEN RETURN [l];
oper _ z.NEW[OperRep.convert _ [convert[from: arithClassValue[from], to: arithClassValue[to]]]];
l _ z.NEW[NodeRep.oper _ [details: oper[oper]]];
cachedConvertOper[from][to] _ l;
};


CreateTemp: PUBLIC PROC [bits: BitCount, type: SEIndex _ typeANY] RETURNS [var: Var,  sei: ISEIndex] = {
vbits: CARDINAL _ bits;	-- fix if idInfo gets bigger
sei _ SymbolOps.MakeCtxSe[Symbols.HTNull, Symbols.CTXNull];
seb[sei].constant _ seb[sei].extended _ seb[sei].linkSpace _ FALSE;
seb[sei].immutable _ TRUE;
seb[sei].idCtx _ CPtr.tempcontext;
seb[sei].idInfo _ vbits;
seb[sei].idType _ type;
var _ P5.VarForSei[sei]};

Declare: PUBLIC PROC [cl: CodeList, var: Var, init: Node _ NIL] = {
dn: Node _ z.NEW[NodeRep.decl _ [details: decl[var: var, init: init]]];
MoreCode[cl, dn]};

Deref: PUBLIC PROC [n: Node, bits: BitCount] RETURNS [v: Var] =
BEGIN
l: Location;
l _ z.NEW[deref LocationRep _ [deref[addr: n]]];
v _ z.NEW[VarRep _ [bits: bits, details: var[location: l]]];
END;

DoAssign: PUBLIC PROC [cl: CodeList, lhs: Var, rhs: Node] = {
l: Node _ z.NEW[NodeRep.assign _ [details: assign[lhs: lhs, rhs: rhs]]];
MoreCode[cl, l];
};

EnumerateCaseArms: PUBLIC PROC [node: Tree.Index, action: PROC [t: Tree.Link]] =
BEGIN

ProcessItem: PROC [t: Tree.Link] =
BEGIN
inode: Tree.Index;
WITH t SELECT FROM
subtree => inode _ index;
ENDCASE;
SELECT tb[inode].name FROM
item, casetest => action[tb[inode].son[2]];
caseswitch => TreeOps.ScanList[tb[inode].son[3], ProcessItem];
ENDCASE;
END;

TreeOps.ScanList[tb[node].son[2], ProcessItem];
IF tb[node].son[3] # Tree.Null THEN action[tb[node].son[3]];
END;

ExtractList: PUBLIC PROC [cl: CodeList] RETURNS [nl: NodeList] = {
nl _ cl.head;
FreeCodeList[cl]};

generatedVar: LogicalId _ CARDINAL.LAST.LONG + 2;
FormalVar: PUBLIC PROC [bits: BitCount] RETURNS [v: Var] = {
v _ z.NEW[NodeRep.var _ [bits: bits, details: var[id: generatedVar]]];
generatedVar _ generatedVar + 1;
RETURN};

FreeChunk: PUBLIC PROC [i: CodeDefs.ChunkIndex, size: CARDINAL] =
BEGIN
table.FreeChunk[LOOPHOLE[i], size, codeType];
END;

cachedCodeListCount: CARDINAL = 4;
cachedCodeList: ARRAY [0..cachedCodeListCount) OF CodeList _ ALL[NIL];
FreeCodeList: PRIVATE PROC [cl: CodeList] = {
cl^ _ [NIL, NIL];
FOR i: CARDINAL IN [0..cachedCodeListCount) DO
IF cachedCodeList[i] = NIL THEN {cachedCodeList[i] _ cl; EXIT};
ENDLOOP;
};

FullWordBits: PUBLIC PROC [bits: BitCount] RETURNS [BitCount] =
BEGIN
RETURN [((bits+WordLength-1)/WordLength) * WordLength]
END;


GetChunk: PUBLIC PROC [size: CARDINAL] RETURNS [c: CodeDefs.ChunkIndex] =
BEGIN
c _ LOOPHOLE[table.GetChunk[size, codeType]];
END;

InsertLabel: PUBLIC PROC [cl: CodeList, lbl: Label] = {
n: Node _ z.NEW [NodeRep.label _ [details: label[lbl]]];
MoreCode[cl, n]};

Jump: PUBLIC PROC [cl: CodeList, target: Label] = {
goto: Node = z.NEW[NodeRep.goto _ [details: goto[target]]];
MoreCode[cl, goto]};

MakeBlock: PUBLIC PROC [cl: CodeList, bits: BitCount] RETURNS [b: BlockNode] = {
b _ z.NEW [NodeRep.block _ [bits: bits, details: block[cl.head]]];
FreeCodeList[cl];
RETURN};


MakeCaseList: PUBLIC PROC [tests: NodeList, body: Node, rest: CaseList _ NIL] RETURNS [CaseList] = {
RETURN [z.NEW [CaseListRep _ [tests, body, rest]]]};

MakeLongTreeLiteral: PUBLIC PROC [d: DESCRIPTOR FOR ARRAY OF WORD, type: CSEIndex]
RETURNS [Tree.Link] =
BEGIN
TreeOps.PushTree[[literal[LiteralOps.FindDescriptor[d]]]];
TreeOps.PushNode[mwconst, 1];  TreeOps.SetInfo[type];
RETURN [TreeOps.PopTree[]]
END;

MakeNodeList: PUBLIC PROC [first: Node, last: NodeList _ NIL] RETURNS [NodeList] = {
RETURN [z.NEW [NodeListRep _ [first, last]]]};

MakeNodeList2: PUBLIC PROC [first, second: Node] RETURNS [NodeList] = {
RETURN [z.NEW [NodeListRep _ [first, z.NEW[NodeListRep _ [second, NIL]]]]]};

MakeNodeLiteral: PUBLIC PROC [val: INT] RETURNS [Node] =
BEGIN
RETURN [z.NEW[NodeRep.const _ [bits: WordSize, details: const[word[IntCodeUtils.IntToWord[val]]]]]]
END;

MakeTemp: PUBLIC PROC [cl: CodeList, bits: BitCount, init: Node _ NIL, type: SEIndex _ typeANY] RETURNS [var: Var,  sei: ISEIndex] = {
[var, sei] _ CreateTemp[bits, type];
Declare[cl: cl, var: var, init: init];
};


MakeTreeLiteral: PUBLIC PROC [val: WORD] RETURNS [Tree.Link] =
BEGIN
RETURN [[literal[LiteralOps.Find[val]]]]
END;

MakeVar: PUBLIC PROC [bits: BitCount, id: VariableId, loc: Location] RETURNS [var: Var] = {
RETURN[z.NEW[NodeRep.var _ [bits: bits, details: var[id: id, location: loc]]]]};

MakeVarList: PUBLIC PROC [first: Var, last: VarList _ NIL] RETURNS [VarList] = {
RETURN [z.NEW [VarListRep _ [first, last]]]};

MakeVarList2: PUBLIC PROC [first, second: Var] RETURNS [VarList] = {
RETURN [z.NEW [VarListRep _ [first, z.NEW[VarListRep _ [second, NIL]]]]]};

MarkedType: PUBLIC PROC [type: SEIndex] RETURNS [CSEIndex] =
BEGIN
subType: CSEIndex = NormalType[UnderType[type]];
RETURN [WITH t: seb[subType] SELECT FROM
ref => UnderType[TypeRoot[t.refType]],
transfer => subType,
ENDCASE => Symbols.typeANY]
END;

MaybeBlock: PUBLIC PROC [cl: CodeList, l: Node] RETURNS [b: Node] = {
IF cl.head = NIL THEN b _ l
ELSE {cl.tail.rest _ MakeNodeList[l]; b _ MakeBlock[cl, l.bits]};
FreeCodeList[cl];
RETURN};


CachedMesaOperRep: TYPE = ARRAY MesaSelector OF Node;
cachedMesaOper: REF CachedMesaOperRep _ NIL; -- *** reset if z goes away
MesaOpNode: PUBLIC PROC [op: MesaSelector] RETURNS [l: Node] = {
oper: IntCodeDefs.Oper;
IF cachedMesaOper = NIL THEN cachedMesaOper _ z.NEW[CachedMesaOperRep] -- all NIL from allocator
ELSE IF (l _ cachedMesaOper[op]) # NIL THEN RETURN [l];
oper _ z.NEW[OperRep.mesa _ [mesa[mesa: op, info: 0]]];
l _ z.NEW[NodeRep.oper _ [details: oper[oper]]];
cachedMesaOper[op] _ l;
};


MoreCode: PUBLIC PROC [cl: CodeList, n: Node] = {
nl: NodeList _ MakeNodeList[n];
IF cl.tail = NIL THEN cl.head _ nl ELSE cl.tail.rest _ nl;
cl.tail _ nl};

NewCodeList: PUBLIC PROC RETURNS [cl: CodeList] = {
FOR i: CARDINAL IN [0..cachedCodeListCount) DO
IF cachedCodeList[i] # NIL THEN {cl _ cachedCodeList[i]; cachedCodeList[i] _ NIL; EXIT};
REPEAT
FINISHED => cl _ z.NEW[CodeListRep _ [NIL, NIL]];
ENDLOOP};

NextVar: PUBLIC PROC [sei: ISEIndex] RETURNS [ISEIndex] =
BEGIN -- starting at sei returns first variable on ctx-list
RETURN [SELECT TRUE FROM
(sei = ISENull) => ISENull,
(seb[sei].idType # Symbols.typeTYPE) AND ~seb[sei].constant => sei, -- I bet types are already constant
ENDCASE => NextVar[NextSe[sei]]]
END;

NilTree: PUBLIC PROC [type: CSEIndex] RETURNS [Tree.Link] =
BEGIN
SELECT SymbolOps.WordsForType[type] FROM
1 => RETURN[MakeTreeLiteral[0]];
2 =>
BEGIN
zeros: ARRAY [0..2) OF WORD _ [0, 0];
RETURN[MakeLongTreeLiteral[DESCRIPTOR[zeros], type]];
END;
ENDCASE => ERROR;
END;

OperandType: PUBLIC PROC [t: Tree.Link] RETURNS [sei: CSEIndex] =
BEGIN -- compute type of tree
RETURN [WITH e:t SELECT FROM
symbol => UnderType[seb[e.index].idType],
literal => IF e.index.litTag = string THEN MPtr.typeSTRING ELSE ERROR,
subtree =>
IF e = Tree.Null THEN
IF CPtr.xtracting THEN UnderType[seb[CPtr.xtractsei].idType] ELSE ERROR
ELSE UnderType[tb[e.index].info],
ENDCASE => ERROR]
END;

PrevVar: PUBLIC PROC [ssei, sei : ISEIndex] RETURNS [ISEIndex] =
BEGIN -- returns vars in reverse order as those returned by  NextVar
psei: ISEIndex _ NextVar[ssei];
rsei: ISEIndex;
IF psei = sei THEN RETURN [psei];
UNTIL psei = sei DO rsei _ psei; psei _ NextVar[NextSe[psei]] ENDLOOP;
RETURN [rsei];
END;

ProcessSafens: PUBLIC PROC [cl: CodeList, t: Tree.Link, ignore: BOOL _ FALSE] RETURNS [nt: Tree.Link] = {
FindSafens: Tree.Map = {
v _ t; -- normal case
IF t # Tree.Null THEN WITH t SELECT FROM
subtree =>
BEGIN
node: Tree.Index = index;
SELECT tb[node].name FROM
rowcons, construct =>
tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], FindSafens];
all =>
BEGIN
tb[node].son[1] _ FindSafens[tb[node].son[1]];
END;
union =>
BEGIN
tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], FindSafens];
END;
cast, pad =>
tb[node].son[1] _ FindSafens[tb[node].son[1]];
safen => 
IF ignore THEN v _ FindSafens[tb[node].son[1]]	
ELSE
BEGIN
sei: ISEIndex;
val: Node = P5.Exp[tb[node].son[1]];
sei _ MakeTemp[cl: cl, bits: val.bits, type: tb[node].info, init: val].sei;
v _ [symbol[sei]];
END;
ENDCASE;
END;
ENDCASE;
RETURN};
nt _ TreeOps.UpdateList[t, FindSafens]};

ReferentType: PUBLIC PROC [type: SEIndex] RETURNS [SEIndex] =
BEGIN
subType: CSEIndex = NormalType[UnderType[type]];
RETURN [WITH t: seb[subType] SELECT FROM
ref => t.refType,
ENDCASE => Symbols.typeANY]
END;

sExtendOp: ARRAY [0..WordSize) OF OperNode _ ALL[NIL]; -- clear if z goes away
SignExtend: PUBLIC PROC [n: Node, to: BitCount _ WordSize] RETURNS [Node] = {
cvt: OperNode;
ext: OperNode _ NIL;
IF n.bits >= to THEN RETURN[n];
IF to = WordSize THEN ext _ sExtendOp[n.bits];
IF ext # NIL THEN cvt _ ext
ELSE cvt _ z.NEW[NodeRep.oper _ [bits: to, details: oper[z.NEW[OperRep.convert _ [convert[from: [kind: signed, precision: n.bits], to: [kind: signed, precision: to]]]]]]];
IF to = WordSize AND ext = NIL THEN sExtendOp[n.bits] _ ext;
RETURN[ApplyOp[oper: cvt, args: MakeNodeList[n], bits: to]]};

TakeField: PUBLIC PROC [n: Node, vl: VLoc] RETURNS [nv: Var] =
BEGIN
l: Location;
BEGIN
WITH n SELECT FROM
v: Var => WITH ll: v.location SELECT FROM
field => {l _ z.NEW[field LocationRep _ [field[start: ll.start + vl.disp, base: ll.base]]]};
ENDCASE => GO TO notAField;
ENDCASE => GO TO notAField;
EXITS
notAField => l _ z.NEW[field LocationRep _ [field[start: vl.disp, base: n]]];
END;
RETURN[z.NEW[VarRep _ [bits: vl.size, details: var[location: l]] ]];
END;

TakeVField: PUBLIC PROC [vl: VLoc, disp: INT, size: BitCount] RETURNS [VLoc] = {
vl.disp _ vl.disp + disp;
vl.size _ size;
RETURN[vl]};

TreeLiteral: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] =
BEGIN
RETURN [WITH t SELECT FROM
literal => index.litTag = word,
subtree =>
SELECT tb[index].name FROM
cast => TreeLiteral[tb[index].son[1]],
mwconst => TRUE,
ENDCASE => FALSE,
ENDCASE => FALSE]
END;

TreeLiteralValue: PUBLIC PROC [t: Tree.Link] RETURNS [WORD] =
BEGIN
RETURN [WITH e:t SELECT FROM
literal =>
WITH e.index SELECT FROM
word => LiteralOps.Value[lti],
ENDCASE => ERROR,
subtree =>
SELECT tb[e.index].name FROM
cast, mwconst =>  TreeLiteralValue[tb[e.index].son[1]],
ENDCASE => ERROR,
ENDCASE => ERROR]
END;

TypeForTree: PUBLIC PROC [t: Tree.Link] RETURNS [SEIndex] =
BEGIN
RETURN [WITH t SELECT FROM
subtree => tb[index].info,
symbol => index,
ENDCASE => ERROR]
END;

VariantTag: PUBLIC PROC [type: SEIndex, ctx: Symbols.CTXIndex] RETURNS [WORD] =
BEGIN
next: SEIndex;
FOR sei: SEIndex _ type, next UNTIL sei = SENull DO
WITH se: seb[sei] SELECT FROM
id =>
BEGIN
IF se.idCtx = ctx THEN RETURN [se.idValue];
next _ se.idInfo;
END;
ENDCASE => EXIT;
ENDLOOP;
ERROR
END;

WordAligned: PUBLIC PROC [tsei: RecordSEIndex] RETURNS [BOOL] =
BEGIN -- sees if a word-aligned record (never TRUE for a variant record)
sei: ISEIndex;
wa: INTEGER _ 0;
a: BitAddress;
tsei _ RecordRoot[tsei];
IF seb[tsei].hints.variant THEN RETURN [FALSE];
IF seb[tsei].argument THEN RETURN [TRUE];
sei _ NextVar[FirstCtxSe[seb[tsei].fieldCtx]];
UNTIL sei = ISENull DO
a _ seb[sei].idValue;
IF a.bd # 0 THEN RETURN [FALSE];
IF a.wd < wa THEN RETURN [FALSE];
wa _ a.wd;
sei _ NextVar[NextSe[sei]];
ENDLOOP;
RETURN [TRUE]
END;

WordsForBits: PUBLIC PROC [b: INT] RETURNS [INT] = {
RETURN [(b+WordSize-1)/WordSize]};

WordsForOperand: PUBLIC PROC [t: Tree.Link] RETURNS [OpWordCount] =
BEGIN -- compute number of words for storing value of tree
RETURN [WITH t SELECT FROM
literal => 1, -- multiwords will be subtrees
symbol => WordsForSei[seb[index].idType],
ENDCASE => OpWordCount[WordsForType[OperandType[t]]]]
END;

WordsForSei: PUBLIC PROC [sei: SEIndex] RETURNS [OpWordCount] =
BEGIN
RETURN [IF sei # SENull THEN OpWordCount[WordsForType[UnderType[sei]]] ELSE 0]
END;

WordsForString: PUBLIC PROC [nChars: CARDINAL] RETURNS [CARDINAL] =
BEGIN  -- computed for the object machine
RETURN [(nChars+1)/2 + 2]
END;

zExtendOp: ARRAY [0..WordSize) OF OperNode _ ALL[NIL]; -- clear if z goes away
ZeroExtend: PUBLIC PROC [n: Node, to: BitCount _ WordSize] RETURNS [Node] = {
cvt: OperNode;
ext: OperNode _ NIL;
IF n.bits >= to THEN RETURN[n];
IF to = WordSize THEN ext _ zExtendOp[n.bits];
IF ext # NIL THEN cvt _ ext
ELSE cvt _ z.NEW[NodeRep.oper _ [bits: to, details: oper[z.NEW[OperRep.convert _ [convert[from: [kind: unsigned, precision: n.bits], to: [kind: unsigned, precision: to]]]]]]];
IF to = WordSize AND ext = NIL THEN zExtendOp[n.bits] _ ext;
RETURN[ApplyOp[oper: cvt, args: MakeNodeList[n], bits: to]]};

END.

"CgenUtil.mesa, 
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, June 2, 1986 1:15:28 am PDT
Satterthwaite, November 14, 1985 12:13:41 pm PST
Maxwell, August 2, 1983 3:15 pm
Russ Atkinson (RRA) March 7, 1985 1:49:01 am PST
imported definitions
CPtr.ZEROlexeme _ Lexeme[literal[word[LiteralOps.Find[0].lti]]];
otherwise drop on floor for REF case
TreeOps.FreeNode[node];
PushLitVal: PUBLIC PROC [v: UNSPECIFIED] =
BEGIN -- forces a constant onto the stack
Out1[FOpCodes.qLI, v];
END;


always true for an argument record
Κ|˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ"™"Kš
œ0™0K™K™0—K˜š
Οk	˜	Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ˜Kš
œ	˜	K˜K˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ
˜
Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—šœ
ž˜Kšžœi˜pKšžœžœ"˜:Kš
œ™K˜Kšœžœ˜&Kšœ
žœ˜"Kšœ
žœ˜"K˜$Kšœžœ˜,Kšœ	žœ˜ K˜!Kšœžœ˜*Kšœ
žœžœΟc!˜7Kš
œ$˜$K˜Kšœžœ
˜K˜KšœŸ˜)KšœŸ#˜7KšœŸ˜-KšœŸ#˜6K˜šœžœ˜'KšžœŸ6˜=K˜K˜K˜K˜&Kšžœ
˜K˜Kšœžœ
žœ
žœ˜3—šΟn	œžœ
žœRžœ	˜xKš
ž˜Kš
œ$˜$Kšœžœ˜&Kš
œ˜šžœžœžœ˜<Kšžœžœ˜'Kšžœ˜ —Kšžœ˜
Kšžœ
˜K˜—š 
œžœ
žœžœ˜?Kšžœžœ<˜JKšžœžœžœ˜1K˜—š œžœ
žœ.žœ˜\KšœžœH˜QK˜Kšœžœžœžœ
žœžœ˜OKšœžœžœŸ˜JK˜šœžœžœ˜7Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜——K˜š œžœžœ˜Ršžœ
˜Kšžœžœ
˜ šžœ
žœžœ
˜Kšžœžœžœ
˜3Kšžœ
žœžœžœ˜=——K˜K˜K˜—š œžœ*žœ˜SK˜Kš	žœžœ
žœžœŸ˜cKš
žœ
žœ"žœ
žœ
žœ
˜9Kšœ	žœC˜OKšœžœ'˜0Kš
œ˜K˜K˜K˜—š œžœ'žœ˜WKš
œ-˜-Kšžœ˜K˜K˜K˜—š œžœžœžœ˜4Kšžœ
žœ
žœžœ˜&K˜—š
 œžœ
žœžœžœ˜?Kš
ž˜šžœžœžœ
ž˜KšœŸ#˜:Kšžœ ˜'—Kšžœ
˜K˜—š
 œžœ
žœžœžœ˜<Kš
ž˜K˜ šžœžœžœ
ž˜"K˜Kšžœžœ ˜3—Kšžœ
˜K˜KšœžœŸ˜5—š œžœ
žœžœ˜>šžœžœ
žœ˜Kšœ
žœB˜RKšœžœ&˜:—Kšžœ=˜CK˜K˜Kšœžœžœžœ˜7KšœžœžœŸ˜J—š œžœžœ˜BK˜Kš	žœžœ
žœžœŸ˜cKš
žœ
žœžœ
žœ
žœ˜8Kšœ	žœ.˜:Kšœžœ'˜0Kš
œ˜K˜K˜K˜—š œžœ
žœ˜4Kš
ž˜K˜K™@K˜0K˜!Kšœžœ
žœ
žœ˜(Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
žœ
žœ˜&Kšœžœ
žœ˜Kšœžœ
˜Kšœžœ
žœ˜Kšœžœ
žœ˜Kšžœ
˜K˜—š œžœ
žœY˜kK˜ K˜GKšœžœ)˜;K˜8Kšœžœ'˜9K˜K˜Kšœžœžœžœ
žœžœ˜NKšœžœžœŸ˜NK˜—š 	œžœ
žœ*žœ˜UK˜Kš	žœžœ
žœžœŸ˜iKš
žœ
žœ'žœ
žœ
žœ
˜>Kšœ	žœJ˜VKšœžœ'˜0Kš
œ"˜"K˜K˜—š œžœ
žœ'žœ˜YKš
œ-˜-Kšžœ˜K˜K˜Kšœžœžœžœ
žœžœ˜RKšœžœžœŸ˜NK˜—š 
œžœžœ˜KK˜Kš	žœžœ
žœžœŸ˜iKš
žœ
žœ%žœ
žœ
žœ˜@Kšœ	žœT˜`Kšœžœ'˜0Kš
œ ˜ K˜K˜K˜—š 
œžœ
žœ+žœ˜hKšœžœ	Ÿ˜4K˜;Kšœ=žœ
˜CKšœžœ
˜K˜"Kš
œ˜Kš
œ˜Kš
œ˜K˜—š œžœ
žœ'žœ˜CKšœ
žœ7˜GK˜K˜—š œžœ
žœžœ˜?Kš
ž˜K˜Kšœžœ'˜0Kšœžœ3˜<Kšžœ
˜K˜—š œžœ
žœ(˜=Kšœžœ9˜HK˜K˜K˜—š œžœ
žœžœ˜PKš
ž˜K˜š œžœ˜"Kš
ž˜K˜šžœžœ
ž˜K˜Kšžœ
˜—šžœž˜K˜+K˜>Kšžœ
˜—Kšžœ
˜K˜—K˜/Kšžœžœ˜<Kšžœ
˜K˜—š œžœžœ˜BK˜
K˜K˜Kšœžœ
žœ
žœ˜1—š 	œžœ
žœžœ
˜<Kšœžœ=˜FK˜ Kšžœ˜K˜—š 	œžœ
žœ žœ˜AKš
ž˜Kšœžœ˜-Kšžœ
˜—˜Kšœžœ˜"Kš	œžœžœžœ
žœ˜F—š œžœ
žœ˜-Kšœžœžœ˜šžœžœ
žœž˜.Kšžœžœ
žœžœ˜?Kšžœ
˜—Kš
œ$™$K˜K˜—š œžœ
žœžœ
˜?Kš
ž˜Kšžœ0˜6Kšžœ
˜K˜—K˜š
 œžœ
žœžœžœ˜IKš
ž˜Kšœžœ!˜-Kšžœ
˜K˜—š œžœ
žœ˜7Kšœžœ)˜8K˜K˜—š œžœ
žœ"˜3Kšœžœ)˜;Kš
œ˜K˜—š 	œžœ
žœ žœ˜PKšœžœ9˜BK˜Kšžœ˜K˜K˜—š
 œžœ
žœ0žœžœ˜dKšžœžœ'˜4K˜—š œžœ
žœž
œ
žœ
žœ
žœ
žœ˜RKšžœ˜Kš
ž˜K˜:K˜5Kšžœ˜Kšžœ
˜K˜—š
 œžœ
žœ žœžœ˜TKšžœžœ!˜.K˜—š 
œžœ
žœžœ˜GKšžœžœžœžœ˜LK˜—š
 œžœ
žœžœžœ	˜8Kš
ž˜KšžœžœV˜cKšžœ
˜K˜—š
 œžœ
žœ-žœžœ˜†
K˜$K˜&K˜K˜K˜—š
 œžœ
žœžœžœ˜>Kš
ž˜Kšžœ"˜(Kšžœ
˜K˜—š œžœ
žœ1žœ˜[KšžœJ˜PK˜—š
 œžœ
žœžœžœ˜PKšžœžœ ˜-K˜—š œžœ
žœžœ˜DKšžœžœžœžœ˜JK˜—š 
œžœ
žœžœ
˜<Kš
ž˜K˜0šžœžœžœ
ž˜(K˜&K˜Kšžœ˜—Kšžœ
˜K˜—š 
œžœ
žœžœ˜EKšžœžœ
žœ˜Kšžœ=˜AK˜Kšžœ˜K˜K˜Kšœžœžœžœ˜5KšœžœžœŸ˜H—š 
œžœžœ˜@K˜Kš	žœžœ
žœžœŸ˜`Kš
žœ
žœžœ
žœ
žœ˜7Kšœ	žœ+˜7Kšœžœ'˜0Kš
œ˜K˜K˜K˜—š œžœ˜1K˜Kšžœžœ
žœžœ˜:K˜K˜—š œžœ
žœ˜3šžœžœ
žœž˜.Kš
žœžœ
žœ.žœžœ˜Xš
ž˜Kšžœžœžœžœ˜1—Kšžœ˜	—K˜—š œžœ
žœžœ
˜9Kšžœ
Ÿ5˜;šžœžœ
žœ
ž˜K˜Kšœ%žœŸ#˜gKšžœ˜ —Kšžœ
˜K˜—š œžœ
žœžœ˜;Kš
ž˜šžœž˜(Kšœžœ˜ ˜Kš
ž˜Kšœžœžœ
žœ
˜%Kšžœž
œ˜5Kšžœ
˜—Kšžœžœ
˜—Kšžœ
˜K˜—š œžœ
žœžœ˜AKšžœ
Ÿ˜šžœžœžœ
ž˜K˜)Kš	œžœžœžœ
žœ
˜F˜
šžœž˜Kšžœžœ'žœ
ž˜G—Kšžœ˜!—Kšžœžœ
˜—Kšžœ
˜K˜—š œžœ
žœžœ
˜@Kšžœ
Ÿ>˜DK˜K˜Kšžœžœ
žœ˜!Kšžœžœ+žœ
˜FKšžœ˜Kšžœ
˜K˜—š 
œžœ
žœ&žœžœžœ˜i˜KšœŸ˜š	žœžœ
žœžœ
ž˜(˜
Kš
ž˜K˜šžœž˜˜Kš
œB˜B—˜Kš
ž˜Kš
œ.˜.Kšžœ
˜—˜Kš
ž˜Kš
œB˜BKšžœ
˜—˜Kš
œ.˜.—˜	Kšžœžœ!˜/š
ž˜Kš
ž˜K˜K˜$Kš
œK˜KK˜Kš
œ™Kšžœ
˜——Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—K˜(K˜—š 
œžœ
žœžœ™*Kšžœ
Ÿ#™)K™Kšžœ
™K™K™—š œžœ
žœžœ˜=Kš
ž˜K˜0šžœžœžœ
ž˜(K˜Kšžœ˜—Kšžœ
˜K˜Kš
œžœžœžœ
žœŸ˜N—š 
œžœ
žœ$žœ˜MKš
œ˜Kšœžœ
˜Kšžœžœ
žœ˜Kšžœžœ˜.Kšžœžœ
žœ
˜Kšžœ	žœ+žœm˜«
Kšžœžœžœ
žœ˜<Kšžœ7˜=K˜—š 	œžœ
žœžœ˜>Kš
ž˜K˜Kš
ž˜šžœžœ
ž˜šœ
žœžœ
ž˜)KšœžœI˜\Kšžœžœ
žœ˜—Kšžœžœ
žœ˜—š
ž˜Kšœžœ7˜M—Kšžœ
˜Kšžœžœ8˜DKšžœ
˜K˜—š
 
œžœ
žœžœžœ˜PK˜K˜Kšžœ˜K˜—š
 œžœ
žœžœžœ˜8Kš
ž˜šžœžœžœ
ž˜K˜˜
šžœž˜K˜&Kšœžœ
˜Kšžœžœ
˜——Kšžœžœ
˜—Kšžœ
˜K˜—š
 œžœ
žœžœžœ˜=Kš
ž˜šžœžœžœ
ž˜˜
šžœ	žœ
ž˜K˜Kšžœžœ
˜——˜
šžœž˜K˜7Kšžœžœ
˜——Kšžœžœ
˜—Kšžœ
˜K˜—š œžœ
žœžœ˜;Kš
ž˜šžœžœžœ
ž˜K˜K˜Kšžœžœ
˜—Kšžœ
˜K˜—š
 
œžœ
žœ(žœžœ˜OKš
ž˜K˜šžœžœž˜3šžœžœ
ž˜˜Kš
ž˜Kšžœžœ
žœ˜+K˜Kšžœ
˜—Kšžœžœ
˜—Kšžœ
˜—Kš
ž˜Kšžœ
˜K˜—š
 œžœ
žœžœžœ˜?šžœ
ŸB˜HKš
œ"™"—K˜Kšœžœ˜K˜K˜Kšžœžœ
žœžœ˜/Kšžœžœ
žœžœ˜)K˜.šžœž˜K˜Kšžœ
žœ
žœžœ˜ Kšžœžœ
žœžœ˜!K˜
K˜Kšžœ
˜—Kšžœžœ
˜
Kšžœ
˜K˜—š œžœ
žœžœžœžœ˜4Kšžœ˜"K˜—š œžœ
žœžœ˜CKšžœ
Ÿ4˜:šžœžœžœ
ž˜KšœŸ˜,K˜)Kšžœ.˜5—Kšžœ
˜K˜—š œžœ
žœžœ˜?Kš
ž˜Kšžœžœžœ+žœ˜NKšžœ
˜K˜—š œžœ
žœ
žœžœžœ˜CKšžœŸ"˜)Kšžœ˜Kšžœ
˜K˜Kš
œžœžœžœ
žœŸ˜N—š 
œžœ
žœ$žœ˜MKš
œ˜Kšœžœ
˜Kšžœžœ
žœ˜Kšžœžœ˜.Kšžœžœ
žœ
˜Kšžœ	žœ+žœq˜―
Kšžœžœžœ
žœ˜<Kšžœ7˜=K˜—Kšžœ
˜K˜——…—JΞel