
<<file Pass3I.mesa>>
<<last modified by Satterthwaite, July 6, 1983 5:20 pm>>
<<last modified by Donahue,  8-Dec-81 15:29:30>>

DIRECTORY
A3: TYPE USING [
LongPath, MarkedType, OperandType, PermanentType, TypeForTree, VarType],
Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
ComData: TYPE USING [
interface, 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, MakeRefType, ResolveType, ResolveValue,
RPop, RPush, RType, SetDefaultImport, 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, MarkShared,
NthSon, OpName, PopTree, PushTree, PushNode, ScanList, ScanSons, SearchList,
SetAttr, SetInfo, UpdateList, UpdateLeaves];

Pass3I: PROGRAM
IMPORTS
A3, Alloc, Copier, Log, P3, P3S, SymLiteralOps, SymbolOps, TreeOps, 
dataPtr: ComData
EXPORTS P3 = { 
OPEN SymbolOps, A3, 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.interface 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 [BOOL] = {
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: BOOL_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: BOOL] = {
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: BOOL] = {
sei: ISEIndex _ FirstCtxSe[seb[rSei].fieldCtx];

EnterField: Tree.Scan = {
IF sei # ISENull THEN {
subType: CSEIndex = UnderType[seb[sei].idType];
WITH seb[subType] SELECT FROM
record => {
IF hints.variant AND RCType[subType] = composite THEN
EnterType[subType, TRUE];
EnterComposite[subType, t, init]};
ENDCASE => EnterComposite[subType, 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: BOOL;
[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 ~dataPtr.interface AND 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];
IF seb[sei].extended THEN attr _ And[UpdateExtension[sei], attr]}
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: BOOL_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]};

UpdateExtension: PROC [sei: ISEIndex] RETURNS [attr: Attr] = {
t: Tree.Link;
tag: ExtensionType;
[tag, t] _ FindExtension[sei];
IF tag # value THEN attr _ fullAttr
ELSE {attr _ UpdateTreeAttr[t]; attr.const _ TRUE};
RETURN};


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: BOOL, 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: BOOL, 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 [BOOL] = INLINE {
RETURN [SELECT LinkMode[sei] FROM val, ref => FALSE, ENDCASE => TRUE]};

ConstResolved: PROC [sei: ISEIndex] RETURNS [BOOL] = {
RETURN [(seb[sei].mark4 OR seb[sei].idValue = Tree.Null) OR ~seb[sei].immutable
OR (seb[sei].constant AND ~RootType[sei])]};

RootType: PROC [sei: ISEIndex] RETURNS [BOOL] = 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: BOOL;

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;  MarkShared[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]]};


<<attribute completion/updating>>

EnterRefLits: PROC [node: Tree.Index] = {
IF node # Tree.NullIndex 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};

UpdateNarrowing: PROC [type: SEIndex, rtTest, tagTest: BOOL] = {
IF rtTest THEN EnterMarkedType[type];
IF tagTest THEN EnterTags[type]};


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];
EnterRefLits[node];
SELECT tb[node].name FROM
assign, assignx => {
attr.noAssign _ FALSE;  phraseNP _ MergeNP[phraseNP][set]};
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;
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: BOOL,        -- 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: BOOL] = {
ctxStack[ctxIndex].base _ base; ctxStack[ctxIndex].indirect _ indirect};

PushRecordCtx: PUBLIC PROC [rSei: RecordSEIndex, base: Tree.Link, indirect: BOOL] = { 
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: BOOL] = {
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, BOOL] = {
found: BOOL;
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: BOOL, 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.interface 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: BOOL] 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: BOOL = c.restricted;
saveShared: BOOL = 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.interface 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;
EnterRefLits[node];
v _ UpdateLeaves[t, UpdateBinding]};
ENDCASE => v _ t;
RETURN};

RETURN [UpdateBinding[t]]};


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: BOOL]
RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
tSei: CSEIndex;
found: BOOL;
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: BOOL;
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 [BOOL] = {
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]/CTXRecord.included.SIZE) 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 OR PermanentType[p.refType]) 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[];  MarkShared[val, TRUE];  RETURN};

OpenBase: PUBLIC PROC [t: Tree.Link, hti: HTIndex] RETURNS [v: Tree.Link] = {
type, vType, nType: CSEIndex;

OpenRecord: PROC [indirect: BOOL] = {
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]};

}.