-- file Pass3I.mesa
-- last modified by Satterthwaite, March 24, 1983 1:02 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, Name, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
    CTXIndex, IncludedCTXIndex, Closure,
    nullName, nullType, 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,
    TypeForm, 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: Type, canonical: BOOL_TRUE] = {
    SymLiteralOps.EnterType[type, canonical];
    CompleteRCType[type]};

  CompleteRCType: PROC [type: Type] = {
    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: Type, t: Tree.Link, init: BOOL] = {
    csei: CSEIndex = UnderType[type];
    SELECT OpName[t] FROM
      loophole, cast, safen, pad => {
	t1: Tree.Link = NthSon[t, 1];
	EnterComposite[OperandType[t1], t1, init];
	IF RCType[csei] = composite THEN EnterType[csei, TRUE]};
      construct =>
	IF RCType[csei] = composite THEN {
	  node: Tree.Index = GetNode[t];
	  EnterFieldTypes[RecordRoot[tb[node].info], tb[node].son[2], init];
	  IF ~init THEN EnterType[csei, 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: Type = 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[UnderType[csei], TRUE]}};
      all => {
	node: Tree.Index = GetNode[t];
	aSei: ArraySEIndex = tb[node].info;
	cSei: Type = seb[aSei].componentType;
	IF RCType[cSei] # none THEN {
	  EnterComposite[cSei, NthSon[t, 1], FALSE];
	  IF ~init THEN EnterType[UnderType[csei], TRUE]}};
      ENDCASE =>
	SELECT seb[csei].typeTag FROM
	  union => Log.ErrorTree[unimplemented, t];
	  sequence => IF t # Tree.Null THEN Log.ErrorTree[unimplemented, t];
	  ENDCASE => IF RCType[csei] = composite THEN EnterType[csei, 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 THEN {
              IF RCType[subType] = composite THEN EnterType[subType, TRUE]}
            ELSE EnterComposite[subType, t, init];
          ENDCASE => EnterComposite[subType, t, init]};
      sei _ NextSe[sei]};

    ScanList[t, EnterField]};

  EnterMarkedType: PROC [type: Type] = INLINE {
    EnterType[MarkedType[type]]};

  EnterDiscriminator: PROC [t: Tree.Link] = INLINE {	-- guarantee that union is copied
    [] _ VariantUnionType[OpenedType[OperandType[t]]]};

  EnterTags: PROC [type: Type] = INLINE {
    subType: CSEIndex _ OpenedType[UnderType[type]];
    DO
      next: Type = TypeLink[subType];
      IF next = nullType THEN EXIT;
      subType _ UnderType[next];
      [] _ VariantUnionType[subType];	-- guarantee that union is copied
      ENDLOOP};

    
-- identifier look-up

  Id: PUBLIC PROC [name: Name] RETURNS [val: Tree.Link] = {
    sei: ISEIndex;
    type: Type;
    ctx: CTXIndex;
    baseV: Tree.Link;
    attr: Attr _ voidAttr;
    indirect: BOOL;
    [sei, baseV, indirect] _ FindSe[name];
    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 _ 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 TypeForm[type] = 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, TypeForm[OperandType[baseV]] = 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: Type, var: BOOL_FALSE] RETURNS [Tree.Link, Type] = {
    rType: Type = ReferentType[type];
    PushTree[t];
    PushNode[uparrow, 1];
    SetInfo[rType];  SetAttr[2, TypeForm[type] = 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 [name: Name, type: RecordSEIndex] RETURNS [n: CARDINAL, sei: ISEIndex] = {
    [n, sei] _ SearchRecord[name, type];
    IF n # 0 THEN {
      IF ~seb[sei].mark3 THEN ResolveIdType[sei];
      IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
      BumpCount[sei]};
    RETURN};

  InterfaceId: PUBLIC PROC [name: Name, ctx: CTXIndex]
      RETURNS [found: BOOL, sei: ISEIndex] = {
    [found, sei] _ SearchCtxList[name, 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 [name: Name, ctx: CTXIndex] 
      RETURNS [found: BOOL, sei: ISEIndex] = {
    WITH c: ctxb[ctx] SELECT FROM
      simple => [found, sei] _ SearchCtxList[name, ctx];
      included => {
        mdi: MDIndex = c.module;
	IF mdb[mdi].defaultImport = CTXNull THEN {  -- avoid creating spurious principal imports
	  IF SearchCtxList[name, ctx].found THEN
	    [found, sei] _ SearchCtxList[name, DefaultImport[LOOPHOLE[ctx], FALSE]]
	  ELSE {found _ FALSE; sei _ ISENull}}
	ELSE [found, sei] _ SearchCtxList[name, 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] = nullType]};


  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 [Name],
	omittedValue: PROC RETURNS [Tree.Link]]
      RETURNS [nItems: CARDINAL] = {
    Pair: TYPE = RECORD[key: Name, 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];
      name: Name = GetHash[tb[node].son[1]];
      FOR i: CARDINAL IN [0 .. n) DO
	IF name = a[i].key THEN GO TO Duplicate;
	REPEAT
	  Duplicate => {duplicate _ TRUE; v _ t};
	  FINISHED => {
	    a[n] _ [key:name, 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: Name;
    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[]) = nullName 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 _ nullName; 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 # nullName 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: Type = TypeForTree[tb[node].son[2]];
	  EnterType[TypeRoot[subType], FALSE];
	  IF tb[node].son[3] # Tree.Null THEN
	    EnterComposite[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: Type, 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: Name],	-- 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 [name: Name, base: Tree.Link, indirect: BOOL] = {
    IF (ctxIndex _ ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
    ctxStack[ctxIndex] _ [base:base, indirect:indirect, info:hash[name]]};

  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 [name: Name] 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[name, s.ctx];
	  IF found THEN GO TO Found};
	record => {
	  [nHits, sei] _ SearchRecord[name, s.rSei];
	  SELECT nHits FROM
	    = 1 => GO TO Found;
	    > 1 => GO TO Ambiguous;
	    ENDCASE};
	hash => IF name = s.ctxHti THEN {sei _ ISENull; GO TO Found};
	ENDCASE;
      REPEAT
	Found => RETURN [sei, ctxStack[i].base, ctxStack[i].indirect];
	Ambiguous => {
	  Log.ErrorHti[ambiguousId, name];
	  RETURN [dataPtr.seAnon, Tree.Null, FALSE]};
	FINISHED => {
	  IF name # nullName THEN Log.ErrorHti[unknownId, name];
	  RETURN [dataPtr.seAnon, Tree.Null, FALSE]};
      ENDLOOP};


  SearchCtxList: PUBLIC PROC [name: Name, 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[name, LOOPHOLE[ctx]]; found _ (sei # ISENull)}
	ELSE {
	  sei _ SearchContext[name, ctx];
	  SELECT TRUE FROM
	    (sei # ISENull) => found _ TRUE;
	    (~c.closed AND ~c.reset) => [found, sei] _ Copier.SearchFileCtx[name, LOOPHOLE[ctx]];
	    ENDCASE => found _ FALSE};
	IF found AND ~seb[sei].public AND ~Shared[ctx]
	 AND sei # dataPtr.seAnon THEN Log.ErrorHti[noAccess, name]};
      imported => {
	iCtx: IncludedCTXIndex = c.includeLink;
	sei _ SearchContext[name, ctx];
	IF sei # ISENull THEN
	  found _ ~ctxb[iCtx].restricted OR CheckRestrictedCtx[name, iCtx] # ISENull
	ELSE {
	  [found, sei] _ SearchCtxList[name, 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[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[name, 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;
	  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: Type = seb[newSei].idType;
	    IF TypeForm[type] = ref AND ~VarType[type] THEN [v, ] _ DeRef[v, type]};
	  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 [name: Name, rSei: RecordSEIndex, suffixed: BOOL]
      RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
    tSei: CSEIndex;
    found: BOOL;
    n: CARDINAL;
    match: ISEIndex;
    [found, sei] _ SearchCtxList[name, 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[name, caseCtx];
	    IF ~found THEN sei _ match;
	    nHits _ nHits + n};
	  IF controlled AND seb[tagSei].hash = name THEN {sei _ tagSei; nHits _ nHits + 1}};
	sequence => {
	  IF controlled AND seb[tagSei].hash = name THEN {sei _ tagSei; nHits _ nHits + 1}};
	ENDCASE => NULL};
    RETURN};

  SearchOverlays: PROC [name: Name, ctx: CTXIndex]
      RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
    vSei: ISEIndex;
    rSei: Type;
    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[name, LOOPHOLE[rSei], FALSE];
		IF nHits = 0 THEN sei _ match;
		nHits _ nHits + n};
	      ENDCASE => ERROR;
	  ENDCASE};
      ENDLOOP;
    RETURN};

  SearchRecord: PROC [name: Name, type: RecordSEIndex]
      RETURNS [nHits: CARDINAL, sei: ISEIndex] = {
    rSei: RecordSEIndex;
    suffixed: BOOL;
    rSei _ type;  suffixed _ FALSE;
    UNTIL rSei = RecordSENull DO
      [nHits, sei] _ SearchRecordSegment[name, 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 [name: Name, ctx: IncludedCTXIndex]
      RETURNS [sei: ISEIndex] = {

    TestId: Tree.Test = {
      WITH t SELECT FROM
	hash => IF index = name THEN sei _ dataPtr.seAnon;
	symbol => IF seb[index].hash = name 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 [name: Name, ctx: IncludedCTXIndex]
      RETURNS [sei: ISEIndex] = {
    sei _ CheckRestrictedCtx[name, ctx];
    IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx THEN {
      [ , sei] _ Copier.SearchFileCtx[name, 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] = {
    name: Name;
    saveIndex: CARDINAL = dataPtr.textIndex;
    IF ctx1 # CTXNull AND ctx2 # CTXNull THEN
      FOR sei: ISEIndex _ FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull DO
	name _ seb[sei].hash;
	IF name # nullName AND SearchContext[name, ctx1] # ISENull THEN {
	  IF ~seb[sei].mark3 THEN
	    dataPtr.textIndex _ tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].info;
	  Log.ErrorHti[duplicateId, name]};
	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: Type] RETURNS [Tree.Link, Type] = {
    subType: Type _ type;
    nType, rType: CSEIndex;
    nDerefs: CARDINAL _ 0;
    DO
      nType _ NormalType[subType];
      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 TypeForm[NormalType[rType]] # ref THEN EXIT;
	  IF (nDerefs _ nDerefs+1) > 63 THEN EXIT};
	ENDCASE;
      [t, subType] _ DeRef[t, subType];
      ENDLOOP;
    RETURN [t, rType]};

  BaseTree: PUBLIC PROC [t: Tree.Link, type: Type] 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, name: Name] RETURNS [v: Tree.Link] = {
    type, vType: Type;
    nType: CSEIndex;
    
    OpenRecord: PROC [indirect: BOOL] = {
      subType: CSEIndex = UnderType[type];
      WITH seb[subType] SELECT FROM
	record => {
	  v _ BaseTree[v, vType];
	  IF name # nullName THEN PushHtCtx[name, v, indirect]
	  ELSE PushRecordCtx[LOOPHOLE[subType, RecordSEIndex], v, indirect]};
	ENDCASE => IF subType # 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 name # nullName THEN PushHtCtx[name, 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, name: Name] = {
    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]};

  }.