-- file Pass4Xa.mesa
-- last written by Satterthwaite, May 21, 1982 1:54 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [ownSymbols, switches, typeINT, typeCARDINAL, typeCHAR, zone],
Environment: TYPE USING [bitsPerByte, bitsPerWord, maxCARDINAL, maxINTEGER],
Heap: TYPE USING [FreeNode, MakeNode],
Inline: TYPE USING [BITAND, BITOR, BITSHIFT],
Literals: TYPE USING [Base, LitDescriptor, ltType],
LiteralOps: TYPE USING [ValueDescriptor, FindDescriptor, MasterString],
Log: TYPE USING [Error, ErrorN, ErrorTree],
P4: TYPE USING [
Covering, Repr, none, signed, unsigned, both, other, RegCount, MaxRegs,
checked,
AdjustBias, BiasForType, BitsForType, CatchNest, ComputeIndexRegs,
Exp, ForceType, MakeStructuredLiteral, MakeTreeLiteral, OperandType,
RegsForType, RepForType, RValue, StructuredLiteral, TreeLiteral,
TreeLiteralDesc, TreeLiteralValue, TypeExp, TypeForTree,
VBias, VPop, VPush, VRegs, VRep, WordsForType, ZeroP],
Pass4: TYPE USING [implicitBias, implicitRep, implicitType],
Symbols: TYPE USING [
Base, BitAddress, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
ISENull, RecordSENull, typeANY, ctxType, seType],
SymbolOps: TYPE USING [
ArgRecord, BitsPerElement, Cardinality, FirstVisibleSe, FnField, NextSe,
RecordRoot, UnderType, VariantField],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType],
TreeOps: TYPE USING [
FreeNode, FreeTree, GetNode, ListLength, NthSon, OpName, PopTree, PushTree,
PushLit, PushNode, ScanList, SetAttr, SetInfo, UpdateList],
Types: TYPE USING [Assignable];
Pass4Xa: PROGRAM
IMPORTS
Heap, Inline, Log, LiteralOps, P4, SymbolOps, TreeOps, Types,
dataPtr: ComData, passPtr: Pass4
EXPORTS P4 = {
OPEN SymbolOps, TreeOps, P4;
-- pervasive definitions from Symbols
SEIndex: TYPE = Symbols.SEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
BitAddress: TYPE = Symbols.BitAddress;
tb: Tree.Base; -- tree base address (local copy)
ltb: Literals.Base; -- literal base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ctxb: Symbols.Base; -- context table base address (local copy)
ExpANotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
tb ← base[Tree.treeType]; ltb ← base[Literals.ltType];
seb ← base[Symbols.seType]; ctxb ← base[Symbols.ctxType]};
-- expression list manipulation
MakeRecord: PROC [record: RecordSEIndex, expList: Tree.Link]
RETURNS [val: Tree.Link, nRegs: RegCount] = {
sei: ISEIndex;
const: BOOLEAN;
subNode: Tree.Index;
EvaluateField: Tree.Map = {
type: CSEIndex = UnderType[seb[sei].idType];
IF t = Tree.Null THEN {
v ← Tree.Null;
IF BitsForType[type] # 0 OR VariantType[type] THEN const ← FALSE}
ELSE {
v ← WITH t SELECT FROM
subtree =>
SELECT tb[index].name FROM
construct => NestedConstruct[index, type],
union => Union[index, TRUE],
ENDCASE => Rhs[t, type],
ENDCASE => Rhs[t, type];
IF ~TreeLiteral[v] THEN
WITH v SELECT FROM
subtree =>
SELECT tb[index].name FROM
mwconst => NULL;
union => IF ~tb[index].attr1 THEN const ← FALSE;
ENDCASE => const ← FALSE;
ENDCASE => const ← FALSE;
nRegs ← MAX[VRegs[], nRegs]; VPop[]};
sei ← NextSe[sei];
RETURN};
sei ← FirstVisibleSe[seb[record].fieldCtx]; const ← TRUE; nRegs ← 0;
val ← UpdateList[expList, EvaluateField];
IF OpName[val] = list THEN {subNode ← GetNode[val]; tb[subNode].attr1 ← const};
RETURN};
VariantType: PROC [type: CSEIndex] RETURNS [BOOLEAN] = INLINE {
RETURN [SELECT seb[type].typeTag FROM
union, sequence => TRUE,
ENDCASE => FALSE]};
NestedConstruct: PROC [node: Tree.Index, lType: CSEIndex] RETURNS [val: Tree.Link] = {
rType: CSEIndex = tb[node].info;
val ← Construct[node, TRUE];
IF WordsForType[lType] > WordsForType[rType] THEN val ← PadRecord[val, lType];
RETURN};
MakeArgRecord: PUBLIC PROC [record: RecordSEIndex, expList: Tree.Link]
RETURNS [val: Tree.Link] = {
SELECT TRUE FROM
(expList = Tree.Null) => val ← Tree.Null;
(record = Symbols.RecordSENull) => val ← FreeTree[expList];
(OpName[expList] = list) => val ← MakeRecord[record, expList].val;
ENDCASE => {
type: CSEIndex = UnderType[seb[FirstVisibleSe[seb[record].fieldCtx]].idType];
val ← Rhs[expList, type]; VPop[]};
RETURN};
-- construction of packed values (machine dependent)
WordLength: CARDINAL = Environment.bitsPerWord;
ByteLength: CARDINAL = Environment.bitsPerByte;
FillMultiWord: PUBLIC PROC [
words: LiteralOps.ValueDescriptor, origin: CARDINAL, t: Tree.Link] = {
desc: Literals.LitDescriptor = TreeLiteralDesc[t];
IF origin + desc.length <= LENGTH[words] THEN
FOR i: CARDINAL IN [0 .. desc.length) DO words[origin+i] ← ltb[desc.offset][i] ENDLOOP};
PackRecord: PROC [record: RecordSEIndex, expList: Tree.Link] RETURNS [Tree.Link] = {
n: CARDINAL = WordsForType[record];
root, type: RecordSEIndex;
list: Tree.Link;
sei: ISEIndex;
offset: CARDINAL;
words: LiteralOps.ValueDescriptor;
more: BOOLEAN;
StoreBits: PROC [sei: ISEIndex, value: WORD] = {
OPEN Inline;
Masks: ARRAY [0..WordLength] OF WORD =
[0b, 1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b,
1777b, 3777b, 7777b, 17777b, 37777b, 77777b, 177777b];
address: BitAddress;
size, w, shift: CARDINAL;
IF seb[root].argument THEN [address, size] ← FnField[sei]
ELSE {address ← seb[sei].idValue; size ← seb[sei].idInfo};
w ← address.wd;
shift ← (WordLength-offset) - (address.bd+size);
words[w] ← BITOR[words[w], BITSHIFT[BITAND[value, Masks[size]], shift]]};
PackField: Tree.Scan = {
node: Tree.Index;
address: BitAddress;
typeId: ISEIndex;
subType: CSEIndex;
SELECT TRUE FROM
t = Tree.Null => NULL;
TreeLiteral[t] => StoreBits[sei, TreeLiteralValue[t]];
ENDCASE => {
node ← GetNode[t];
SELECT tb[node].name FROM
mwconst => {
address ← IF seb[root].argument
THEN FnField[sei].offset
ELSE seb[sei].idValue;
FillMultiWord[words, address.wd, tb[node].son[1]]};
union => {
typeId ← WITH tb[node].son[1] SELECT FROM
symbol => index,
ENDCASE => ERROR;
subType ← UnderType[seb[sei].idType];
WITH seb[subType] SELECT FROM
union => IF controlled THEN StoreBits[tagSei, seb[typeId].idValue];
ENDCASE => ERROR;
type ← LOOPHOLE[UnderType[typeId], RecordSEIndex];
list ← tb[node].son[2]; more ← TRUE};
ENDCASE => ERROR};
sei ← NextSe[sei]};
words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n];
FOR i: CARDINAL IN [0 .. n) DO words[i] ← 0 ENDLOOP;
root ← type ← RecordRoot[record];
offset ← IF seb[record].length < WordLength
THEN WordLength - seb[record].length
ELSE 0;
list ← expList; more ← TRUE;
WHILE more DO
more ← FALSE; sei ← FirstVisibleSe[seb[type].fieldCtx];
ScanList[list, PackField];
ENDLOOP;
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[IF n=1 THEN cast ELSE mwconst, 1]; SetInfo[record];
Heap.FreeNode[dataPtr.zone, BASE[words]];
RETURN [PopTree[]]};
PadRecord: PUBLIC PROC [t: Tree.Link, lType: CSEIndex] RETURNS [Tree.Link] = {
IF StructuredLiteral[t] THEN {
nW: CARDINAL = WordsForType[lType];
words: LiteralOps.ValueDescriptor;
node: Tree.Index;
words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, nW], nW];
FOR w: CARDINAL IN [0 .. nW) DO words[w] ← 0 ENDLOOP;
IF TreeLiteral[t] THEN words[0] ← TreeLiteralValue[t]
ELSE {
node ← GetNode[t];
SELECT tb[node].name FROM
mwconst => FillMultiWord[words, 0, tb[node].son[1]];
ENDCASE => ERROR;
FreeNode[node]};
PushLit[LiteralOps.FindDescriptor[words]]; PushNode[mwconst, 1];
Heap.FreeNode[dataPtr.zone, BASE[words]]}
ELSE {PushTree[t]; PushNode[pad, 1]};
SetInfo[lType];
RETURN [PopTree[]]};
ExtractValue: PROC [t: Tree.Link, addr: BitAddress, size: CARDINAL, type: CSEIndex]
RETURNS [val: Tree.Link] = {
words: LiteralOps.ValueDescriptor;
desc: Literals.LitDescriptor = TreeLiteralDesc[t];
n: CARDINAL = size/WordLength;
IF n > 1 THEN {
IF addr.bd # 0 THEN Log.Error[unimplemented];
words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n];
FOR i: CARDINAL IN [0..n) DO words[i] ← ltb[desc.offset][addr.wd+i] ENDLOOP;
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[mwconst, 1]; SetInfo[type];
Heap.FreeNode[dataPtr.zone, BASE[words]];
val ← PopTree[]}
ELSE
val ← MakeStructuredLiteral[
Inline.BITSHIFT[
Inline.BITSHIFT[ltb[desc.offset][addr.wd], addr.bd],
-(WordLength - size)],
type];
RETURN};
UnpackField: PROC [t: Tree.Link, field: ISEIndex] RETURNS [val: Tree.Link] = {
rType: CSEIndex = OperandType[t];
vType: CSEIndex = UnderType[seb[field].idType];
addr: BitAddress;
addr ← seb[field].idValue;
WITH r: seb[rType] SELECT FROM
record =>
IF r.length < WordLength THEN addr.bd ← addr.bd + (WordLength - r.length);
ENDCASE => ERROR;
RETURN [ExtractValue[t, addr, seb[field].idInfo, vType]]};
UnpackElement: PROC [t: Tree.Link, i: CARDINAL] RETURNS [val: Tree.Link] = {
aType: CSEIndex = OperandType[t];
cType: CSEIndex;
addr: BitAddress;
nB, nW: CARDINAL;
WITH a: seb[aType] SELECT FROM
array => {
cType ← UnderType[a.componentType];
nB ← BitsPerElement[cType, a.packed];
IF nB > ByteLength THEN {
nW ← (nB+(WordLength-1))/WordLength;
addr ← [wd:i*nW, bd:0]; nB ← nW*WordLength}
ELSE {
itemsPerWord: CARDINAL = WordLength/nB;
offset: CARDINAL = IF WordsForType[aType] = 1
THEN WordLength - BitsForType[aType]
ELSE 0;
addr ← [wd: i/itemsPerWord, bd: offset + (i MOD itemsPerWord)*nB]}};
ENDCASE => ERROR;
RETURN [ExtractValue[t, addr, nB, cType]]};
-- operators
Call: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
OPEN tb[node];
type: CSEIndex;
son[1] ← Exp[son[1], none]; VPop[];
type ← OperandType[son[1]];
WITH t: seb[type] SELECT FROM
transfer => {
IF attr1 AND name # xerror AND t.typeIn # Symbols.RecordSENull THEN {
son[2] ← Rhs[son[2], t.typeIn]; VPop[]}
ELSE son[2] ← MakeArgRecord[ArgRecord[t.typeIn], son[2]];
VPush[BiasForType[t.typeOut], RepForType[t.typeOut], MaxRegs]};
ENDCASE => ERROR;
IF nSons > 2 THEN CatchNest[son[3]];
RETURN [[subtree[index: node]]]};
Construct: PUBLIC PROC [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] = {
OPEN tb[node];
type: RecordSEIndex = info;
record: RecordSEIndex = RecordRoot[type];
nRegs: RegCount;
k: RegCount = RegsForType[type];
[son[2], nRegs] ← MakeRecord[record, son[2]];
SELECT TRUE FROM
(OpName[son[2]] = list OR OpName[son[2]] = union) => {
subNode: Tree.Index = GetNode[son[2]];
IF ~tb[subNode].attr1 THEN { -- ~all fields constant
val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k]}
ELSE {val ← PackRecord[type, son[2]]; FreeNode[node]; nRegs ← k};
VPush[0, other, nRegs]};
(son[2] = Tree.Null) => {val ← Tree.Null; VPush[0, other, 0]};
ENDCASE => val ← CastUniList[node, type, nested];
RETURN};
Union: PUBLIC PROC [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] = {
OPEN tb[node];
vSei: ISEIndex = WITH son[1] SELECT FROM symbol=>index, ENDCASE=>ERROR;
type: RecordSEIndex = LOOPHOLE[UnderType[vSei]];
tSei: CSEIndex = UnderType[info];
tagged: BOOLEAN =
WITH seb[tSei] SELECT FROM union => controlled, ENDCASE => FALSE;
nRegs: RegCount;
[son[2], nRegs] ← MakeRecord[type, son[2]];
attr2 ← tagged;
SELECT TRUE FROM
(OpName[son[2]] = list OR OpName[son[2]] = union) => {
attr1 ← WITH son[2] SELECT FROM subtree => tb[index].attr1, ENDCASE => FALSE;
val ← [subtree[index: node]]; VPush[0, other, nRegs]};
(son[2] = Tree.Null) => {
attr1 ← TRUE; val ← [subtree[index: node]]; VPush[0, other, 1]};
ENDCASE =>
IF (~tagged OR seb[vSei].idValue = 0) AND WordsForType[type] = 1
AND ZeroOffset[IF tagged THEN TagSei[tSei] ELSE FirstVisibleSe[seb[type].fieldCtx]]
THEN val ← CastUniList[node, type, nested]
ELSE {
attr1 ← StructuredLiteral[son[2]];
val ← [subtree[index: node]]; VPush[0, other, RegsForType[type]]};
RETURN};
TagSei: PROC [tSei: CSEIndex] RETURNS [ISEIndex] = INLINE {
RETURN [WITH seb[tSei] SELECT FROM union => tagSei, ENDCASE => Symbols.ISENull]};
ZeroOffset: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE {
RETURN [sei # Symbols.ISENull AND seb[sei].idValue = BitAddress[0, 0]]};
CastUniList: PROC [node: Tree.Index, type: CSEIndex, nested: BOOLEAN]
RETURNS [val: Tree.Link] = {
subNode: Tree.Index;
unSafe: BOOLEAN;
t: Tree.Link ← tb[node].son[2];
IF (unSafe ← OpName[t] = safen) THEN {
subNode ← GetNode[t]; t ← tb[subNode].son[1];
tb[subNode].son[1] ← Tree.Null; FreeNode[subNode]};
tb[node].son[2] ← Tree.Null; FreeNode[node];
val ← ForceType[t, type];
IF unSafe AND nested THEN {
PushTree[val]; PushNode[safen, 1]; SetInfo[type]; val ← PopTree[]};
VPush[BiasForType[type], RepForType[type], RegsForType[type]];
RETURN};
RowConstruct: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
aType: Symbols.ArraySEIndex = info;
cType: CSEIndex = UnderType[seb[aType].componentType];
n: CARDINAL = Cardinality[seb[aType].indexType];
const, strings, lstrings: BOOLEAN;
nRegs: RegCount;
l: CARDINAL;
EvalElement: Tree.Map = {
IF t = Tree.Null THEN {v ← Tree.Null; const ← strings ← lstrings ← FALSE}
ELSE {
v ← Rhs[t, cType]; nRegs ← MAX[VRegs[], nRegs];
IF TreeLiteral[v] THEN strings ← lstrings ← FALSE
ELSE
WITH v SELECT FROM
subtree =>
SELECT tb[index].name FROM
mwconst => strings ← lstrings ← FALSE;
ENDCASE => const ← strings ← lstrings ← FALSE;
literal =>
WITH info SELECT FROM
string => {
const ← FALSE;
IF LiteralOps.MasterString[index] = index THEN lstrings ← FALSE
ELSE strings ← FALSE};
ENDCASE;
ENDCASE => const ← strings ← lstrings ← FALSE;
VPop[]};
RETURN};
w, nW: CARDINAL;
words: LiteralOps.ValueDescriptor;
bitsLeft: CARDINAL;
bitCount: CARDINAL;
PackElement: Tree.Scan = {
IF TreeLiteral[t] THEN {
bitsLeft ← bitsLeft - bitCount;
words[w] ← Inline.BITOR[words[w],
Inline.BITSHIFT[TreeLiteralValue[t], bitsLeft]];
IF bitsLeft < bitCount THEN {w ← w+1; bitsLeft ← WordLength}}
ELSE {
node: Tree.Index = GetNode[t];
SELECT tb[node].name FROM
mwconst => {
FillMultiWord[words, w, tb[node].son[1]];
w ← w + WordsForType[cType]};
ENDCASE => ERROR}};
SELECT (l ← ListLength[son[2]]) FROM
= n => NULL;
> n => Log.ErrorN[listLong, l-n];
< n => Log.ErrorN[listShort, n-l];
ENDCASE;
const ← strings ← lstrings ← TRUE; nRegs ← 0;
son[2] ← UpdateList[son[2], EvalElement];
IF const AND l = n THEN {
nW ← WordsForType[aType];
words ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, nW], nW];
FOR w: CARDINAL IN [0 .. nW) DO words[w] ← 0 ENDLOOP;
bitCount ← BitsPerElement[cType, seb[aType].packed];
w ← 0; bitsLeft ← IF nW = 1 THEN BitsForType[aType] ELSE WordLength;
ScanList[son[2], PackElement]; FreeNode[node];
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[IF nW = 1 THEN cast ELSE mwconst, 1]; SetInfo[aType];
Heap.FreeNode[dataPtr.zone, BASE[words]];
val ← PopTree[]; nRegs ← RegsForType[aType]}
ELSE {attr1 ← strings # lstrings; val ← [subtree[index: node]]};
VPush[0, other, nRegs]; RETURN};
All: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
aType: Symbols.ArraySEIndex = info;
cType: CSEIndex = UnderType[seb[aType].componentType];
val ← [subtree[index: node]];
IF son[1] # Tree.Null THEN {
son[1] ← Rhs[son[1], cType];
IF TreeLiteral[son[1]] AND WordsForType[aType] = 1 THEN {
nB: CARDINAL = BitsPerElement[cType, seb[aType].packed];
v, w: WORD;
v ← TreeLiteralValue[son[1]]; w ← 0;
THROUGH [1 .. Cardinality[seb[aType].indexType]] DO
w ← Inline.BITOR[Inline.BITSHIFT[w, nB], v] ENDLOOP;
val ← ForceType[MakeTreeLiteral[w], aType]; FreeNode[node]}
ELSE IF OperandType[son[1]] # cType THEN son[1] ← ForceType[son[1], cType];
VPop[]};
VPush[0, other, RegsForType[aType]]; RETURN};
Dollar: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
rep: Repr;
bias: INTEGER;
nRegs: RegCount;
k: RegCount = RegsForType[info];
son[1] ← RValue[son[1], BiasForType[OperandType[son[1]]], none];
nRegs ← VRegs[]; VPop[];
son[2] ← Exp[son[2], none]; rep ← VRep[]; bias ← VBias[]; VPop[];
IF ~StructuredLiteral[son[1]] THEN {val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k]}
ELSE
WITH son[2] SELECT FROM
symbol => {val ← UnpackField[son[1], index]; FreeNode[node]; nRegs ← k};
ENDCASE => ERROR;
VPush[bias, rep, nRegs]; RETURN};
Index: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
iType, cType: CSEIndex;
next: SEIndex;
nRegs: RegCount;
son[1] ← Exp[son[1], none];
FOR aType: CSEIndex ← OperandType[son[1]], UnderType[next] DO
WITH seb[aType] SELECT FROM
array => {
iType ← UnderType[indexType]; cType ← UnderType[componentType]; EXIT};
arraydesc => next ← describedType;
long => next ← rangeType;
ENDCASE => ERROR;
ENDLOOP;
IF name = dindex THEN {
son[2] ← RValue[son[2], BiasForType[iType], unsigned];
attr1 ← checked OR dataPtr.switches['n];
attr3 ← checked OR dataPtr.switches['b]}
ELSE son[2] ← Rhs[son[2], iType, TRUE];
SELECT TRUE FROM
(TreeLiteral[son[2]] AND OpName[son[1]] = all) => {
subNode: Tree.Index = GetNode[son[1]];
val ← tb[subNode].son[1];
tb[subNode].son[1] ← Tree.Null; FreeNode[node];
nRegs ← RegsForType[cType]};
(TreeLiteral[son[2]] AND StructuredLiteral[son[1]]) => {
val ← UnpackElement[son[1], TreeLiteralValue[son[2]]]; FreeNode[node];
nRegs ← RegsForType[cType]};
ENDCASE => {
val ← [subtree[index:node]]; nRegs ← ComputeIndexRegs[node]};
VPop[]; VPop[]; VPush[BiasForType[cType], RepForType[cType], nRegs];
RETURN};
SeqIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
OPEN tb[node];
iType, cType, sType: CSEIndex;
nRegs: RegCount;
son[1] ← Exp[son[1], none];
sType ← OperandType[son[1]];
WITH t: seb[sType] SELECT FROM
sequence => {
iType ← UnderType[seb[t.tagSei].idType]; cType ← UnderType[t.componentType];
attr3 ← t.controlled AND (checked OR dataPtr.switches['b])};
array => {
iType ← UnderType[t.indexType]; cType ← UnderType[t.componentType];
attr3 ← checked OR dataPtr.switches['b]};
ENDCASE;
son[2] ← RValue[son[2], BiasForType[iType], TargetRep[RepForType[iType]]];
nRegs ← ComputeIndexRegs[node];
VPop[]; VPop[]; VPush[BiasForType[cType], RepForType[cType], nRegs];
RETURN [[subtree[index:node]]]};
Reloc: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
nRegs: RegCount;
type: CSEIndex = tb[node].info;
tb[node].son[1] ← RValue[tb[node].son[1], 0, unsigned];
tb[node].son[2] ← RValue[tb[node].son[2], 0, unsigned];
nRegs ← ComputeIndexRegs[node]; VPop[]; VPop[];
IF ~tb[node].attr1 AND ZeroP[tb[node].son[1]] THEN {
rType, subType, next: CSEIndex;
FOR subType ← OperandType[tb[node].son[2]], next DO -- CanonicalType
WITH r: seb[subType] SELECT FROM
relative => {
rType ← UnderType[r.resultType];
PushTree[tb[node].son[2]]; tb[node].son[2] ← Tree.Null;
IF tb[node].attr2 AND seb[UnderType[r.offsetType]].typeTag # long THEN {
PushNode[lengthen, 1];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE]}
ELSE PushNode[cast, 1];
EXIT};
record => next ← UnderType[seb[FirstVisibleSe[r.fieldCtx]].idType];
ENDCASE => ERROR;
ENDLOOP;
SetInfo[rType];
PushNode[uparrow, 1]; SetInfo[type];
SetAttr[1, dataPtr.switches['n]]; SetAttr[2, tb[node].attr2];
val ← PopTree[]; FreeNode[node]}
ELSE val ← [subtree[node]];
VPush[BiasForType[type], RepForType[type], nRegs]};
Assignment: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
OPEN tb[node];
lhsType: CSEIndex;
son[1] ← Exp[son[1], none]; lhsType ← OperandType[son[1]];
son[2] ← Rhs[son[2], lhsType]; VPop[];
RETURN [RewriteAssign[node, lhsType]]};
Extract: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
rType: RecordSEIndex = tb[subNode].info;
sei: ISEIndex;
AssignItem: Tree.Map = {
type: CSEIndex;
saveType: CSEIndex = passPtr.implicitType;
saveBias: INTEGER = passPtr.implicitBias;
saveRep: Repr = passPtr.implicitRep;
IF t = Tree.Null THEN v ← Tree.Null
ELSE {
subNode: Tree.Index = GetNode[t];
type ← UnderType[seb[sei].idType];
passPtr.implicitType ← type;
passPtr.implicitBias ← BiasForType[type]; passPtr.implicitRep ← RepForType[type];
v ← IF tb[subNode].name = extract THEN Extract[subNode] ELSE Assignment[subNode];
VPop[]};
sei ← NextSe[sei];
passPtr.implicitRep ← saveRep; passPtr.implicitBias ← saveBias;
passPtr.implicitType ← saveType; RETURN};
sei ← FirstVisibleSe[seb[rType].fieldCtx];
tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], AssignItem];
tb[node].son[2] ← Exp[tb[node].son[2], none]; VPop[];
VPush[BiasForType[rType], RepForType[rType], MaxRegs];
RETURN [[subtree[index:node]]]};
New: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
OPEN tb[node];
IF son[1] # Tree.Null THEN {son[1] ← Exp[son[1], none]; VPop[]};
IF OpName[son[2]] = apply THEN {
subNode: Tree.Index = GetNode[son[2]];
vSei: ISEIndex;
TypeExp[tb[subNode].son[1]];
tb[subNode].son[2] ← Rhs[tb[subNode].son[2], dataPtr.typeCARDINAL]; VPop[];
vSei ← VariantField[UnderType[TypeForTree[tb[subNode].son[1]]]];
IF vSei # Symbols.ISENull THEN {
vType: CSEIndex = UnderType[seb[vSei].idType];
n: CARDINAL = WITH t: seb[vType] SELECT FROM
sequence => Cardinality[seb[t.tagSei].idType],
ENDCASE => 0;
subType: CSEIndex = OperandType[tb[subNode].son[2]];
IF subType = dataPtr.typeINT OR ~(Cardinality[subType] IN [1..n]) THEN -- (0..n]
tb[subNode].son[2] ← CheckRange[tb[subNode].son[2], n, dataPtr.typeCARDINAL]}}
ELSE TypeExp[son[2], OpName[son[3]] = body];
SELECT OpName[son[3]] FROM
body => {
expNode: Tree.Index = GetNode[son[3]];
PushNode[body, 0]; SetInfo[tb[expNode].info]; son[3] ← PopTree[]};
signalinit => NULL;
ENDCASE =>
IF son[3] # Tree.Null THEN {
son[3] ← Rhs[son[3], UnderType[TypeForTree[son[2]]]]; VPop[]};
IF nSons > 3 THEN CatchNest[son[4]];
VPush[0, unsigned, MaxRegs];
RETURN [[subtree[index:node]]]};
Narrow: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
type: CSEIndex = tb[node].info;
IF tb[node].son[2] # Tree.Null THEN TypeExp[tb[node].son[2]];
IF tb[node].attr2 OR tb[node].attr3 THEN {
OPEN tb[node];
son[1] ← RValue[son[1], 0, RepForType[OperandType[son[1]]]]; VPop[];
IF nSons > 2 THEN CatchNest[son[3]];
val ← [subtree[index: node]];
VPush[BiasForType[type], RepForType[type], MaxRegs]}
ELSE {
val ← Rhs[tb[node].son[1], type];
tb[node].son[1] ← Tree.Null; FreeNode[node]}};
TargetRep: --PUBLIC-- PROC [rep: Repr] RETURNS [Repr] = INLINE {
RETURN [--IF rep = both THEN signed ELSE-- rep]};
Rhs: PUBLIC PROC [exp: Tree.Link, lType: CSEIndex, voidOK: BOOLEAN ← FALSE]
RETURNS [val: Tree.Link] = {
lBias: INTEGER = BiasForType[lType];
lRep: Repr = RepForType[lType];
nw: CARDINAL = WordsForType[lType];
rType: CSEIndex = OperandType[exp];
rRep: Repr;
val ← RValue[exp, lBias, TargetRep[lRep]]; rRep ← VRep[];
IF ~Types.Assignable[[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]] THEN
Log.ErrorTree[typeClash, val];
IF ~(IF nw = 0 THEN voidOK ELSE WordsForType[rType] = nw) THEN
SELECT TRUE FROM
(seb[lType].typeTag = record) AND (seb[rType].typeTag = record) =>
val ← PadRecord[val, lType];
(seb[lType].typeTag = union) AND (seb[rType].typeTag = union) => NULL;
ENDCASE => Log.ErrorTree[sizeClash, val];
IF (lType = dataPtr.typeINT AND rRep = unsigned) OR
((rType = dataPtr.typeINT AND rRep = signed) AND lRep = unsigned) THEN
val ← CheckRange[val, CARDINAL[Environment.maxINTEGER-lBias]+1, lType]
ELSE
SELECT seb[lType].typeTag FROM
subrange, enumerated, relative =>
SELECT Cover[lType, lRep, rType, rRep] FROM
full => NULL;
partial => val ← CheckRange[val, Cardinality[lType], lType];
ENDCASE => IF nw # 0 THEN val ← BoundsFault[val, lType];
basic =>
IF lType = dataPtr.typeCHAR AND (rRep # both OR TreeLiteral[val]) THEN
val ← CheckRange[val, Cardinality[lType], lType];
ENDCASE => NULL;
RETURN};
Cover: PUBLIC PROC [lType: CSEIndex, lRep: Repr, rType: CSEIndex, rRep: Repr]
RETURNS [Covering] = {
lLb, lUb, rLb, rUb: LONG INTEGER;
[lLb, lUb] ← Bounds[lType, lRep];
[rLb, rUb] ← Bounds[rType, rRep];
RETURN [
IF lLb <= rLb
THEN IF lUb < rLb THEN none ELSE IF lUb < rUb THEN partial ELSE full
ELSE IF lLb <= rUb THEN partial ELSE none]};
Bounds: PROC [type: CSEIndex, rep: Repr] RETURNS [lb, ub: LONG INTEGER] = {
WITH t: seb[type] SELECT FROM
subrange => {lb ← t.origin; ub ← lb + t.range};
enumerated => {lb ← 0; ub ← t.nValues-1};
relative => [lb, ub] ← Bounds[UnderType[t.offsetType], rep];
ENDCASE =>
SELECT rep FROM
signed => {lb ← -Environment.maxINTEGER-1; ub ← Environment.maxINTEGER};
both => {lb ← 0; ub ← Environment.maxINTEGER};
ENDCASE => {lb ← 0; ub ← Environment.maxCARDINAL};
RETURN};
CheckRange: PUBLIC PROC [t: Tree.Link, bound: CARDINAL, type: CSEIndex]
RETURNS [val: Tree.Link] = {
SELECT TRUE FROM
(bound = 0) => val ← t;
TreeLiteral[t] =>
val ← IF TreeLiteralValue[t] >= bound THEN BoundsFault[t,type] ELSE t;
(checked OR dataPtr.switches['b]) AND ~Bounded[t, bound] => {
PushTree[MakeTreeLiteral[bound]];
IF OpName[t] = safen THEN {
node: Tree.Index = GetNode[t];
PushTree[tb[node].son[1]]; PushNode[check, -2]; SetInfo[type];
tb[node].son[1] ← PopTree[]; val ← t}
ELSE {PushTree[t]; PushNode[check,-2]; SetInfo[type]; val ← PopTree[]}};
ENDCASE => val ← t;
RETURN};
Bounded: PROC [t: Tree.Link, bound: CARDINAL] RETURNS [BOOLEAN] = INLINE {
IF OpName[t] = mod THEN {
t2: Tree.Link = NthSon[t, 2];
RETURN [TreeLiteral[t2] AND TreeLiteralValue[t2] IN [0..bound]]}
ELSE RETURN [FALSE]};
BoundsFault: PROC [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = {
Log.ErrorTree[boundsFault, AdjustBias[t, -BiasForType[type]]];
PushTree[t];
-- PushTree[MakeTreeLiteral[0]]; PushNode[check, 2]; SetInfo[type];
RETURN [PopTree[]]};
RewriteAssign: PUBLIC PROC [node: Tree.Index, lType: CSEIndex] RETURNS [Tree.Link] = {
IF seb[lType].typeTag = union THEN {
WITH tb[node].son[1] SELECT FROM
subtree => {
subType: CSEIndex;
subNode: Tree.Index = index;
SELECT tb[subNode].name FROM
dot => {
subType ← OperandType[tb[subNode].son[1]];
PushTree[tb[subNode].son[1]]; PushNode[uparrow, 1];
SetInfo[WITH seb[subType] SELECT FROM
ref => UnderType[refType],
ENDCASE => Symbols.typeANY];
tb[subNode].son[1] ← PopTree[];
tb[subNode].name ← dollar};
dollar => NULL;
ENDCASE => NULL}; -- flagged by code generators for now
ENDCASE => NULL}; -- flagged by code generators for now
IF tb[node].name = assignx THEN tb[node].info ← OperandType[tb[node].son[1]];
RETURN [[subtree[index: node]]]};
}.