DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [BITAND, BITOR, BITSHIFT, bitsPerByte, bitsPerWord],
ComData:
TYPE
USING [
idCARDINAL, ownSymbols, switches, typeINT, typeCARDINAL, typeCHAR],
Literals: TYPE USING [Base, LitDescriptor, ltType],
LiteralOps: TYPE USING [FindDescriptor, MasterString],
Log: TYPE USING [Error, ErrorN, ErrorTree, ErrorType],
P4:
TYPE
USING [
AdjustBias, Attr, BiasForType, BitsForType, both, CatchNest, checked, CommonProp,
ComputeIndexRegs, ConsState, Covering, emptyProp, Exp, ForceType, MakeStructuredLiteral,
MakeTreeLiteral, MaxCardinality, maxRegs, NeutralExp, none, OperandType,
OpWordCount, other, Prop, RegCount, RegsForType, RepForType, Repr, RValue,
signed, StructuredLiteral, Subst, TreeLiteral, TreeLiteralDesc, TreeLiteralValue, TypeExp,
TypeForTree, unsigned, ValueDescriptor, VAttr, VBias, voidAttr, voidProp,
VPop, VProp, VPush, VRegs, VRep, WordSeq, WordsForType, ZeroP],
Pass4: TYPE USING [implicitAttr, implicitBias, implicitType],
Symbols:
TYPE
USING [
ArraySEIndex, Base, BitAddress, CSEIndex, ctxType, ISEIndex, ISENull,
RecordSEIndex, RecordSENull, seType, Type, typeANY, WordCount],
SymbolOps:
TYPE
USING [
ArgRecord, BitsPerElement, Cardinality, EqTypes, FirstCtxSe, FirstVisibleSe, FnField,
NextSe, RCType, RecordRoot, ReferentType, TypeForm, UnderType, VariantField],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType],
TreeOps:
TYPE
USING [
FreeNode, FreeTree, GetAttr, GetNode, ListLength, NthSon, OpName, PopTree,
PushLit, PushNode, PushTree, ScanList, SetAttr, SetInfo, UpdateList],
Types: TYPE USING [Assignable];
construction of packed values (machine dependent)
WordLength: CARDINAL = Basics.bitsPerWord;
ByteLength: CARDINAL = Basics.bitsPerByte;
FillMultiWord:
PUBLIC
PROC[words: ValueDescriptor, origin:
CARDINAL, t: Tree.Link] = {
desc: Literals.LitDescriptor = TreeLiteralDesc[t];
IF origin + desc.length <= words.length
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: ValueDescriptor;
more: BOOL;
StoreBits:
PROC[sei: ISEIndex, value:
WORD] = {
OPEN Basics;
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 ← NARROW[tb[node].son[1], Tree.Link.symbol].index;
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 ← NEW[WordSeq[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[DESCRIPTOR[@words[0], n]]];
PushNode[IF n=1 THEN cast ELSE mwconst, 1]; SetInfo[record];
words ← NIL;
RETURN[PopTree[]]};
PadRecord:
PUBLIC
PROC[t: Tree.Link, lType: Type]
RETURNS[Tree.Link] = {
IF StructuredLiteral[t]
THEN {
nW: CARDINAL = WordsForType[lType];
words: ValueDescriptor;
node: Tree.Index;
words ← NEW[WordSeq[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[DESCRIPTOR[@words[0], nW]]]; PushNode[mwconst, 1];
words ← NIL}
ELSE {PushTree[t]; PushNode[pad, 1]};
SetInfo[lType];
RETURN[PopTree[]]};
ExtractValue:
PROC[t: Tree.Link, addr: BitAddress, size:
CARDINAL, type: Type]
RETURNS[val: Tree.Link] = {
words: ValueDescriptor;
desc: Literals.LitDescriptor = TreeLiteralDesc[t];
n: CARDINAL = size/WordLength;
IF n > 1
THEN {
IF addr.bd # 0 THEN Log.Error[unimplemented];
words ← NEW[WordSeq[n]];
FOR i: CARDINAL IN [0..n) DO words[i] ← ltb[desc.offset][addr.wd+i] ENDLOOP;
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], n]]];
PushNode[mwconst, 1]; SetInfo[type];
words ← NIL;
val ← PopTree[]}
ELSE
val ← MakeStructuredLiteral[
Basics.
BITSHIFT[
Basics.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 = OperandStruct[t];
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, seb[field].idType]]};
UnpackElement:
PROC[t: Tree.Link, i:
CARDINAL]
RETURNS[val: Tree.Link] = {
aType: CSEIndex = OperandStruct[t];
cType: Type;
addr: BitAddress;
nB, nW: CARDINAL;
WITH a: seb[aType]
SELECT
FROM
array => {
cType ← 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 - CARDINAL[BitsForType[aType]]
ELSE 0;
addr ← [wd: i/itemsPerWord, bd: offset + (i MOD itemsPerWord)*nB]}};
ENDCASE => ERROR;
RETURN[ExtractValue[t, addr, nB, cType]]};
Substx:
PUBLIC
PROC[node: Tree.Index]
RETURNS[val: Tree.Link] = {
type: Type = tb[node].info;
IF OpName[tb[node].son[2]] = result
THEN {
saveChecked: BOOL = checked;
subNode: Tree.Index = GetNode[tb[node].son[2]];
IF ~tb[node].attr3 THEN checked ← tb[node].attr1;
tb[node].son[1] ← NeutralExp[tb[node].son[1]];
SELECT ListLength[tb[subNode].son[1]]
FROM
0 => ERROR;
1 =>
val ←
--IF tb[subNode].attr3
THEN tb[subNode].son[1]
--ELSE-- ForceType[tb[subNode].son[1], type];
ENDCASE => {
PushTree[Tree.Null]; PushTree[tb[subNode].son[1]];
PushNode[construct, 2]; SetInfo[type]; val ← PopTree[]};
tb[subNode].son[1] ← Tree.Null; FreeNode[node];
val ← Rhs[val, type, $init];
checked ← saveChecked}
ELSE {
val ← Subst[node];
VPush[BiasForType[type], [prop: emptyProp, rep: RepForType[type]], maxRegs]};
RETURN};
Call:
PUBLIC
PROC[node: Tree.Index]
RETURNS[Tree.Link] = {
OPEN tb[node];
type: CSEIndex;
prop: Prop;
son[1] ← Exp[son[1], none]; prop ← VProp[]; VPop[];
type ← OperandStruct[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, $init]
ELSE son[2] ← MakeArgRecord[ArgRecord[t.typeIn], son[2]];
prop ← CommonProp[prop, VProp[]]; VPop[];
prop.noXfer ← prop.noAssign ← prop.noFreeVar ← FALSE;
IF nSons > 2 THEN CatchNest[son[3]];
VPush[BiasForType[t.typeOut], [prop: prop, rep: RepForType[t.typeOut]], maxRegs]};
ENDCASE => ERROR;
RETURN[[subtree[index: node]]]};
Construct:
PUBLIC
PROC[node: Tree.Index, cs: ConsState]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
type: RecordSEIndex = LOOPHOLE[UnderType[info]];
record: RecordSEIndex = RecordRoot[type];
prop: Prop;
nRegs: RegCount;
k: RegCount = RegsForType[type];
SELECT
TRUE
FROM
(OpName[son[2]] = list) => {
subNode: Tree.Index;
son[2] ← MakeRecord[record, son[2], cs]; nRegs ← VRegs[]; prop ← VProp[];
subNode ← GetNode[son[2]];
IF ~tb[subNode].attr1
THEN {
-- ~all fields constant
tb[node].attr3 ← tb[subNode].attr3;
val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k]}
ELSE {val ← PackRecord[type, son[2]]; FreeNode[node]; nRegs ← k};
VPop[]; VPush[0, [prop: prop, rep: other], nRegs]};
(son[2] = Tree.Null) => {
val ← Tree.Null; VPush[0, [prop: voidProp, rep: other], k]};
(OpName[son[2]] = union) => {
son[2] ← Union[GetNode[son[2]], cs];
IF OpName[son[2]] = union
THEN {
subNode: Tree.Index = GetNode[son[2]];
IF tb[subNode].attr1 THEN {val ← PackRecord[type, son[2]]; FreeNode[node]}
ELSE val ← [subtree[index: node]]}
ELSE {val ← ForceType[son[2], type]; son[2] ← Tree.Null; FreeNode[node]}};
ENDCASE => val ← CastUniList[node, type, cs, record];
RETURN};
Union:
PUBLIC
PROC[node: Tree.Index, cs: ConsState]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
vSei: ISEIndex = NARROW[son[1], Tree.Link.symbol].index;
type: RecordSEIndex = LOOPHOLE[UnderType[vSei]];
tSei: CSEIndex = UnderType[info];
tagged: BOOL = (WITH t: seb[tSei] SELECT FROM union => t.controlled, ENDCASE => FALSE);
attr: Attr;
nRegs: RegCount;
attr2 ← tagged;
SELECT
TRUE
FROM
(OpName[son[2]] = list
OR OpName[son[2]] = union) => {
son[2] ← MakeRecord[type, son[2], cs]; nRegs ← VRegs[]; attr ← VAttr[];
attr1 ← WITH son[2] SELECT FROM subtree => tb[index].attr1, ENDCASE => FALSE;
val ← [subtree[index: node]]; VPop[]; attr.rep ← other; VPush[0, attr, nRegs]};
(son[2] = Tree.Null) => {
attr1 ← TRUE; val ← [subtree[index: node]];
VPush[0, [prop: voidProp, rep: 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, tSei, cs, type]
ELSE {
son[2] ← MakeRecord[type, son[2], cs]; attr ← VAttr[];
attr1 ← StructuredLiteral[son[2]];
val ← [subtree[index: node]];
VPop[]; attr.rep ← other; VPush[0, attr, 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[
BOOL] =
INLINE {
RETURN[sei # Symbols.ISENull AND seb[sei].idValue = BitAddress[0, 0]]};
CastUniList:
PROC[node: Tree.Index, type: CSEIndex, cs: ConsState, rType: RecordSEIndex]
RETURNS[val: Tree.Link] = {
target: Type = seb[FirstVisibleSe[seb[rType].fieldCtx]].idType;
prop: Prop;
nRegs: RegCount;
val ← ForceType[FieldRhs[tb[node].son[2], target, cs], type];
prop ← VProp[]; nRegs ← VRegs[]; VPop[];
tb[node].son[2] ← Tree.Null; FreeNode[node];
VPush[BiasForType[type], [prop: prop, rep: RepForType[type]], nRegs];
RETURN};
RowConstruct:
PUBLIC
PROC[node: Tree.Index, cs: ConsState]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
aType: Symbols.ArraySEIndex = LOOPHOLE[UnderType[info]];
cType: Type = seb[aType].componentType;
n: CARDINAL = Cardinality[seb[aType].indexType];
const, strings, lstrings: BOOL;
prop: Prop ← voidProp;
nRegs: RegCount ← 0;
l: CARDINAL;
EvalElement: Tree.Map = {
IF t = Tree.Null THEN {v ← Tree.Null; const ← strings ← lstrings ← FALSE}
ELSE {
v ← FieldRhs[t, cType, cs];
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 index
SELECT
FROM
string => {
const ← FALSE;
IF LiteralOps.MasterString[sti] = sti THEN lstrings ← FALSE
ELSE strings ← FALSE};
ENDCASE;
ENDCASE => const ← strings ← lstrings ← FALSE;
prop ← CommonProp[VProp[], prop]; nRegs ← MAX[VRegs[], nRegs]; VPop[];
IF cs = $first THEN cs ← $rest};
RETURN};
w, nW: CARDINAL;
words: ValueDescriptor;
bitsLeft: CARDINAL;
bitCount: CARDINAL;
PackElement: Tree.Scan = {
IF TreeLiteral[t]
THEN {
bitsLeft ← bitsLeft - bitCount;
words[w] ← Basics.
BITOR[words[w],
Basics.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 ← NEW[WordSeq[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 CARDINAL[BitsForType[aType]] ELSE WordLength;
ScanList[son[2], PackElement]; FreeNode[node];
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], nW]]];
PushNode[IF nW = 1 THEN cast ELSE mwconst, 1]; SetInfo[aType];
words ← NIL;
val ← PopTree[]; nRegs ← RegsForType[aType]}
ELSE {
IF (attr1 ← strings # lstrings) THEN prop.noFreeVar ← FALSE;
val ← [subtree[index: node]]};
VPush[0, [prop: prop, rep: other], nRegs]; RETURN};
All:
PUBLIC
PROC[node: Tree.Index, cs: ConsState]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
aType: Symbols.ArraySEIndex = LOOPHOLE[UnderType[info]];
cType: Type = seb[aType].componentType;
prop: Prop;
val ← [subtree[index: node]];
IF son[1] = Tree.Null THEN prop ← voidProp
ELSE {
son[1] ← FieldRhs[son[1], cType, cs];
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 ← Basics.BITOR[Basics.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];
prop ← VProp[]; VPop[]};
VPush[0, [prop: prop, rep: other], RegsForType[aType]];
RETURN};
Dot:
PUBLIC
PROC[node: Tree.Index, target: Repr]
RETURNS[Tree.Link] = {
OPEN tb[node];
prop: Prop;
attr: Attr;
bias: INTEGER;
nRegs: RegCount;
son[1] ← RValue[son[1], 0, unsigned];
prop ← VProp[]; prop.noSelect ← prop.noFreeVar ← FALSE;
nRegs ← MAX[RegsForType[info], VRegs[]]; VPop[];
son[2] ← Exp[son[2], target];
attr ← VAttr[]; bias ← VBias[]; VPop[];
attr.prop ← CommonProp[attr.prop, prop];
attr1 ← ~attr3 AND (checked OR dataPtr.switches['n]);
VPush[bias, attr, nRegs];
RETURN[[subtree[index: node]]]};
Dollar:
PUBLIC
PROC[node: Tree.Index]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
attr: Attr;
immutable: BOOL;
bias: INTEGER;
nRegs: RegCount;
k: RegCount = RegsForType[info];
son[1] ← RValue[son[1], BiasForType[OperandType[son[1]]], none];
nRegs ← VRegs[]; attr.prop ← VProp[]; immutable ← attr.prop.immutable; VPop[];
son[2] ← Exp[son[2], none]; attr.rep ← VRep[]; bias ← VBias[];
IF ~StructuredLiteral[son[1]]
THEN {
val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k];
attr.prop ← CommonProp[attr.prop, VProp[]];
attr.prop.noSelect ← FALSE; attr.prop.immutable ← immutable}
ELSE {
val ← UnpackField[son[1], NARROW[son[2], Tree.Link.symbol].index];
FreeNode[node]; nRegs ← k};
VPop[];
VPush[bias, attr, nRegs]; RETURN};
Index:
PUBLIC
PROC[node: Tree.Index]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
iType, cType: Type;
next: Type;
prop: Prop;
immutable: BOOL;
nRegs: RegCount;
son[1] ← Exp[son[1], none]; prop ← VProp[]; immutable ← prop.immutable;
FOR aType: CSEIndex ← OperandStruct[son[1]], UnderType[next]
DO
WITH seb[aType]
SELECT
FROM
array => {iType ← indexType; cType ← componentType; EXIT};
arraydesc => next ← describedType;
long => next ← rangeType;
ENDCASE => ERROR;
ENDLOOP;
IF WordsForType[cType] > OpWordCount.
LAST
THEN
Log.ErrorTree[operandSize, [subtree[node]]];
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, $init, TRUE];
prop ← CommonProp[prop, VProp[]];
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]]
AND name = index) => {
val ← UnpackElement[son[1], TreeLiteralValue[son[2]]]; FreeNode[node];
nRegs ← RegsForType[cType]};
ENDCASE => {
val ← [subtree[index:node]];
nRegs ← ComputeIndexRegs[node];
prop.noSelect ← FALSE; prop.immutable ← immutable};
VPop[]; VPop[];
VPush[BiasForType[cType], [prop: prop, rep: RepForType[cType]], nRegs];
RETURN};
SeqIndex:
PUBLIC
PROC[node: Tree.Index]
RETURNS[Tree.Link] = {
OPEN tb[node];
sType: CSEIndex;
iType, cType: Type;
prop: Prop;
nRegs: RegCount;
son[1] ← Exp[son[1], none]; prop ← VProp[];
sType ← OperandStruct[son[1]];
WITH t: seb[sType]
SELECT
FROM
sequence => {
iType ← seb[t.tagSei].idType; cType ← 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;
IF WordsForType[cType] > OpWordCount.
LAST
THEN
Log.ErrorTree[operandSize, [subtree[node]]];
son[2] ← RValue[son[2], BiasForType[iType], TargetRep[RepForType[iType]]];
nRegs ← ComputeIndexRegs[node];
prop ← CommonProp[prop, VProp[]]; prop.noSelect ← FALSE; VPop[]; VPop[];
VPush[BiasForType[cType], [prop: prop, rep: RepForType[cType]], nRegs];
RETURN[[subtree[index:node]]]};
Reloc:
PUBLIC
PROC[node: Tree.Index]
RETURNS[val: Tree.Link] = {
prop: Prop;
nRegs: RegCount;
type: Type = tb[node].info;
tb[node].son[1] ← RValue[tb[node].son[1], 0, unsigned]; prop ← VProp[];
tb[node].son[2] ← RValue[tb[node].son[2], 0, unsigned]; prop ← CommonProp[prop, VProp[]];
nRegs ← ComputeIndexRegs[node]; VPop[]; VPop[];
IF ~tb[node].attr1
AND ZeroP[tb[node].son[1]]
THEN {
rType: Type;
subType, next: CSEIndex;
FOR subType ← OperandStruct[tb[node].son[2]], next
DO
-- CanonicalType
WITH r: seb[subType]
SELECT
FROM
relative => {
rType ← 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]];
prop.noSelect ← FALSE;
VPush[BiasForType[type], [prop: prop, rep: RepForType[type]], nRegs];
RETURN};
Assignment:
PUBLIC
PROC[node: Tree.Index]
RETURNS[Tree.Link] = {
OPEN tb[node];
lhsType: Type;
bias: INTEGER;
attr: Attr;
nRegs: RegCount;
son[1] ← Exp[son[1], none];
bias ← VBias[]; attr ← VAttr[]; nRegs ← VRegs[];
lhsType ← OperandType[son[1]];
son[2] ← Rhs[son[2], lhsType, $first];
attr.prop ← CommonProp[attr.prop, VProp[]]; attr.prop.noAssign ← FALSE;
VPop[]; VPop[]; VPush[bias, attr, nRegs];
RETURN[RewriteAssign[node, lhsType]]};
Extract:
PUBLIC
PROC[node: Tree.Index]
RETURNS[Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
rType: RecordSEIndex = LOOPHOLE[UnderType[tb[subNode].info]];
prop: Prop ← voidProp;
sei: ISEIndex;
AssignItem: Tree.Map = {
type: Type;
saveType: Type = passPtr.implicitType;
saveBias: INTEGER = passPtr.implicitBias;
saveAttr: Attr = passPtr.implicitAttr;
IF t = Tree.Null THEN v ← Tree.Null
ELSE {
subNode: Tree.Index = GetNode[t];
type ← seb[sei].idType;
passPtr.implicitType ← type;
passPtr.implicitBias ← BiasForType[type]; passPtr.implicitAttr.rep ← RepForType[type];
v ← IF tb[subNode].name = extract THEN Extract[subNode] ELSE Assignment[subNode];
prop ← CommonProp[prop, VProp[]]; VPop[]};
sei ← NextSe[sei];
passPtr.implicitAttr ← saveAttr; 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]; prop ← CommonProp[prop, VProp[]]; VPop[];
VPush[BiasForType[rType], [prop: prop, rep: RepForType[rType]], maxRegs];
RETURN[[subtree[index:node]]]};
New:
PUBLIC
PROC[node: Tree.Index]
RETURNS[Tree.Link] = {
OPEN tb[node];
prop: Prop ← voidProp;
IF son[1] # Tree.Null THEN {son[1] ← Exp[son[1], none]; prop ← VProp[]; VPop[]};
IF OpName[son[2]] = apply
THEN {
subNode: Tree.Index = GetNode[son[2]];
type: Type;
vSei: ISEIndex;
TypeExp[tb[subNode].son[1]]; type ← TypeForTree[tb[subNode].son[1]];
tb[subNode].son[2] ← Rhs[tb[subNode].son[2], dataPtr.idCARDINAL, $init];
prop ← CommonProp[prop, VProp[]]; VPop[];
vSei ← VariantField[UnderType[type]];
IF vSei # Symbols.ISENull
THEN {
vType: CSEIndex = UnderType[seb[vSei].idType];
subType: Type = OperandType[tb[subNode].son[2]];
n:
LONG
CARDINAL =
WITH t: seb[vType]
SELECT
FROM
sequence =>
MIN[
Cardinality[seb[t.tagSei].idType],
MaxCardinality[t.componentType, t.packed, OpWordCount.LAST-WordsForType[type]]]
ENDCASE => 0;
IF EqTypes[subType, dataPtr.typeINT]
OR ~(Cardinality[subType]
IN [1..n])
THEN
-- (0..n]
tb[subNode].son[2] ← CheckRange[tb[subNode].son[2], n, dataPtr.idCARDINAL]}}
ELSE {
TypeExp[son[2], OpName[son[3]] = body];
IF WordsForType[UnderType[TypeForTree[son[2]]]] > OpWordCount.
LAST
THEN
Log.ErrorTree[operandSize, [subtree[node]]]};
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 {
type: Type = TypeForTree[son[2]];
subProp: Prop;
son[3] ← Rhs[son[3], type, $init]; subProp ← VProp[]; VPop[];
IF attr3 THEN son[3] ← Safen[son[3], subProp, $init, type];
prop ← CommonProp[prop, subProp]};
IF nSons > 3 THEN CatchNest[son[4]];
prop.noXfer ← prop.noFreeVar ← FALSE; VPush[0, [prop: prop, rep: unsigned], maxRegs];
RETURN[[subtree[index:node]]]};
ListCons:
PUBLIC
PROC[node: Tree.Index]
RETURNS[val: Tree.Link] = {
OPEN tb[node];
ItemType:
PROC[nType: Type]
RETURNS[Type] =
INLINE {
sei: CSEIndex = UnderType[nType];
RETURN[
WITH r: seb[sei]
SELECT
FROM
record => seb[FirstCtxSe[r.fieldCtx]].idType,
ENDCASE => Symbols.typeANY]
};
cType: Type = ItemType[ReferentType[info]];
prop: Prop ← voidProp;
EvalElement: Tree.Map = {
IF t = Tree.Null THEN v ← Tree.Null
ELSE {
subProp: Prop;
v ← Rhs[t, cType, $init]; subProp ← VProp[]; VPop[];
IF attr3 THEN v ← Safen[v, subProp, $init, cType];
prop ← CommonProp[prop, subProp]};
RETURN};
IF son[1] # Tree.Null THEN {son[1] ← Exp[son[1], none]; prop ← VProp[]; VPop[]};
IF WordsForType[cType] > OpWordCount.
LAST
THEN
Log.ErrorTree[operandSize, [subtree[node]]];
IF ListLength[son[2]] = 0
THEN {
PushTree[Tree.Null]; PushNode[nil, 1]; SetInfo[info];
val ← Exp[PopTree[], RepForType[UnderType[info]]];
FreeNode[node]}
ELSE {
son[2] ← UpdateList[son[2], EvalElement];
prop.noXfer ← prop.noFreeVar ← FALSE; VPush[0, [prop: prop, rep: unsigned], maxRegs];
val ← [subtree[index:node]]};
RETURN};
Narrow:
PUBLIC
PROC[node: Tree.Index]
RETURNS[val: Tree.Link] = {
type: Type = 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];
prop: Prop;
son[1] ← RValue[son[1], 0, RepForType[OperandType[son[1]]]];
prop ← VProp[]; prop.noXfer ← FALSE; VPop[];
IF nSons > 2 THEN CatchNest[son[3]];
val ← [subtree[index: node]];
VPush[BiasForType[type], [prop: prop, rep: RepForType[type]], maxRegs]}
ELSE {
val ← Rhs[tb[node].son[1], type, $init];
tb[node].son[1] ← Tree.Null; FreeNode[node];
IF ~EqTypes[OperandType[val], type] THEN val ← ForceType[val, type]}
TargetRep:
--PUBLIC--
PROC[rep: Repr]
RETURNS[Repr] =
INLINE {
RETURN[--IF rep = both THEN signed ELSE-- rep]};
Rhs:
PUBLIC
PROC[exp: Tree.Link, lhsType: Type, cs: ConsState, voidOK:
BOOL←
FALSE]
RETURNS[val: Tree.Link] = {
lType: CSEIndex = UnderType[lhsType];
rType: CSEIndex = OperandStruct[exp];
lBias: INTEGER = BiasForType[lType];
lRep: Repr = RepForType[lType];
nw: Symbols.WordCount = WordsForType[lType];
rRep: Repr;
WITH exp
SELECT
FROM
subtree => {
node: Tree.Index = index;
val ←
SELECT tb[node].name
FROM
construct => Construct[node, cs],
union => Union[node, cs],
rowcons => RowConstruct[node, cs],
all => All[node, cs],
ENDCASE => RValue[exp, lBias, TargetRep[lRep]]};
ENDCASE => val ← RValue[exp, lBias, TargetRep[lRep]];
rRep ← VRep[];
IF ~Types.Assignable[[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]]
THEN
Log.ErrorType[typeClash, val, [dataPtr.ownSymbols, lhsType]];
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 nw > OpWordCount.LAST THEN Log.ErrorTree[operandSize, val];
IF (lType = dataPtr.typeINT
AND rRep = unsigned)
OR
((rType = dataPtr.typeINT AND rRep = signed) AND lRep = unsigned) THEN
val ← CheckRange[val, CARDINAL[INTEGER.LAST-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];
long =>
IF (lRep=signed
AND rRep=unsigned)
OR (lRep=unsigned
AND rRep=signed)
THEN
val ← CheckRange[val, CARDINAL[INTEGER.LAST]+1, lType];
ENDCASE => NULL;
RETURN};
Cover:
PUBLIC
PROC[lType: Type, lRep: Repr, rType: Type, 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: Type, rep: Repr]
RETURNS[lb, ub:
LONG
INTEGER] = {
sei: CSEIndex = UnderType[type];
WITH t: seb[sei]
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 ← -INTEGER.LAST-1; ub ← INTEGER.LAST};
both => {lb ← 0; ub ← INTEGER.LAST};
ENDCASE => {lb ← 0; ub ← CARDINAL.LAST};
RETURN};
CheckRange:
PUBLIC
PROC[t: Tree.Link, bound:
CARDINAL, type: Type]
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]]; PushTree[t];
PushNode[check,-2]; SetInfo[type]; val ← PopTree[]};
ENDCASE => val ← t;
RETURN};
Bounded:
PROC[t: Tree.Link, bound:
CARDINAL]
RETURNS[
BOOL] =
INLINE {
IF OpName[t] = mod
AND ~GetAttr[t, 3]
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: Type]
RETURNS[Tree.Link] = {
Log.ErrorTree[boundsFault, AdjustBias[t, -BiasForType[type]]];
PushTree[t];
-- PushTree[MakeTreeLiteral[0]]; PushNode[check, 2]; SetInfo[type];
RETURN[PopTree[]]};