-- file Pass4D.mesa
-- last modified by Satterthwaite, June 9, 1983 2:32 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [interface, mainCtx, textIndex, typeCARDINAL],
PrincOps: TYPE USING [GFTIndex, globalbase, localbase],
Log: TYPE USING [Error, ErrorSei, ErrorTree, Warning],
P4: TYPE USING [
Repr, none, signed, unsigned, both, other, OpWordCount, Prop, mark, ownGfi,
currentLevel,
AdjustBias, BitsForType, CheckFields, ConstantInterval, EmptyInterval,
ForceType, Interval, LayoutArgs, LayoutFields, MakeEPLink,
RewriteAssign, Rhs, StructuredLiteral, TreeLiteral, TreeLiteralValue,
VPop, VProp, VRep],
Symbols: TYPE USING [
Base, ExtensionType, Type, ISEIndex, CSEIndex, RecordSEIndex,
CTXIndex, CBTIndex, BitAddress, BitCount, TypeClass, WordCount,
WordLength, nullType, ISENull, CSENull, RecordSENull, CBTNull,
codeANY, codeCHAR, codeINT, lG, lZ, RootBti,
typeANY, typeTYPE, seType, ctxType, bodyType],
SymbolOps: TYPE USING [
ArgRecord, BitsPerElement, Cardinality, ConstantId, CtxEntries, EnterExtension,
FindExtension, FirstCtxSe, LinkMode, NextSe, NormalType, RCType,
SearchContext, TypeLink, UnderType, WordsForType],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Scan, Null, treeType],
TreeOps: TYPE USING [
CopyTree, FreeNode, FreeTree, GetNode, IdentityMap, ListHead, ListLength,
NthSon, OpName, PopTree, PushList, PushNode, PushTree,
ScanList, SetAttr, SetInfo, UpdateList];
Pass4D: PROGRAM
IMPORTS
Log, P4, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS P4 = {
OPEN TreeOps, SymbolOps, Symbols;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ctxb: Symbols.Base; -- context table base address (local copy)
bb: Symbols.Base; -- body table base address (local copy)
DeclNotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType]};
VarInit: PUBLIC SIGNAL RETURNS [BOOL] = CODE;
ownGfi: PrincOps.GFTIndex = P4.ownGfi;
ItemId: PROC [t: Tree.Link] RETURNS [ISEIndex] = {
RETURN [WITH t SELECT FROM
symbol => index,
subtree => ItemId[tb[index].son[1]],
ENDCASE => ERROR]};
FirstId: PROC [node: Tree.Index] RETURNS [ISEIndex] = {
RETURN [ItemId[ListHead[tb[node].son[1]]]]};
DeclItem: PUBLIC PROC [item: Tree.Link] = {
node: Tree.Index = GetNode[item];
initFlag, eqFlag: BOOL;
ExpInit: PROC = INLINE {
OPEN tb[node];
type: CSEIndex = UnderType[TypeForDecl[node]];
class: TypeClass = seb[NormalType[type]].typeTag;
son[3] ← P4.Rhs[son[3], type, $init];
IF eqFlag THEN {
t: Tree.Link ← son[3];
prop: P4.Prop = P4.VProp[];
WHILE OpName[t] = cast DO t ← NthSon[t, 1] ENDLOOP;
IF P4.TreeLiteral[t] THEN {
DefineSEValue[ids:son[1], value:P4.TreeLiteralValue[t]]; GO TO defined};
IF prop.noFreeVar AND prop.noXfer AND class # $transfer THEN {
DefineSEValue[ids:son[1]];
AugmentSEValue[son[1], value, son[3]]; son[3] ← Tree.Null; GO TO defined};
IF class = $transfer THEN
WITH t SELECT FROM
symbol => {
sei: ISEIndex = index;
IF seb[sei].constant THEN {
DefineSEValue[ids:son[1], value:seb[sei].idValue, info:seb[sei].idInfo];
IF seb[sei].extended THEN
AugmentSEValue[son[1], form, FindExtension[sei].tree, TRUE];
GO TO defined}};
ENDCASE;
DefineSEVar[ids:son[1]];
EXITS
defined => son[3] ← FreeTree[son[3]]};
SELECT class FROM
$ref, $arraydesc, $relative =>
IF ListLength[son[1]] # 1 AND son[3] # Tree.Null
AND ~P4.StructuredLiteral[son[3]] THEN
Log.Warning[pointerInit];
ENDCASE;
P4.VPop[]};
BodyInit: PROC = INLINE {
expNode: Tree.Index = GetNode[tb[node].son[3]];
bti: CBTIndex = tb[expNode].info;
IF eqFlag THEN {
IF tb[expNode].attr3 THEN { -- inline
DefineSEValue[ids:tb[node].son[1], info:bti];
AugmentSEValue[tb[node].son[1], form,
IF dataPtr.interface THEN TrimTree[tb[node].son[3]] ELSE Tree.Null]}
ELSE DefineSEValue[
ids: tb[node].son[1],
value: P4.MakeEPLink[bb[bti].entryIndex, ownGfi], info: bti];
tb[node].son[3] ← Tree.Null}
ELSE {PushNode[body, 0]; SetInfo[bti]; tb[node].son[3] ← PopTree[]}};
saveIndex: CARDINAL = dataPtr.textIndex;
IF tb[node].attr3 = P4.mark THEN RETURN; -- already processed
tb[node].attr3 ← P4.mark;
dataPtr.textIndex ← tb[node].info;
initFlag ← (tb[node].son[3] # Tree.Null);
IF tb[node].name = typedecl THEN {
ENABLE VarInit => {RESUME [FALSE]};
TypeExp[tb[node].son[2]]; CheckDefaults[item]}
ELSE {
OPEN tb[node];
op: Tree.NodeName = OpName[son[3]];
IF son[2] # Tree.Null THEN TypeExp[son[2], op = body];
IF initFlag THEN {
eqFlag ← attr1;
SELECT op FROM
body, procinit => BodyInit[];
signalinit =>
IF eqFlag THEN {
expNode: Tree.Index = GetNode[son[3]];
DefineSEValue[son[1], P4.MakeEPLink[tb[expNode].info, ownGfi], RootBti];
son[3] ← FreeTree[son[3]]};
inline => {
expNode: Tree.Index = GetNode[son[3]];
tb[expNode].son[1] ← UpdateList[tb[expNode].son[1], InlineOp];
DefineSEValue[ids:son[1]];
AugmentSEValue[son[1], value, son[3]]; son[3] ← Tree.Null};
ENDCASE => ExpInit[]}};
MarkAndCheckSE[tb[node].son[1], initFlag];
dataPtr.textIndex ← saveIndex};
TypeForDecl: PROC [node: Tree.Index] RETURNS [Type] = {
RETURN [IF tb[node].son[2] # Tree.Null
THEN TypeForTree[tb[node].son[2]]
ELSE seb[FirstId[node]].idType]};
ConstInit: PROC [t: Tree.Link] RETURNS [BOOL] = {
RETURN [IF OpName[t] # all
THEN P4.StructuredLiteral[t]
ELSE ConstInit[NthSon[t, 1]]]};
InlineByte: Tree.Map = {
v ← P4.Rhs[t, dataPtr.typeCARDINAL]; P4.VPop[];
IF ~P4.TreeLiteral[v] THEN Log.ErrorTree[nonConstant, v];
RETURN};
InlineOp: Tree.Map = {RETURN [UpdateList[t, InlineByte]]};
DefineSEVar: PROC [ids: Tree.Link] = {
UpdateSE: Tree.Scan = {
sei: ISEIndex = ItemId[t];
seb[sei].constant ← FALSE};
ScanList[ids, UpdateSE]};
DefineSEValue: PROC [ids: Tree.Link, value: UNSPECIFIED←0, info: CBTIndex←CBTNull] = {
UpdateSE: Tree.Scan = {
sei: ISEIndex = ItemId[t];
seb[sei].constant ← TRUE;
seb[sei].idValue ← value; seb[sei].idInfo ← info};
ScanList[ids, UpdateSE]};
AugmentSEValue: PROC [
ids: Tree.Link,
type: ExtensionType, extension: Tree.Link,
copy: BOOL←FALSE] = {
UpdateSE: Tree.Scan = {
sei: ISEIndex = ItemId[t];
EnterExtension[sei, type, IF copy THEN IdentityMap[extension] ELSE extension];
copy ← TRUE};
ScanList[ids, UpdateSE]};
MarkAndCheckSE: PROC [ids: Tree.Link, initialized: BOOL] = {
UpdateSE: Tree.Scan = {
sei: ISEIndex = ItemId[t];
seb[sei].mark4 ← TRUE;
IF dataPtr.interface THEN CheckDefinition[sei, initialized];
IF seb[sei].idType = typeTYPE AND ctxb[seb[sei].idCtx].level # lZ THEN
seb[sei].idValue ← sei - ISEIndex.FIRST};
ScanList[ids, UpdateSE]};
CheckDefinition: PROC [sei: ISEIndex, initialized: BOOL] = {
SELECT seb[sei].idCtx FROM
dataPtr.mainCtx =>
SELECT LinkMode[sei] FROM
val => IF ~initialized OR seb[sei].extended THEN RETURN;
ref => IF ~initialized THEN RETURN;
manifest, type => IF ConstantId[sei] THEN RETURN;
ENDCASE;
ENDCASE => RETURN;
Log.ErrorSei[nonDefinition, sei]};
CheckDefaults: PROC [t: Tree.Link] = {
TestDefaults: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: CARDINAL = dataPtr.textIndex;
sei: ISEIndex = FirstId[node];
dataPtr.textIndex ← tb[node].info;
IF seb[sei].extended THEN {
type: CSEIndex =
UnderType[IF seb[sei].idType = typeTYPE THEN sei ELSE seb[sei].idType];
nType: CSEIndex = NormalType[type];
TestDefault: Tree.Map = {
IF OpName[t] = void THEN v ← t
ELSE {
v ← P4.AdjustBias[P4.Rhs[t, type, $init], -BiasForType[type]];
IF P4.TreeLiteral[v] AND (
WITH n: seb[nType] SELECT FROM
basic => n.code # codeINT OR P4.VRep[] = P4.signed,
ENDCASE => TRUE) THEN
v ← P4.ForceType[v, type];
IF ~(P4.VProp[].noFreeVar OR (SIGNAL VarInit[])) THEN
Log.ErrorTree[nonConstant, v];
P4.VPop[]};
RETURN};
t: Tree.Link ← FindExtension[sei].tree;
v: Tree.Link ← UpdateList[IdentityMap[t], TestDefault];
IF t.tag # symbol AND P4.StructuredLiteral[v] THEN
UpdateDefaults[tb[node].son[1], v]
ELSE v ← FreeTree[v]};
dataPtr.textIndex ← saveIndex};
IF dataPtr.interface THEN ScanList[t, TestDefaults]};
UpdateDefaults: PROC [ids: Tree.Link, v: Tree.Link] = {
copy: BOOL ← FALSE;
UpdateDefault: Tree.Scan = {
sei: ISEIndex = ItemId[t];
old: Tree.Link ← FindExtension[sei].tree;
EnterExtension[sei, default, IF copy THEN IdentityMap[v] ELSE v];
copy ← TRUE;
[] ← FreeTree[old]};
ScanList[ids, UpdateDefault]};
TrimTree: Tree.Map = {
WITH t SELECT FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
body => {
OPEN tb[node];
PushTree[TrimTree[son[1]]];
PushTrimDecls[son[2]];
PushTree[TrimTree[son[3]]]; PushTree[TrimTree[son[4]]];
PushNode[body, 4]; SetInfo[info];
SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, attr3];
v ← PopTree[]};
block => {
OPEN tb[node];
PushTrimDecls[son[1]]; PushTree[TrimTree[son[2]]];
PushNode[block, 2]; SetInfo[info];
SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, attr3];
v ← PopTree[]};
cdot => v ← TrimTree[tb[node].son[2]];
ENDCASE => v ← CopyTree[[@tb, t], TrimTree]};
ENDCASE => v ← t;
RETURN};
PushTrimDecls: PROC [t: Tree.Link] = {
IF OpName[t] = initlist THEN {
node: Tree.Index = GetNode[t];
PushTree[TrimTree[tb[node].son[1]]]; PushTrimDecls[tb[node].son[2]];
PushNode[initlist, 2]; SetInfo[tb[node].info]}
ELSE {
n: CARDINAL ← 0;
PushDecl: Tree.Scan = {
node: Tree.Index = GetNode[t];
SELECT tb[node].name FROM
typedecl => NULL;
decl =>
IF tb[node].son[3] # Tree.Null THEN {
OPEN tb[node];
PushTree[TrimTree[son[1]]]; PushTree[Tree.Null];
PushTree[TrimTree[son[3]]];
PushNode[decl, 3]; SetInfo[info];
SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, ~P4.mark];
n ← n+1};
ENDCASE => ERROR};
ScanList[t, PushDecl]; PushList[n]}};
DeclUpdate: PUBLIC PROC [item: Tree.Link] RETURNS [update: Tree.Link] = {
node: Tree.Index = GetNode[item];
IF tb[node].name = typedecl OR tb[node].son[3] = Tree.Null THEN
update ← Tree.Null
ELSE {
OPEN tb[node];
type: CSEIndex = UnderType[TypeForDecl[node]];
rewrite: BOOL = SELECT OpName[tb[node].son[3]] FROM
body, signalinit => FALSE,
ENDCASE => TRUE;
n: CARDINAL = ListLength[tb[node].son[1]];
ScanList[tb[node].son[1], PushTree];
PushTree[tb[node].son[3]];
FOR i: CARDINAL IN [1 .. n] DO
IF i = n THEN PushNode[assign, 2]
ELSE {PushNode[assignx, 2]; SetInfo[type]};
SetInitAttr[type, ConstInit[tb[node].son[3]]];
IF rewrite THEN PushTree[P4.RewriteAssign[GetNode[PopTree[]], type]];
ENDLOOP;
SetInfo[info]; update ← PopTree[]; tb[node].son[3] ← Tree.Null};
FreeNode[node];
RETURN};
SetInitAttr: PROC [type: CSEIndex, const: BOOL] = {
SetAttr[1, TRUE];
IF P4.currentLevel = lG AND ~const THEN
SELECT RCType[type] FROM
simple => {SetAttr[2, TRUE]; SetAttr[3, FALSE]};
composite => {SetAttr[2, TRUE]; SetAttr[3, TRUE]};
ENDCASE => SetAttr[2, FALSE]
ELSE SetAttr[2, FALSE]};
TypeExp: PUBLIC PROC [typeExp: Tree.Link, body, indirect: BOOL ← FALSE] = {
-- body => arg records subsumed by frame
WITH typeExp SELECT FROM
symbol =>
IF ~indirect THEN {
iSei: ISEIndex = index;
IF ~seb[iSei].mark4 THEN DeclItem[[subtree[index: seb[iSei].idValue]]]};
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
discrimTC => TypeExp[tb[node].son[1], FALSE, indirect];
cdot => TypeExp[tb[node].son[2], body, indirect];
implicitTC, linkTC => NULL;
frameTC => NULL;
ENDCASE => {
OPEN tb[node];
sei: CSEIndex = info;
IF ~seb[sei].mark4 THEN
WITH type: seb[sei] SELECT FROM
enumerated =>
IF type.machineDep THEN
[nValues:type.nValues, sparse:type.sparse] ←
LayoutEnum[son[1], type.valueCtx];
record => {
ENABLE VarInit => {RESUME [FALSE]};
ScanList[son[1], DeclItem];
IF attr1 THEN ScanList[son[1], AssignPositions];
WITH type SELECT FROM
notLinked =>
IF attr1 THEN P4.CheckFields[LOOPHOLE[sei, RecordSEIndex], 0]
ELSE P4.LayoutFields[LOOPHOLE[sei, RecordSEIndex], 0];
ENDCASE;
ExtractFieldAttributes[LOOPHOLE[sei, RecordSEIndex]];
CheckDefaults[son[1]]};
ref => {
IF type.var AND FALSE THEN Log.Error[unimplemented];
TypeExp[son[1], FALSE, TRUE]};
array => {
maxArraySize: WordCount = BitCount.LAST/WordLength;
IF son[1] # Tree.Null THEN TypeExp[son[1]];
TypeExp[son[2], FALSE, indirect];
IF Cardinality[type.indexType] >
MaxCardinality[type.componentType, type.packed, maxArraySize] THEN
Log.Error[addressOverflow]};
arraydesc => TypeExp[son[1], FALSE, TRUE];
transfer => {
origin, newOrigin: CARDINAL;
rSei: RecordSEIndex;
origin ← SELECT type.mode FROM
program => PrincOps.globalbase,
signal, error => PrincOps.localbase+1,
proc => PrincOps.localbase,
ENDCASE => 0;
IF OpName[son[1]] # anyTC THEN {
ScanList[son[1], DeclItem]; CheckDefaults[son[1]]};
rSei ← ArgRecord[type.typeIn];
IF rSei # RecordSENull THEN {
seb[rSei].hints.comparable ← TRUE; -- for now
newOrigin ← P4.LayoutArgs[rSei, origin, body];
seb[rSei].length ← (newOrigin - origin)*WordLength;
seb[rSei].mark4 ← TRUE;
origin ← newOrigin};
IF OpName[son[2]] # anyTC THEN {
ScanList[son[2], DeclItem]; CheckDefaults[son[2]]};
rSei ← ArgRecord[type.typeOut];
IF rSei # RecordSENull THEN {
seb[rSei].hints.comparable ← TRUE; -- for now
seb[rSei].length ← (P4.LayoutArgs[rSei, origin, body]-origin)*WordLength;
seb[rSei].mark4 ← TRUE}};
definition => NULL;
union => {
DeclItem[son[1]];
IF attr1 AND type.controlled THEN AssignPositions[son[1]];
ProcessVariants[UnderType[seb[type.tagSei].idType], son[2]]};
sequence => {
DeclItem[son[1]];
IF attr1 AND type.controlled THEN AssignPositions[son[1]];
TypeExp[son[2], FALSE, indirect]};
relative => {TypeExp[son[1], FALSE, TRUE]; TypeExp[son[2], FALSE, TRUE]};
opaque =>
IF son[1] # Tree.Null THEN {
son[1] ← P4.Rhs[son[1], dataPtr.typeCARDINAL]; P4.VPop[];
IF P4.TreeLiteral[son[1]] THEN
type.length ← P4.TreeLiteralValue[son[1]]*WordLength};
zone => NULL;
subrange => {
subNode: Tree.Index;
tSei: CSEIndex = UnderType[type.rangeType];
TypeExp[son[1], FALSE, indirect];
subNode ← GetNode[son[2]];
IF P4.Interval[subNode, 0, P4.both] THEN
[type.origin, type.range] ← P4.ConstantInterval[subNode
! P4.EmptyInterval => {type.empty ← TRUE; RESUME}]
ELSE type.origin ← type.range ← 0;
type.filled ← TRUE;
SELECT P4.VRep[] FROM
P4.none => Log.ErrorTree[mixedRepresentation, son[2]];
P4.unsigned => IF type.origin < 0 THEN Log.Error[subrangeNesting];
ENDCASE;
P4.VPop[];
WITH cover: seb[tSei] SELECT FROM
subrange => -- incomplete test
IF type.origin < cover.origin
OR (~type.empty AND type.range > cover.range) THEN
Log.Error[subrangeNesting];
ENDCASE => NULL;
son[2] ← FreeTree[son[2]]};
long => TypeExp[son[1], FALSE, indirect];
any => NULL;
ENDCASE => ERROR;
seb[sei].mark4 ← TRUE}};
ENDCASE => ERROR};
-- machine dependent representations
MaxCardinality: PUBLIC PROC [type: Type, packed: BOOL, maxSize: WordCount]
RETURNS [LONG CARDINAL] = {
maxBits: BitCount =
(IF maxSize > BitCount.LAST/WordLength THEN BitCount.LAST ELSE maxSize*WordLength);
eSize: BitCount = BitsPerElement[type, packed];
RETURN [maxBits/(IF eSize # 0 THEN eSize ELSE 1)]};
EvalUnsigned: PROC [t: Tree.Link, default: CARDINAL]
RETURNS [v: Tree.Link, n: CARDINAL] = {
v ← P4.Rhs[t, dataPtr.typeCARDINAL]; P4.VPop[];
IF P4.TreeLiteral[v] THEN n ← P4.TreeLiteralValue[v]
ELSE {Log.ErrorTree[nonConstant, v]; n ← default};
RETURN};
LayoutEnum: PROC [t: Tree.Link, ctx: CTXIndex]
RETURNS [sparse: BOOL, nValues: CARDINAL] = {
sei: ISEIndex;
started: BOOL;
last: CARDINAL;
AssignElement: Tree.Scan = {
val: CARDINAL;
WITH t SELECT FROM
subtree => {
node: Tree.Index = index;
[tb[node].son[2], val] ←
EvalUnsigned[tb[node].son[2], IF started THEN last+1 ELSE 0]};
ENDCASE => val ← IF started THEN last+1 ELSE 0;
IF ~started THEN {sparse ← (val#0); started ← TRUE}
ELSE {
IF val <= last THEN Log.ErrorSei[enumOrder, sei];
IF val # last+1 THEN sparse ← TRUE};
last ← seb[sei].idValue ← val; sei ← NextSe[sei]};
started ← sparse ← FALSE; sei ← FirstCtxSe[ctx];
ScanList[t, AssignElement];
nValues ← IF ~started THEN 0 ELSE last+1; RETURN};
AssignPositions: PROC [item: Tree.Link] = {
node: Tree.Index = GetNode[item];
saveIndex: CARDINAL = dataPtr.textIndex;
type: Type = TypeForTree[tb[node].son[2]];
nB, nW: CARDINAL;
AssignPosition: Tree.Scan = {
wd, bL, bR: CARDINAL;
dB: CARDINAL = IF nB=0 THEN 0 ELSE nB-1;
sei: ISEIndex = ItemId[t];
node: Tree.Index = GetNode[NthSon[t, 2]];
[tb[node].son[1], wd] ← EvalUnsigned[tb[node].son[1], 0];
IF tb[node].son[2] = Tree.Null THEN {
bL ← 0; bR ← IF nB = 0 THEN 0 ELSE nW*WordLength - 1}
ELSE {
subNode: Tree.Index = GetNode[tb[node].son[2]];
[tb[subNode].son[1], bL] ← EvalUnsigned[tb[subNode].son[1], 0];
[tb[subNode].son[2], bR] ← EvalUnsigned[tb[subNode].son[2], dB]};
wd ← wd + bL/WordLength;
IF bR >= bL THEN bR ← bR - (bL/WordLength)*WordLength;
bL ← bL MOD WordLength;
IF (SELECT TRUE FROM
(nB = 0) => bR < bL,
(nB >= WordLength) => bL # 0 OR bR # bL + dB,
ENDCASE => bR > WordLength OR bR < bL + dB) THEN {
Log.ErrorSei[fieldPosition, sei]; bR ← bL + dB};
seb[sei].idValue ← BitAddress[wd:wd, bd:bL];
seb[sei].idInfo ← IF nB=0 AND tb[node].son[2] = Tree.Null THEN 0 ELSE bR-bL + 1};
dataPtr.textIndex ← tb[node].info;
nB ← P4.BitsForType[type]; nW ← (nB+(WordLength-1))/WordLength;
ScanList[tb[node].son[1], AssignPosition];
dataPtr.textIndex ← saveIndex};
ExtractFieldAttributes: PROC [rType: RecordSEIndex] = {
-- compatibility version
type: CSEIndex;
comparable, privateFields: BOOL;
comparable ← TRUE; privateFields ← FALSE;
FOR sei: ISEIndex ← FirstCtxSe[seb[rType].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
IF ~seb[sei].public THEN privateFields ← TRUE;
type ← UnderType[seb[sei].idType];
WITH t: seb[type] SELECT FROM
record =>
IF ~t.hints.comparable AND ~ComparableType[type] THEN comparable ← FALSE;
array => IF ~ComparableType[type] THEN comparable ← FALSE;
union => IF ~t.hints.equalLengths THEN comparable ← FALSE;
sequence => comparable ← FALSE;
ENDCASE;
ENDLOOP;
seb[rType].hints.comparable ← comparable;
seb[rType].hints.privateFields ← privateFields};
ProcessVariants: PROC [tagType: CSEIndex, list: Tree.Link] = {
lb, ub: CARDINAL;
MapTag: PROC [vSei: ISEIndex] RETURNS [CARDINAL] = {
WITH t: seb[tagType] SELECT FROM
enumerated =>
IF t.machineDep THEN {
sei: ISEIndex = SearchContext[seb[vSei].hash, t.valueCtx];
IF sei # ISENull THEN RETURN [seb[sei].idValue]};
ENDCASE;
RETURN [seb[vSei].idValue]};
CheckTag: Tree.Scan = {
sei: ISEIndex = ItemId[t];
tag: CARDINAL = MapTag[sei];
IF tag NOT IN [lb .. ub) THEN Log.ErrorSei[boundsFault, sei];
seb[sei].idValue ← tag - lb};
ProcessVariant: Tree.Scan = {
saveIndex: CARDINAL = dataPtr.textIndex;
node: Tree.Index = GetNode[t];
dataPtr.textIndex ← tb[node].info;
ScanList[tb[node].son[1], CheckTag];
DeclItem[t];
dataPtr.textIndex ← saveIndex};
lb ← BiasForType[tagType]; ub ← lb + CARDINAL[Cardinality[tagType]];
ScanList[list, ProcessVariant]};
TypeForTree: PUBLIC PROC [t: Tree.Link] RETURNS [Type] = {
RETURN [WITH t SELECT FROM
symbol => index,
subtree => tb[index].info,
ENDCASE => typeANY]};
CanonicalType: PUBLIC PROC [type: CSEIndex] RETURNS [CSEIndex] = {
RETURN [WITH t: seb[type] SELECT FROM
subrange => CanonicalType[UnderType[t.rangeType]],
record =>
IF t.hints.unifield AND CtxEntries[t.fieldCtx] = 1
THEN CanonicalType[UnderType[seb[ctxb[t.fieldCtx].seList].idType]]
ELSE type,
ENDCASE => type]};
BiasForType: PUBLIC PROC [type: CSEIndex] RETURNS [INTEGER] = {
RETURN [IF type = CSENull
THEN 0
ELSE
WITH t: seb[type] SELECT FROM
subrange => t.origin,
record =>
IF t.hints.unifield AND CtxEntries[t.fieldCtx] = 1
THEN BiasForType[UnderType[seb[ctxb[t.fieldCtx].seList].idType]]
ELSE 0,
ENDCASE => 0]};
RepForType: PUBLIC PROC [type: CSEIndex] RETURNS [P4.Repr] = {
RETURN [IF type = CSENull
THEN P4.none
ELSE
WITH t: seb[type] SELECT FROM
basic =>
SELECT t.code FROM
codeANY => P4.both + P4.other,
codeINT => P4.signed,
codeCHAR => P4.both,
ENDCASE => P4.other,
enumerated => P4.both,
ref => P4.unsigned,
record =>
IF t.hints.unifield AND CtxEntries[t.fieldCtx] = 1
THEN RepForType[UnderType[seb[ctxb[t.fieldCtx].seList].idType]]
ELSE P4.other,
relative => RepForType[UnderType[t.offsetType]],
subrange =>
IF t.origin >= 0
THEN (IF CARDINAL[t.origin] + t.range > 77777b THEN P4.unsigned ELSE P4.both)
ELSE (IF t.range <= 77777b THEN P4.signed ELSE P4.none),
long => RepForType[UnderType[t.rangeType]],
opaque => IF t.lengthKnown THEN P4.both + P4.other ELSE P4.none,
ENDCASE => P4.other]};
SparseRep: PUBLIC PROC [type: CSEIndex] RETURNS [BOOL] = {
nType: CSEIndex = NormalType[type];
RETURN [WITH seb[nType] SELECT FROM
enumerated => sparse,
ENDCASE => FALSE]};
WordsForType: PUBLIC PROC [type: CSEIndex] RETURNS [WordCount] = {
RETURN [IF ~seb[type].mark4
THEN (P4.BitsForType[type]+(WordLength-1))/WordLength
ELSE SymbolOps.WordsForType[type]]};
ComparableType: PUBLIC PROC [type: CSEIndex] RETURNS [BOOL] = {
-- compatibility version
RETURN [WITH t: seb[type] SELECT FROM
record => t.hints.comparable OR t.argument, -- for now
array => ~SparseRep[UnderType[t.indexType]]
AND ComparableType[UnderType[t.componentType]]
AND WordsForType[type] <= P4.OpWordCount.LAST,
opaque => t.lengthKnown,
any => FALSE,
ENDCASE => TRUE]};
DefaultBasicOps: PUBLIC PROC [type: Type, size: BitCount] RETURNS [BOOL] = {
uType: CSEIndex = UnderType[type];
next: Type;
FOR s: Type ← type, next DO
WITH se: seb[s] SELECT FROM
id => {
sei: ISEIndex = LOOPHOLE[s];
IF seb[sei].extended THEN {
IF OpName[FindExtension[sei].tree] # void THEN RETURN [FALSE] ELSE EXIT};
next ← seb[sei].idInfo};
cons =>
WITH t: se SELECT FROM
ref => IF t.counted THEN RETURN [FALSE] ELSE EXIT;
array => next ← t.componentType;
record => IF t.hints.default THEN RETURN [FALSE] ELSE EXIT;
transfer => IF t.mode = port THEN RETURN [FALSE] ELSE EXIT;
long => next ← t.rangeType;
zone => IF t.counted THEN RETURN [FALSE] ELSE EXIT;
ENDCASE => EXIT;
ENDCASE;
ENDLOOP;
RETURN [WordsForType[uType]*WordLength = size
AND ComparableType[uType] AND TypeLink[uType] = nullType]};
}.