CgenUtil:
PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, Alloc, CodeDefs, IntCodeUtils, LiteralOps, P5, SourceMap, SymbolOps, TreeOps
EXPORTS P5U = BEGIN OPEN IntCodeDefs, SymbolOps, CodeDefs;
imported definitions
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.ZEROlexeme ← Lexeme[literal[word[LiteralOps.Find[0].lti]]];
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;
otherwise drop on floor for REF case
};
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]];
TreeOps.FreeNode[node];
END;
ENDCASE;
END;
ENDCASE;
RETURN};
nt ← TreeOps.UpdateList[t, FindSafens]};
PushLitVal: PUBLIC PROC [v: UNSPECIFIED] =
BEGIN -- forces a constant onto the stack
Out1[FOpCodes.qLI, v];
END;
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)
always true for an argument 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.