-- file Pass3I.mesa
-- last modified by Satterthwaite, September 10, 1982 11:32 am
-- last modified by Donahue, 8-Dec-81 15:29:30
DIRECTORY
Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
ComData: TYPE USING [
definitionsOnly, moduleCtx, seAnon, switches, table, textIndex, typeAtomRecord],
Copier: TYPE USING [CompleteContext, Delink, SearchFileCtx],
Log: TYPE USING [Error, ErrorHti, ErrorSei, ErrorTree, WarningSei],
P3: TYPE USING [
Attr, FullAttr, VoidAttr, Mark, MergeNP, phraseNP,
And, Exp, FirstId, InterfaceCtx, LongPath, MakeRefType, MarkedType,
OperandType, ResolveType, ResolveValue, RPop, RPush, RType, SetDefaultImport,
TypeForTree, VariantUnionType, VoidExp],
P3S: TYPE USING [currentBody, currentScope, safety],
Symbols: TYPE USING [
seType, ctxType, mdType,
Base, CTXRecord, ExtensionType,
MDIndex, HTIndex, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
CTXIndex, IncludedCTXIndex, Closure,
HTNull, SENull, ISENull, RecordSENull, CTXNull, IncludedCTXNull,
lG, lZ, StandardContext, typeTYPE, typeANY],
SymbolOps: TYPE USING [
ArgCtx, ConstantId, EnterExtension, FindExtension, FirstCtxSe, LinkMode,
NextSe, NormalType, RCType, RecordRoot, ReferentType, SearchContext, SetSeLink,
TypeLink, TypeRoot, UnderType],
SymLiteralOps: TYPE USING [EnterAtom, EnterType],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Test, Null, NullIndex, treeType],
TreeOps: TYPE USING [
CopyTree, FreeTree, GetHash, GetNode, GetSe, ListLength, NthSon, OpName,
PopTree, PushTree, PushNode, ScanList, ScanSons, SearchList,
SetAttr, SetInfo, SetShared, UpdateList, UpdateLeaves];
Pass3I: PROGRAM
IMPORTS
Alloc, Copier, Log, P3, P3S, SymLiteralOps, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS P3 = {
OPEN SymbolOps, P3, Symbols, TreeOps;
-- uninitialized variable processing
RefItem: TYPE = RECORD [kind: {seal, rhs, lhs}, sei: ISEIndex];
RefSeal: RefItem = [kind:seal, sei:ISENull];
RefSequence: TYPE = RECORD [SEQUENCE length: CARDINAL OF RefItem];
RefStack: TYPE = LONG POINTER TO RefSequence;
refStack: RefStack;
refIndex: CARDINAL;
AdjustRefStack: PROC [n: CARDINAL] = {
oldStack: RefStack ← refStack;
refStack ← zone.NEW[RefSequence[n]];
FOR i: CARDINAL IN [0..refIndex) DO refStack[i] ← oldStack[i] ENDLOOP;
zone.FREE[@oldStack]};
RecordMention: PUBLIC PROC [sei: ISEIndex] = {
IF dataPtr.switches['u] AND (seb[sei].idInfo = 0 AND ~seb[sei].mark4) THEN {
IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
refStack[refIndex] ← [kind:rhs, sei:sei];
refIndex ← refIndex + 1}
ELSE BumpCount[sei]};
RecordLhs: PUBLIC PROC [sei: ISEIndex] = {
key: RefItem;
IF dataPtr.switches['u] AND (seb[sei].idInfo = 0 AND ~seb[sei].mark4) THEN {
key ← [kind:rhs, sei:sei];
FOR i: CARDINAL DECREASING IN [0..refIndex) DO
SELECT refStack[i] FROM
key => {refStack[i].kind ← lhs; EXIT};
RefSeal => EXIT;
ENDCASE;
ENDLOOP}};
SealRefStack: PUBLIC PROC = {
IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
refStack[refIndex] ← RefSeal; refIndex ← refIndex + 1};
UnsealRefStack: PUBLIC PROC = {
ClearRefStack[]; refIndex ← refIndex - 1;
IF refStack[refIndex] # RefSeal THEN ERROR};
ClearRefStack: PUBLIC PROC = {
sei: ISEIndex;
FOR i: CARDINAL DECREASING IN [0..refIndex) UNTIL refStack[i] = RefSeal DO
sei ← refStack[i].sei;
IF refStack[i].kind = rhs
AND ~ConstantInit[sei]
AND (~dataPtr.definitionsOnly OR ctxb[seb[sei].idCtx].level # lG) THEN
Log.WarningSei[uninitialized, sei];
BumpCount[sei];
refIndex ← refIndex - 1;
ENDLOOP;
IF refStack.length > 16 AND refIndex <= 16 THEN AdjustRefStack[16]};
ConstantInit: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = {
node: Tree.Index;
IF seb[sei].constant THEN RETURN [TRUE];
node ← seb[sei].idValue;
RETURN [seb[sei].immutable
AND node # Tree.NullIndex AND OpName[tb[node].son[3]] = body]};
-- tables defining the current symbol table
tb: Tree.Base; -- tree base
seb: Symbols.Base; -- se table
ctxb: Symbols.Base; -- context table
mdb: Symbols.Base; -- module directory base
IdNotify: Alloc.Notifier = {
-- called whenever the main symbol table is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]};
zone: UNCOUNTED ZONE ← NIL;
-- type table management
EnterType: PUBLIC PROC [type: SEIndex, canonical: BOOLEAN←TRUE] = {
SymLiteralOps.EnterType[type, canonical];
CompleteRCType[type]};
CompleteRCType: PROC [type: SEIndex] = {
subType: CSEIndex = UnderType[TypeRoot[type]];
IF RCType[subType] # none THEN {
WITH t: seb[subType] SELECT FROM
record => CompleteRecord[LOOPHOLE[subType], rc];
array => CompleteRCType[t.componentType];
union, sequence => Log.Error[unimplemented];
ENDCASE => NULL}};
EnterComposite: PUBLIC PROC [type: CSEIndex, t: Tree.Link, init: BOOLEAN] = {
SELECT OpName[t] FROM
loophole, cast, safen, pad => {
t1: Tree.Link = NthSon[t, 1];
EnterComposite[OperandType[t1], t1, init];
IF RCType[type] = composite THEN EnterType[type, TRUE]};
construct =>
IF RCType[type] = composite THEN {
node: Tree.Index = GetNode[t];
EnterFieldTypes[RecordRoot[tb[node].info], tb[node].son[2], init];
IF ~init THEN EnterType[type, TRUE]}; -- in case constant-folded
union => {
node: Tree.Index = GetNode[t];
EnterFieldTypes[LOOPHOLE[UnderType[GetSe[tb[node].son[1]]]], tb[node].son[2], init]};
rowcons => {
node: Tree.Index = GetNode[t];
aSei: ArraySEIndex = tb[node].info;
cSei: CSEIndex = UnderType[seb[aSei].componentType];
EnterElement: Tree.Scan = {EnterComposite[cSei, t, init]};
IF RCType[cSei] # none THEN {
ScanList[tb[node].son[2], EnterElement];
IF ~init THEN EnterType[type, TRUE]}};
all => {
node: Tree.Index = GetNode[t];
aSei: ArraySEIndex = tb[node].info;
cSei: CSEIndex = UnderType[seb[aSei].componentType];
IF RCType[cSei] # none THEN {
EnterComposite[cSei, NthSon[t, 1], FALSE];
IF ~init THEN EnterType[type, TRUE]}};
ENDCASE =>
SELECT seb[type].typeTag FROM
union => Log.ErrorTree[unimplemented, t];
sequence => IF t # Tree.Null THEN Log.ErrorTree[unimplemented, t];
ENDCASE => IF RCType[type] = composite THEN EnterType[type, TRUE]};
EnterFieldTypes: PROC [rSei: RecordSEIndex, t: Tree.Link, init: BOOLEAN] = {
sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx];
EnterField: Tree.Scan = {
IF sei # ISENull THEN EnterComposite[UnderType[seb[sei].idType], t, init];
sei ← NextSe[sei]};
ScanList[t, EnterField]};
EnterMarkedType: PROC [type: SEIndex] = INLINE {
EnterType[MarkedType[UnderType[type]]]};
EnterDiscriminator: PROC [t: Tree.Link] = INLINE { -- guarantee that union is copied
[] ← VariantUnionType[OpenedType[OperandType[t]]]};
EnterTags: PROC [type: SEIndex] = INLINE {
subType: CSEIndex ← OpenedType[UnderType[type]];
DO
next: CSEIndex ← UnderType[TypeLink[subType]];
IF next = SENull THEN EXIT;
[] ← VariantUnionType[next]; -- guarantee that union is copied
subType ← next;
ENDLOOP};
-- identifier look-up
Id: PUBLIC PROC [hti: HTIndex] RETURNS [val: Tree.Link] = {
sei: ISEIndex;
type: CSEIndex;
ctx: CTXIndex;
baseV: Tree.Link;
attr: Attr ← VoidAttr;
indirect: BOOLEAN;
[sei, baseV, indirect] ← FindSe[hti];
IF sei # ISENull THEN {
IF baseV = Tree.Null THEN RecordMention[sei] ELSE BumpCount[sei];
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
val ← [symbol[index: sei]]; type ← UnderType[seb[sei].idType];
ctx ← seb[sei].idCtx;
SELECT ctxb[ctx].ctxType FROM
included => {
attr.const ← ConstantId[sei];
IF baseV = Tree.Null AND (~attr.const OR ~InterfaceConst[sei]) THEN
Log.ErrorSei[notImported, sei]};
imported => {
IF seb[type].typeTag = ref THEN [val, type] ← DeRef[val, type];
attr.const ← FALSE};
ENDCASE => {
IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
attr.const ← seb[sei].constant};
SELECT TRUE FROM
baseV = Tree.Null => {
IF ctx = P3S.currentBody.argCtx THEN phraseNP ← ref;
IF ctxb[ctx].level = lZ AND ~attr.const THEN
SELECT ctx FROM
IN StandardContext, dataPtr.moduleCtx => NULL;
ENDCASE => Log.ErrorSei[missingBase, sei]};
(~attr.const AND ctxb[ctx].ctxType # imported) => {
attr ← And[UpdateTreeAttr[baseV], attr];
PushTree[CopyTree[baseV]]; PushTree[val];
IF indirect THEN {PushNode[dot, 2]; SetAttr[2, seb[OperandType[baseV]].typeTag = long]}
ELSE {PushNode[dollar, 2]; SetAttr[2, LongPath[baseV]]};
SetInfo[type]; val ← PopTree[]};
ENDCASE;
IF VarType[type] THEN [val, type] ← DeRef[val, type, TRUE]}
ELSE {
attr ← And[UpdateTreeAttr[baseV], attr]; type ← OperandType[baseV];
IF indirect THEN [val, type] ← DeRef[CopyTree[baseV], type]
ELSE val ← CopyTree[baseV]};
RPush[type, attr];
RETURN};
DeRef: PROC [t: Tree.Link, type: CSEIndex, var: BOOLEAN ← FALSE]
RETURNS [Tree.Link, CSEIndex] = {
rType: CSEIndex = ReferentType[type];
PushTree[t];
PushNode[uparrow, 1];
SetInfo[rType]; SetAttr[2, seb[type].typeTag = long]; SetAttr[3, var];
RETURN [PopTree[], rType]};
FieldId: PUBLIC PROC [hti: HTIndex, type: RecordSEIndex] RETURNS [n: CARDINAL, sei: ISEIndex] = {
[n, sei] ← SearchRecord[hti, type];
IF n # 0 THEN {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
BumpCount[sei]};
RETURN};
InterfaceId: PUBLIC PROC [hti: HTIndex, ctx: CTXIndex]
RETURNS [found: BOOLEAN, sei: ISEIndex] = {
[found, sei] ← SearchCtxList[hti, ctx];
IF found THEN {
SELECT ctxb[seb[sei].idCtx].ctxType FROM
imported => NULL;
included =>
IF ~ConstantId[sei] OR ~InterfaceConst[sei] THEN Log.ErrorSei[notImported, sei];
ENDCASE => {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
IF ~ConstResolved[sei] THEN ResolveIdValue[sei]};
BumpCount[sei]};
RETURN};
ClusterId: PUBLIC PROC [hti: HTIndex, ctx: CTXIndex]
RETURNS [found: BOOLEAN, sei: ISEIndex] = {
WITH c: ctxb[ctx] SELECT FROM
simple => [found, sei] ← SearchCtxList[hti, ctx];
included => {
mdi: MDIndex = c.module;
IF mdb[mdi].defaultImport = CTXNull THEN { -- avoid creating spurious principal imports
IF SearchCtxList[hti, ctx].found THEN
[found, sei] ← SearchCtxList[hti, DefaultImport[LOOPHOLE[ctx], FALSE]]
ELSE {found ← FALSE; sei ← ISENull}}
ELSE [found, sei] ← SearchCtxList[hti, mdb[mdi].defaultImport]};
ENDCASE => {found ← FALSE; sei ← ISENull};
IF found THEN {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
BumpCount[sei]};
RETURN};
-- service routines for above
InterfaceConst: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE {
RETURN [SELECT LinkMode[sei] FROM val, ref => FALSE, ENDCASE => TRUE]};
ConstResolved: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = {
RETURN [(seb[sei].mark4 OR seb[sei].idValue = Tree.Null) OR ~seb[sei].immutable
OR (seb[sei].constant AND ~RootType[sei])]};
VarType: PROC [type: CSEIndex] RETURNS [BOOLEAN] = INLINE {
subType: CSEIndex = NormalType[type];
RETURN [WITH t: seb[subType] SELECT FROM
ref => t.var,
ENDCASE => FALSE]};
RootType: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE {
RETURN [seb[sei].idType = typeTYPE AND TypeLink[sei] = SENull]};
ResolveIdType: PROC [sei: ISEIndex] = {
declNode: Tree.Index ← seb[sei].idValue;
IF tb[declNode].attr3 # P3.Mark THEN ResolveType[sei]};
ResolveIdValue: PROC [sei: ISEIndex] = {
declNode: Tree.Index ← seb[sei].idValue;
IF seb[sei].mark3 AND tb[declNode].attr2 # P3.Mark THEN ResolveValue[sei]};
BumpCount: PUBLIC PROC [sei: ISEIndex] = {
OPEN seb[sei];
IF idType # typeTYPE AND (~mark4 OR (ctxb[idCtx].ctxType = imported AND ~constant)) THEN
idInfo ← idInfo + 1};
-- keyed-list matching
CompleteRecord: PUBLIC PROC [rSei: RecordSEIndex, depth: Closure ← unit] = {
ctx: CTXIndex = seb[rSei].fieldCtx;
WITH ctxb[ctx] SELECT FROM
simple => NULL;
included => IF level = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], depth];
ENDCASE};
ArrangeKeys: PUBLIC PROC [
expList: Tree.Link,
nextKey: PROC RETURNS [HTIndex],
omittedValue: PROC RETURNS [Tree.Link]]
RETURNS [nItems: CARDINAL] = {
Pair: TYPE = RECORD[key: HTIndex, val: Tree.Link];
PairList: TYPE = RECORD[SEQUENCE length: CARDINAL OF Pair];
a: LONG POINTER TO PairList;
n: CARDINAL;
duplicate: BOOLEAN;
ListItem: Tree.Map = {
node: Tree.Index = GetNode[t];
hti: HTIndex = GetHash[tb[node].son[1]];
FOR i: CARDINAL IN [0 .. n) DO
IF hti = a[i].key THEN GO TO Duplicate;
REPEAT
Duplicate => {duplicate ← TRUE; v ← t};
FINISHED => {
a[n] ← [key:hti, val:tb[node].son[2]]; n ← n+1;
tb[node].son[2] ← Tree.Null; v ← FreeTree[t]};
ENDLOOP;
RETURN};
DuplicateItem: Tree.Scan = {
IF t # Tree.Null THEN {
node: Tree.Index = GetNode[t];
Log.ErrorTree[duplicateKey, tb[node].son[1]];
tb[node].son[2] ← P3.VoidExp[tb[node].son[2]]}};
key: HTIndex;
m: CARDINAL;
n ← ListLength[expList]; nItems ← 0;
a ← zone.NEW[PairList[n]];
n ← 0; duplicate ← FALSE; expList ← UpdateList[expList, ListItem]; m ← n;
UNTIL (key ← nextKey[]) = HTNull DO
FOR i: CARDINAL IN [0 .. n) DO
IF key = a[i].key THEN GO TO Found;
REPEAT
Found => {PushTree[a[i].val]; a[i].key ← HTNull; m ← m-1};
FINISHED => PushTree[omittedValue[]];
ENDLOOP;
nItems ← nItems + 1;
ENDLOOP;
IF duplicate THEN ScanList[expList, DuplicateItem];
IF m # 0 THEN
FOR i: CARDINAL IN [0 .. n) DO
IF a[i].key # HTNull THEN {
Log.ErrorHti[unknownKey, a[i].key]; [] ← FreeTree[P3.VoidExp[a[i].val]]};
ENDLOOP;
[] ← FreeTree[expList]; zone.FREE[@a];
RETURN};
-- service routines for copying/mapping list structure
BindTree: PUBLIC PROC [
t: Tree.Link, binding: PROC [ISEIndex] RETURNS [Tree.Link]]
RETURNS [Tree.Link] = {
MapTree: Tree.Map = {
IF t = Tree.Null THEN v ← Tree.Null
ELSE WITH t SELECT FROM
symbol => v ← binding[index];
subtree => {
node: Tree.Index = index;
v ← SELECT TRUE FROM
tb[node].shared =>
SELECT tb[node].name FROM
call, callx => MapThreadedTree[t],
ENDCASE => t,
ENDCASE => TreeOps.CopyTree[[baseP:@tb, link:t], MapTree]};
ENDCASE => v ← t;
RETURN};
MapThread: Tree.Map = {
IF OpName[t] = thread THEN {
node: Tree.Index = GetNode[t];
PushTree[MapTree[tb[node].son[1]]]; PushTree[Tree.Null];
PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[P3S.currentScope];
v ← PopTree[]}
ELSE v ← MapTree[t]};
MapThreadedTree: Tree.Map = {
sThread: Tree.Index = GetNode[NthSon[t, 1]];
dThread: Tree.Index;
v ← TreeOps.CopyTree[[baseP:@tb, link:t], MapThread];
dThread ← GetNode[NthSon[v, 1]];
tb[dThread].son[2] ← tb[sThread].son[2];
tb[sThread].son[2] ← v; SetShared[v, TRUE];
RETURN};
RETURN [MapTree[t]]};
IdentityBinding: PROC [sei: ISEIndex] RETURNS [Tree.Link] = {
RETURN [[symbol[index: sei]]]};
CopyTree: PUBLIC Tree.Map = {
RETURN [BindTree[t, IdentityBinding]]};
UpdateTreeAttr: PUBLIC PROC [t: Tree.Link] RETURNS [attr: Attr] = {
-- traverses the tree, incrementing reference counts for ids
UpdateAttr: Tree.Scan = {
WITH t SELECT FROM
symbol => {
IF seb[index].idCtx = P3S.currentBody.argCtx THEN
phraseNP ← MergeNP[phraseNP][ref];
BumpCount[index]};
subtree => {
node: Tree.Index = index;
ScanSons[t, UpdateAttr];
SELECT tb[node].name FROM
assign, assignx => {
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][set];
IF tb[node].attr2 AND tb[node].attr3 THEN
EnterComposite[OperandType[tb[node].son[1]], tb[node].son[2], tb[node].attr1]};
IN [call..join], IN [callx..joinx] => { -- conservative
P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][set]};
new => P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
atom => SymLiteralOps.EnterAtom[GetHash[tb[node].son[1]]];
ENDCASE => NULL};
ENDCASE => NULL};
attr ← FullAttr; phraseNP ← none; UpdateAttr[t];
attr.const ← FALSE; RETURN};
-- context stack management
ContextEntry: TYPE = RECORD [
base: Tree.Link, -- the basing expr (empty if none)
indirect: BOOLEAN, -- true iff basing expr is pointer
info: SELECT tag: * FROM
list => [ctx: CTXIndex], -- a single context
record => [rSei: RecordSEIndex], -- a group of contexts
hash => [ctxHti: HTIndex], -- a single identifier
ENDCASE];
ContextSequence: TYPE = RECORD [SEQUENCE length: NAT OF ContextEntry];
ContextStack: TYPE = LONG POINTER TO ContextSequence;
ctxStack: ContextStack;
ctxIndex: INTEGER;
ContextIncr: CARDINAL = 16;
MakeStack: PROC [size: CARDINAL] RETURNS [ContextStack] = INLINE {
RETURN [zone.NEW[ContextSequence[size]]]};
ExpandStack: PROC = {
oldstack: ContextStack ← ctxStack;
ctxStack ← MakeStack[oldstack.length + ContextIncr];
FOR i: CARDINAL IN [0 .. oldstack.length) DO ctxStack[i] ← oldstack[i] ENDLOOP;
zone.FREE[@oldstack]};
PushCtx: PUBLIC PROC [ctx: CTXIndex] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:Tree.Null, indirect:FALSE, info:list[ctx]]};
SetCtxBase: PROC [base: Tree.Link, indirect: BOOLEAN] = {
ctxStack[ctxIndex].base ← base; ctxStack[ctxIndex].indirect ← indirect};
PushRecordCtx: PUBLIC PROC [rSei: RecordSEIndex, base: Tree.Link, indirect: BOOLEAN] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:record[rSei]]};
UpdateRecordCtx: PUBLIC PROC [type: RecordSEIndex] = {
WITH ctxStack[ctxIndex] SELECT FROM
record => rSei ← type;
ENDCASE => ERROR};
PushHtCtx: PUBLIC PROC [hti: HTIndex, base: Tree.Link, indirect: BOOLEAN] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:hash[hti]]};
PopCtx: PUBLIC PROC = {ctxIndex ← ctxIndex-1};
TopCtx: PUBLIC PROC RETURNS [CTXIndex] = {
RETURN [WITH ctxStack[ctxIndex] SELECT FROM list => ctx, ENDCASE => ERROR]};
-- primary lookup
FindSe: PUBLIC PROC [hti: HTIndex] RETURNS [ISEIndex, Tree.Link, BOOLEAN] = {
found: BOOLEAN;
nHits: CARDINAL;
sei: ISEIndex;
FOR i: INTEGER DECREASING IN [0 .. ctxIndex] DO
WITH s: ctxStack[i] SELECT FROM
list => {
[found, sei] ← SearchCtxList[hti, s.ctx];
IF found THEN GO TO Found};
record => {
[nHits, sei] ← SearchRecord[hti, s.rSei];
SELECT nHits FROM
= 1 => GO TO Found;
> 1 => GO TO Ambiguous;
ENDCASE};
hash => IF hti = s.ctxHti THEN {sei ← ISENull; GO TO Found};
ENDCASE;
REPEAT
Found => RETURN [sei, ctxStack[i].base, ctxStack[i].indirect];
Ambiguous => {
Log.ErrorHti[ambiguousId, hti];
RETURN [dataPtr.seAnon, Tree.Null, FALSE]};
FINISHED => {
IF hti # HTNull THEN Log.ErrorHti[unknownId, hti];
RETURN [dataPtr.seAnon, Tree.Null, FALSE]};
ENDLOOP};
SearchCtxList: PUBLIC PROC [hti: HTIndex, ctx: CTXIndex]
RETURNS [found: BOOLEAN, sei: ISEIndex] = {
IF ctx = CTXNull THEN RETURN [FALSE, ISENull];
WITH c: ctxb[ctx] SELECT FROM
included => {
IF c.restricted THEN {
sei ← SearchRestrictedCtx[hti, LOOPHOLE[ctx]]; found ← (sei # ISENull)}
ELSE {
sei ← SearchContext[hti, ctx];
SELECT TRUE FROM
(sei # ISENull) => found ← TRUE;
(~c.closed AND ~c.reset) => [found, sei] ← Copier.SearchFileCtx[hti, LOOPHOLE[ctx]];
ENDCASE => found ← FALSE};
IF found AND ~seb[sei].public AND ~Shared[ctx]
AND sei # dataPtr.seAnon THEN Log.ErrorHti[noAccess, hti]};
imported => {
iCtx: IncludedCTXIndex = c.includeLink;
sei ← SearchContext[hti, ctx];
IF sei # ISENull THEN
found ← ~ctxb[iCtx].restricted OR CheckRestrictedCtx[hti, iCtx] # ISENull
ELSE {
[found, sei] ← SearchCtxList[hti, iCtx];
IF found AND sei # dataPtr.seAnon THEN
SELECT LinkMode[sei] FROM
val => {MoveSe[sei, ctx]; ImportSe[sei, ctx]};
ref => {
MoveSe[sei, ctx];
IF ~dataPtr.definitionsOnly AND ~VarType[UnderType[seb[sei].idType]] THEN {
seb[sei].idType ← MakeRefType[
cType: seb[sei].idType, readOnly: seb[sei].immutable,
hint: typeANY];
seb[sei].immutable ← TRUE};
ImportSe[sei, ctx]};
ENDCASE}};
ENDCASE => {sei ← SearchContext[hti, ctx]; found ← (sei # ISENull)};
RETURN};
MoveSe: PROC [sei: ISEIndex, ctx: CTXIndex] = {
Copier.Delink[sei]; seb[sei].idCtx ← ctx;
SetSeLink[sei, ctxb[ctx].seList]; ctxb[ctx].seList ← sei};
-- import handling
MainIncludedCtx: PUBLIC PROC [mdi: MDIndex] RETURNS [ctx: IncludedCTXIndex] = {
FOR ctx ← mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
IF ctxb[ctx].level = lG THEN EXIT ENDLOOP;
RETURN};
DefaultImport: PROC [iCtx: IncludedCTXIndex, new: BOOLEAN] RETURNS [CTXIndex] = {
mdi: MDIndex = ctxb[iCtx].module;
IF mdb[mdi].defaultImport = CTXNull THEN SetDefaultImport[iCtx, new];
RETURN [mdb[mdi].defaultImport]};
ImportTree: PROC [t: Tree.Link, importCtx: CTXIndex] RETURNS [Tree.Link] = {
iCtx: IncludedCTXIndex = WITH c: ctxb[importCtx] SELECT FROM
imported => c.includeLink,
ENDCASE => ERROR;
UpdateBinding: Tree.Map = {
WITH t SELECT FROM
symbol => {
oldSei: ISEIndex = index;
oldCtx: CTXIndex = seb[oldSei].idCtx;
newSei: ISEIndex;
type: CSEIndex;
WITH c: ctxb[oldCtx] SELECT FROM
included =>
IF c.level # lG OR InterfaceConst[oldSei] THEN newSei ← oldSei
ELSE {
mdi: MDIndex = c.module;
saveRestricted: BOOLEAN = c.restricted;
saveShared: BOOLEAN = mdb[mdi].shared;
targetCtx: CTXIndex;
c.restricted ← FALSE; mdb[mdi].shared ← TRUE;
targetCtx ← IF oldCtx = iCtx
THEN importCtx
ELSE DefaultImport[LOOPHOLE[oldCtx], TRUE];
newSei ← SearchCtxList[seb[oldSei].hash, targetCtx].sei;
mdb[mdi].shared ← saveShared; c.restricted ← saveRestricted};
ENDCASE => newSei ← oldSei;
v ← [symbol[index: newSei]];
IF ~dataPtr.definitionsOnly AND ctxb[seb[newSei].idCtx].ctxType = imported THEN {
type ← UnderType[seb[newSei].idType];
WITH s: seb[type] SELECT FROM
ref => IF ~s.var THEN [v, ] ← DeRef[v, type];
ENDCASE};
BumpCount[newSei]};
subtree => {
node: Tree.Index = index;
IF t # Tree.Null THEN
SELECT tb[node].name FROM
assign, assignx =>
IF tb[node].attr2 AND tb[node].attr3 THEN
EnterComposite[OperandType[tb[node].son[1]], tb[node].son[2], tb[node].attr1];
new =>
IF tb[node].attr3 THEN {
subType: SEIndex = TypeForTree[tb[node].son[2]];
EnterType[TypeRoot[subType], FALSE];
IF tb[node].son[3] # Tree.Null THEN
EnterComposite[UnderType[subType], tb[node].son[3], TRUE]};
ditem => {
sei: ISEIndex = FirstId[GetNode[tb[node].son[1]]];
UpdateNarrowing[seb[sei].idType, tb[node].attr2, tb[node].attr3]};
narrow => {
IF RCType[tb[node].info] = simple THEN {
nType: CSEIndex = NormalType[tb[node].info];
WITH t: seb[nType] SELECT FROM
ref => EnterType[t.refType, FALSE];
ENDCASE => NULL};
UpdateNarrowing[tb[node].info, tb[node].attr2, tb[node].attr3]};
istype =>
UpdateNarrowing[TypeForTree[tb[node].son[2]], tb[node].attr2, tb[node].attr3];
atom => {
SymLiteralOps.EnterAtom[GetHash[tb[node].son[1]]];
EnterType[dataPtr.typeAtomRecord, FALSE]};
bind, bindx =>
IF ~tb[node].attr3 THEN
EnterDiscriminator[NthSon[tb[node].son[1], 2]];
ENDCASE;
v ← UpdateLeaves[t, UpdateBinding]};
ENDCASE => v ← t;
RETURN};
RETURN [UpdateBinding[t]]};
UpdateNarrowing: PROC [type: SEIndex, rtTest, tagTest: BOOLEAN] = {
IF rtTest THEN EnterMarkedType[type];
IF tagTest THEN EnterTags[type]};
ImportCtx: PROC [ctx, importCtx: CTXIndex] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
ImportSe[sei, importCtx] ENDLOOP};
ImportSe: PROC [sei: ISEIndex, importCtx: CTXIndex] = {
t: Tree.Link;
tag: ExtensionType;
type: CSEIndex = UnderType[seb[sei].idType];
WITH t: seb[type] SELECT FROM
transfer => {
ImportCtx[ArgCtx[t.typeIn], importCtx];
ImportCtx[ArgCtx[t.typeOut], importCtx]};
ENDCASE;
IF seb[sei].extended THEN {
[tag, t] ← FindExtension[sei];
EnterExtension[sei, tag, ImportTree[t, importCtx]]}};
-- searching records
SearchRecordSegment: PROC [hti: HTIndex, rSei: RecordSEIndex, suffixed: BOOLEAN]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
tSei: CSEIndex;
found: BOOLEAN;
n: CARDINAL;
match: ISEIndex;
[found, sei] ← SearchCtxList[hti, seb[rSei].fieldCtx];
nHits ← IF found THEN 1 ELSE 0;
IF seb[rSei].hints.variant THEN {
tSei ← VariantUnionType[rSei];
WITH seb[tSei] SELECT FROM
union => {
IF ~suffixed AND ~controlled AND overlaid THEN {
[n, match] ← SearchOverlays[hti, caseCtx];
IF ~found THEN sei ← match;
nHits ← nHits + n};
IF controlled AND seb[tagSei].hash = hti THEN {sei ← tagSei; nHits ← nHits + 1}};
sequence => {
IF controlled AND seb[tagSei].hash = hti THEN {sei ← tagSei; nHits ← nHits + 1}};
ENDCASE => NULL};
RETURN};
SearchOverlays: PROC [hti: HTIndex, ctx: CTXIndex]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
vSei: ISEIndex;
rSei: SEIndex;
n: CARDINAL;
match: ISEIndex;
WITH ctxb[ctx] SELECT FROM
included => Copier.CompleteContext[LOOPHOLE[ctx]];
ENDCASE;
nHits ← 0; sei ← ISENull;
FOR vSei ← FirstCtxSe[ctx], NextSe[vSei] UNTIL vSei = ISENull DO
IF seb[vSei].public OR Shared[ctx] THEN {
rSei ← seb[vSei].idInfo;
WITH r: seb[rSei] SELECT FROM
id => NULL;
cons =>
WITH r SELECT FROM
record => {
[n, match] ← SearchRecordSegment[hti, LOOPHOLE[rSei], FALSE];
IF nHits = 0 THEN sei ← match;
nHits ← nHits + n};
ENDCASE => ERROR;
ENDCASE};
ENDLOOP;
RETURN};
SearchRecord: PROC [hti: HTIndex, type: RecordSEIndex]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
rSei: RecordSEIndex;
suffixed: BOOLEAN;
rSei ← type; suffixed ← FALSE;
UNTIL rSei = RecordSENull DO
[nHits, sei] ← SearchRecordSegment[hti, rSei, suffixed];
IF nHits # 0 THEN RETURN;
rSei ← WITH seb[rSei] SELECT FROM
linked => LOOPHOLE[UnderType[linkType]],
ENDCASE => RecordSENull;
suffixed ← TRUE;
ENDLOOP;
RETURN [0, ISENull]};
-- management of restricted contexts
Shared: PUBLIC PROC [ctx: CTXIndex] RETURNS [BOOLEAN] = {
RETURN [WITH c: ctxb[ctx] SELECT FROM
included => mdb[c.module].shared,
imported => Shared[c.includeLink],
ENDCASE => TRUE]};
CtxRestriction: TYPE = RECORD [ctx: IncludedCTXIndex, list: Tree.Link];
CtxIdTable: TYPE = RECORD [SEQUENCE length: CARDINAL OF CtxRestriction];
ctxIdTable: LONG POINTER TO CtxIdTable;
CtxHash: PROC [ctx: IncludedCTXIndex] RETURNS [CARDINAL] = INLINE {
RETURN [(LOOPHOLE[ctx, CARDINAL]/SIZE[included CTXRecord]) MOD ctxIdTable.length]};
MakeIdTable: PUBLIC PROC [nIdLists: CARDINAL] = {
ctxIdTable ← zone.NEW[CtxIdTable[nIdLists]];
FOR i: CARDINAL IN [0..nIdLists) DO ctxIdTable[i] ← [IncludedCTXNull, Tree.Null] ENDLOOP};
EnterIdList: PUBLIC PROC [ctx: IncludedCTXIndex, list: Tree.Link] = {
i: CARDINAL ← CtxHash[ctx];
DO
IF ctxIdTable[i].ctx = IncludedCTXNull THEN {ctxIdTable[i] ← [ctx, list]; EXIT};
IF (i ← i+1) = ctxIdTable.length THEN i ← 0;
ENDLOOP};
CheckRestrictedCtx: PROC [hti: HTIndex, ctx: IncludedCTXIndex]
RETURNS [sei: ISEIndex] = {
TestId: Tree.Test = {
WITH t SELECT FROM
hash => IF index = hti THEN sei ← dataPtr.seAnon;
symbol => IF seb[index].hash = hti THEN sei ← index;
ENDCASE;
RETURN [sei # ISENull]};
i: CARDINAL ← CtxHash[ctx];
DO
IF ctxIdTable[i].ctx = ctx THEN EXIT;
IF (i ← i+1) = ctxIdTable.length THEN i ← 0;
ENDLOOP;
sei ← ISENull; SearchList[ctxIdTable[i].list, TestId];
IF sei # ISENull AND seb[sei].idCtx = CTXNull THEN seb[sei].idCtx ← ctx;
RETURN};
SearchRestrictedCtx: PROC [hti: HTIndex, ctx: IncludedCTXIndex]
RETURNS [sei: ISEIndex] = {
sei ← CheckRestrictedCtx[hti, ctx];
IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx THEN {
[ , sei] ← Copier.SearchFileCtx[hti, ctx];
seb[sei].public ← TRUE}; -- second copy, access already checked
RETURN};
CheckDirectoryIds: Tree.Scan = {
CheckId: Tree.Scan = {
WITH t SELECT FROM
symbol => IF seb[index].idCtx = CTXNull THEN Log.WarningSei[unusedId, index];
ENDCASE};
node: Tree.Index = GetNode[t];
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
ScanList[tb[node].son[3], CheckId];
dataPtr.textIndex ← saveIndex};
CheckDisjoint: PUBLIC PROC [ctx1, ctx2: CTXIndex] = {
hti: HTIndex;
saveIndex: CARDINAL = dataPtr.textIndex;
IF ctx1 # CTXNull AND ctx2 # CTXNull THEN
FOR sei: ISEIndex ← FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull DO
hti ← seb[sei].hash;
IF hti # HTNull AND SearchContext[hti, ctx1] # ISENull THEN {
IF ~seb[sei].mark3 THEN
dataPtr.textIndex ← tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].info;
Log.ErrorHti[duplicateId, hti]};
ENDLOOP;
dataPtr.textIndex ← saveIndex};
-- basing management
OpenedType: PROC [type: CSEIndex] RETURNS [CSEIndex] = {
subType: CSEIndex = NormalType[type];
RETURN [WITH seb[subType] SELECT FROM
ref => UnderType[refType],
ENDCASE => type]};
OpenPointer: PUBLIC PROC [t: Tree.Link, type: CSEIndex]
RETURNS [Tree.Link, CSEIndex] = {
nType, rType: CSEIndex;
nDerefs: CARDINAL ← 0;
DO
nType ← NormalType[type];
WITH p: seb[nType] SELECT FROM
ref => {
rType ← UnderType[p.refType];
IF P3S.safety = checked AND ~p.counted THEN
Log.ErrorTree[unsafeOperation, t];
IF seb[NormalType[rType]].typeTag # ref THEN EXIT;
IF (nDerefs ← nDerefs+1) > 63 THEN EXIT};
ENDCASE;
[t, type] ← DeRef[t, type];
ENDLOOP;
RETURN [t, rType]};
BaseTree: PUBLIC PROC [t: Tree.Link, type: CSEIndex] RETURNS [val: Tree.Link] = {
PushTree[t]; PushNode[openx, 1]; SetInfo[type]; SetAttr[1, FALSE];
val ← PopTree[]; SetShared[val, TRUE]; RETURN};
OpenBase: PUBLIC PROC [t: Tree.Link, hti: HTIndex] RETURNS [v: Tree.Link] = {
type, vType, nType: CSEIndex;
OpenRecord: PROC [indirect: BOOLEAN] = {
WITH seb[type] SELECT FROM
record => {
v ← BaseTree[v, vType];
IF hti # HTNull THEN PushHtCtx[hti, v, indirect]
ELSE PushRecordCtx[LOOPHOLE[type, RecordSEIndex], v, indirect]};
ENDCASE => IF type # typeANY THEN Log.ErrorTree[typeClash, v]};
v ← Exp[t, typeANY];
type ← vType ← RType[]; nType ← NormalType[vType]; RPop[];
WITH seb[nType] SELECT FROM
definition, transfer => {
ctx: CTXIndex = InterfaceCtx[nType, v];
IF ctx = CTXNull THEN OpenRecord[FALSE]
ELSE IF hti # HTNull THEN PushHtCtx[hti, v, FALSE]
ELSE PushCtx[ctx]};
ref => {
[v, type] ← OpenPointer[v, vType]; vType ← OperandType[v];
OpenRecord[TRUE]};
ENDCASE => OpenRecord[FALSE];
RETURN};
CloseBase: PUBLIC PROC [t: Tree.Link, hti: HTIndex] = {
type: CSEIndex;
CloseRecord: PROC = {WITH seb[type] SELECT FROM record => PopCtx[]; ENDCASE};
type ← NormalType[OperandType[t]];
WITH seb[type] SELECT FROM
definition => PopCtx[];
ref => {type ← UnderType[refType]; CloseRecord[]};
ENDCASE => CloseRecord[]};
-- initialization/finalization
IdInit: PUBLIC PROC [scratchZone: UNCOUNTED ZONE] = {
(dataPtr.table).AddNotify[IdNotify];
zone ← scratchZone;
refStack ← zone.NEW[RefSequence[16]];
refIndex ← 0;
ctxStack ← MakeStack[2*ContextIncr]; ctxIndex ← -1};
IdReset: PUBLIC Tree.Scan = {
ScanList[t, CheckDirectoryIds];
zone.FREE[@ctxIdTable]; zone.FREE[@ctxStack];
zone.FREE[@refStack];
zone ← NIL;
(dataPtr.table).DropNotify[IdNotify]};
}.