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𡤀, info: CBTIndex�TNull] = {
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]};
}.