-- file Pass3I.Mesa
-- last modified by Satterthwaite, November 15, 1979  3:45 PM

DIRECTORY
  ComData: FROM "comdata"
    USING [definitionsOnly, moduleCtx, seAnon, switches, textIndex],
  Copier: FROM "copier" USING [CompleteContext, Delink, SearchFileCtx],
  InlineDefs: FROM "inlinedefs" USING [BITAND],
  Log: FROM "log" USING [ErrorHti, ErrorSei, WarningSei, ErrorTree],
  P3: FROM "p3"
    USING [
      Attr, FullAttr, VoidAttr, Mark, MergeNP,
      currentArgCtx, phraseNP,
      --And,-- Exp, LongPath, MakePointerType, OperandType,
      ResolveType, ResolveValue, RPop, RPush, RType,
      VariantUnionType, VoidExp],
  Symbols: FROM "symbols"
    USING [seType, ctxType, mdType, bodyType,
      CTXRecord, ExtensionType,
      MDIndex, HTIndex, SEIndex, ISEIndex, CSEIndex, RecordSEIndex,
      CTXIndex, IncludedCTXIndex,
      HTNull, ISENull, RecordSENull, CTXNull, IncludedCTXNull,
      lG, lZ, StandardContext, typeTYPE, typeANY],
  SymbolOps: FROM "symbolops"
    USING [
      ConstantId, EnterExtension, FindExtension, FirstCtxSe, LinkMode, NextSe,
      NormalType, SearchContext, SetSeLink, UnderType],
  SystemDefs: FROM "systemdefs"
    USING [
      AllocateHeapNode, AllocateSegment, FreeHeapNode, FreeSegment,
      SegmentSize],
  Table: FROM "table" USING [Base, Notifier, Allocate],
  Tree: FROM "tree"
    USING [Index, Link, Map, Scan, Test, Null, NullIndex, treeType],
  TreeOps: FROM "treeops"
    USING [
      FreeNode, FreeTree, GetNode, IdentityMap, PopTree, PushTree, PushNode,
      ScanList, SearchList, SetAttr, SetInfo, SetShared, TestTree,
      UpdateList, UpdateTree];

Pass3I: PROGRAM
    IMPORTS
	InlineDefs, Copier, Log, P3, SymbolOps, SystemDefs, Table, TreeOps, 
	dataPtr: ComData
    EXPORTS P3 = 
  BEGIN
  OPEN SymbolOps, P3, Symbols, TreeOps;

  And: PROCEDURE [Attr, Attr] RETURNS [Attr] = LOOPHOLE[InlineDefs.BITAND];

-- uninitialized variable processing

  RefItem: TYPE = RECORD [kind: {seal, rhs, lhs}, sei: ISEIndex];
  RefSeal: RefItem = [kind:seal, sei:ISENull];

  refStack: DESCRIPTOR FOR ARRAY OF RefItem;
  refIndex: CARDINAL;

  AdjustRefStack: PROCEDURE [n: CARDINAL] =
    BEGIN
    i: CARDINAL;
    oldStack: DESCRIPTOR FOR ARRAY OF RefItem _ refStack;
    refStack _ DESCRIPTOR[SystemDefs.AllocateHeapNode[n*SIZE[RefItem]], n];
    FOR i IN [0..refIndex) DO refStack[i] _ oldStack[i] ENDLOOP;
    SystemDefs.FreeHeapNode[BASE[oldStack]];
    END;

  RecordMention: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN
    IF dataPtr.switches['u] AND
     (seb[sei].idInfo = 0 AND ~seb[sei].mark4)
      THEN
	BEGIN
	IF refIndex >= LENGTH[refStack]
	  THEN AdjustRefStack[LENGTH[refStack] + 8];
	refStack[refIndex] _ [kind:rhs, sei:sei];
	refIndex _ refIndex + 1;
	END
      ELSE  BumpCount[sei];
    END;

  RecordLhs: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN
    i: CARDINAL;
    key: RefItem;
    IF dataPtr.switches['u] AND
     (seb[sei].idInfo = 0 AND ~seb[sei].mark4)
      THEN
	BEGIN
	key _ [kind:rhs, sei:sei];
	FOR i DECREASING IN [0..refIndex)
	  DO
	  SELECT refStack[i] FROM
	    key =>  BEGIN refStack[i].kind _ lhs; EXIT END;
	    RefSeal => EXIT;
	    ENDCASE;
	  ENDLOOP;
	END;
    END;

  SealRefStack: PUBLIC PROCEDURE =
    BEGIN
    IF refIndex >= LENGTH[refStack] THEN AdjustRefStack[LENGTH[refStack] + 8];
    refStack[refIndex] _ RefSeal;  refIndex _ refIndex + 1;
    END;

  UnsealRefStack: PUBLIC PROCEDURE =
    BEGIN
    ClearRefStack[];    refIndex _ refIndex - 1;
    IF refStack[refIndex] # RefSeal THEN ERROR;
    END;

  ClearRefStack: PUBLIC PROCEDURE =
    BEGIN
    i: CARDINAL;
    sei: ISEIndex;
    FOR i 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 LENGTH[refStack] > 16 THEN AdjustRefStack[16];
    END;

  ConstantInit: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] =
    BEGIN
    node: Tree.Index;
    IF seb[sei].constant THEN RETURN [TRUE];
    node _ seb[sei].idValue;
    RETURN [seb[sei].immutable
	AND node # Tree.NullIndex AND TestTree[tb[node].son[3], body]]
    END;


-- tables defining the current symbol table

  tb: Table.Base;		-- tree base
  seb: Table.Base;		-- se table
  ctxb: Table.Base;		-- context table
  mdb: Table.Base;		-- module directory base
  bb: Table.Base;		-- body directory base

  IdNotify: PUBLIC Table.Notifier =
    BEGIN  -- called whenever the main symbol table is repacked
    tb _ base[Tree.treeType];
    seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
    bb _ base[bodyType];
    END;


-- identifier look-up

  Id: PUBLIC PROCEDURE [hti: HTIndex] RETURNS [val: Tree.Link] =
    BEGIN
    sei: ISEIndex;
    type: CSEIndex;
    ctx: CTXIndex;
    baseV: Tree.Link;
    attr: Attr;
    indirect: BOOLEAN;
    attr _ VoidAttr;
    [sei, baseV, indirect] _ FindSe[hti];
    IF sei # ISENull
      THEN
	BEGIN
	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 =>
	    BEGIN
	    attr.const _ ConstantId[sei];
	    IF baseV = Tree.Null AND (~attr.const OR LinkMode[sei] # manifest)
	      THEN Log.ErrorSei[notImported, sei];
	    END;
	  imported =>
	    BEGIN
	    IF seb[type].typeTag = pointer THEN
	      [val, type] _ DeRef[val, type];
	    attr.const _ FALSE;
	    END;
	  ENDCASE =>
	    BEGIN
	    IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
	    attr.const _ seb[sei].constant;
	    END;
	SELECT TRUE FROM
	  baseV = Tree.Null =>
	    BEGIN
	    IF ctx = currentArgCtx 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];
	    END;
	  (~attr.const AND ctxb[ctx].ctxType # imported) =>
	    BEGIN
	    attr _ And[UpdateTreeAttr[baseV], attr];
	    PushTree[IdentityMap[baseV]];  PushTree[val];
	    IF indirect
	      THEN
		BEGIN
		PushNode[dot, 2];
		SetAttr[2, seb[OperandType[baseV]].typeTag = long];
		END
	      ELSE
		BEGIN
		PushNode[dollar, 2];  SetAttr[2, LongPath[baseV]];
		END;
	    SetInfo[type];  val _ PopTree[];
	    END;
	  ENDCASE;
	END
      ELSE
	BEGIN
	attr _ And[UpdateTreeAttr[baseV], attr];  type _ OperandType[baseV];
	IF indirect
	  THEN  [val, type] _ DeRef[IdentityMap[baseV], type]
	  ELSE  val _ IdentityMap[baseV];
	END;
    RPush[type, attr];
    RETURN
    END;

  DeRef: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link, CSEIndex] =
    BEGIN
    rType: CSEIndex;
    PushTree[t];
    PushNode[uparrow, 1];  SetAttr[2, seb[type].typeTag = long];
    type _ NormalType[type];
    WITH seb[type] SELECT FROM
      pointer => BEGIN dereferenced _ TRUE; rType _ UnderType[refType] END;
      ENDCASE => rType _ typeANY;
    SetInfo[rType];
    RETURN [PopTree[], rType]
    END;


  FieldId: PUBLIC PROCEDURE [hti: HTIndex, type: RecordSEIndex]
      RETURNS [n: CARDINAL, sei: ISEIndex] =
    BEGIN
    [n, sei] _ SearchRecord[hti, type];
    IF n # 0
      THEN
	BEGIN
	IF ~seb[sei].mark3 THEN ResolveIdType[sei];
	IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
	BumpCount[sei];
	END;
    RETURN
    END;

  DefinedId: PUBLIC PROCEDURE [hti: HTIndex, type: CSEIndex]
      RETURNS [found: BOOLEAN, sei: ISEIndex] =
    BEGIN
    WITH seb[type] SELECT FROM
      definition =>
	BEGIN
	[found, sei] _ SearchCtxList[hti, defCtx];
	IF found  THEN
	  BEGIN
	  SELECT ctxb[seb[sei].idCtx].ctxType FROM
	    imported =>  NULL;
	    included =>
	      IF ~ConstantId[sei] OR LinkMode[sei] # manifest
		THEN Log.ErrorSei[notImported, sei];
	    ENDCASE =>
	      BEGIN
	      IF ~seb[sei].mark3 THEN ResolveIdType[sei];
	      IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
	      END;
	    BumpCount[sei];
	    END;
	END;
      ENDCASE =>  BEGIN  found _ FALSE;  sei _ ISENull  END;
    RETURN
    END;

-- service routines for above

  ConstResolved: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE
    BEGIN
    RETURN [seb[sei].mark4 OR ~seb[sei].immutable OR seb[sei].constant]
    END;

  ResolveIdType: PROCEDURE [sei: ISEIndex] =
    BEGIN
    declNode: Tree.Index;
    declNode _ seb[sei].idValue;
    IF tb[declNode].attr3 # P3.Mark THEN ResolveType[sei];
    END;

  ResolveIdValue: PROCEDURE [sei: ISEIndex] =
    BEGIN
    declNode: Tree.Index;
    declNode _ seb[sei].idValue;
    IF seb[sei].mark3 AND tb[declNode].attr2 # P3.Mark THEN ResolveValue[sei];
    END;


  BumpCount: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN  OPEN seb[sei];
    IF idType # typeTYPE AND
     (~mark4 OR (ctxb[idCtx].ctxType = imported AND ~constant))
      THEN  idInfo _ idInfo + 1;
    END;


-- keyed-list matching

  CompleteRecord: PUBLIC PROCEDURE [rSei: RecordSEIndex] =
    BEGIN
    ctx: CTXIndex = seb[rSei].fieldCtx;
    WITH ctxb[ctx] SELECT FROM
      simple => NULL;
      included =>
	IF level = lZ
	  THEN Copier.CompleteContext[LOOPHOLE[ctx, IncludedCTXIndex], FALSE];
      ENDCASE;
    END;

  ArrangeKeys: PUBLIC PROCEDURE [
	expList: Tree.Link,
	ctx: CTXIndex,
	startSei, endSei: ISEIndex,
	omittedKey: PROCEDURE [ISEIndex] RETURNS [Tree.Link]]
      RETURNS [nItems: CARDINAL] =
    BEGIN
    Pair: TYPE = RECORD[
      key: ISEIndex,
      defined: BOOLEAN,
      attr: Tree.Link];
    i: CARDINAL;
    aList: DESCRIPTOR FOR ARRAY OF Pair;
    sei: ISEIndex;

    KeyItem: Tree.Map =
      BEGIN
      node: Tree.Index;
      hti: HTIndex;
      i: CARDINAL;
      WITH t SELECT FROM
	subtree =>
	  BEGIN  node _ index;
	  WITH tb[node].son[1] SELECT FROM
	    hash =>
	      BEGIN  hti _ index;
	      FOR i IN [0 .. nItems)
		DO
		IF seb[aList[i].key].hash = hti THEN GO TO found;
		REPEAT
		  found =>
		    IF ~aList[i].defined
		      THEN
			BEGIN  aList[i].attr _ tb[node].son[2];
			tb[node].son[2] _ Tree.Null;
			aList[i].defined _ TRUE;
			END
		      ELSE
			BEGIN  Log.ErrorHti[duplicateKey, hti];
			tb[node].son[2] _ P3.VoidExp[tb[node].son[2]];
			END;
		  FINISHED =>
		    BEGIN  Log.ErrorHti[unknownKey, hti];
		    tb[node].son[2] _ P3.VoidExp[tb[node].son[2]];
		    END;
		ENDLOOP;
	      FreeNode[node];
	      END;
	    ENDCASE =>  ERROR;
	  END;
	ENDCASE =>  ERROR;
      RETURN [Tree.Null]
      END;

    nItems _ 0;
    FOR sei _ startSei, NextSe[sei] UNTIL sei = endSei
      DO  IF seb[sei].idCtx = ctx THEN nItems _ nItems+1  ENDLOOP;
    aList _ DESCRIPTOR[
	SystemDefs.AllocateHeapNode[nItems*SIZE[Pair]],
	nItems];
    i _ 0;
    FOR sei _ startSei, NextSe[sei] UNTIL sei = endSei
      DO
      IF seb[sei].idCtx = ctx
        THEN
	  BEGIN
	  aList[i] _ Pair[key:sei, defined:FALSE, attr:Tree.Null];  i _ i+1;
	  END;
      ENDLOOP;
    expList _ FreeTree[UpdateList[expList, KeyItem]];
    FOR i IN [0 .. nItems)
      DO
      PushTree[IF aList[i].defined
	THEN aList[i].attr
	ELSE omittedKey[aList[i].key]];
      ENDLOOP;
    SystemDefs.FreeHeapNode[BASE[aList]];
    RETURN 
    END;


-- service routines for copying/mapping list structure

  UpdateTreeAttr: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [attr: Attr] =
    BEGIN  -- traverses the tree, incrementing reference counts for ids

    UpdateAttr: Tree.Map =
      BEGIN
      WITH t SELECT FROM
	symbol =>
	  BEGIN
	  IF seb[index].idCtx = currentArgCtx
	    THEN phraseNP _ MergeNP[phraseNP][ref];
	  BumpCount[index];
	  END;
	subtree =>
	  BEGIN
	  [] _ UpdateTree[t, UpdateAttr];
	  SELECT tb[index].name FROM
	    assign, assignx, extract =>
	      BEGIN
	      attr.noAssign _ FALSE;  phraseNP _ MergeNP[phraseNP][set];
	      END;
	    IN [subst..join], IN [callx..joinx], substx =>
	      BEGIN
	      attr.noXfer _ FALSE;  phraseNP _ MergeNP[phraseNP][set];
	      END;
	    ENDCASE => NULL;
	  END;
	ENDCASE =>  NULL;
      RETURN [t]
      END;

    attr _ FullAttr;  phraseNP _ none;  [] _ UpdateAttr[t];
    attr.const _ FALSE;  RETURN
    END;



-- 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];

  ContextStack: TYPE = DESCRIPTOR FOR ARRAY OF ContextEntry;

  ctxStack: ContextStack;
  ctxIndex: INTEGER;
  ContextIncr: CARDINAL = 25;

  MakeStack: PROCEDURE [size: CARDINAL] RETURNS [ContextStack] =
    BEGIN  OPEN SystemDefs;
    base: POINTER = AllocateSegment[size*SIZE[ContextEntry]];
    RETURN [DESCRIPTOR[base, SegmentSize[base]/SIZE[ContextEntry]]]
    END;

  FreeStack: PROCEDURE [s: ContextStack] =
    BEGIN
    IF LENGTH [s] > 0 THEN SystemDefs.FreeSegment[BASE[s]];
    END;

  ExpandStack: PROCEDURE =
    BEGIN
    i: CARDINAL;
    oldstack: ContextStack _ ctxStack;
    ctxStack _ MakeStack[LENGTH[oldstack]+ContextIncr];
    FOR i IN [0 .. LENGTH[oldstack]) DO ctxStack[i] _ oldstack[i] ENDLOOP;
    FreeStack[oldstack];
    END;



  PushCtx: PUBLIC PROCEDURE [ctx: CTXIndex] =
    BEGIN
    IF (ctxIndex _ ctxIndex+1) >= LENGTH[ctxStack] THEN  ExpandStack[];
    ctxStack[ctxIndex] _ [base:Tree.Null, indirect:FALSE, info:list[ctx]];
    END;

  SetCtxBase: PROCEDURE [base: Tree.Link, indirect: BOOLEAN] =
    BEGIN
    ctxStack[ctxIndex].base _ base;  ctxStack[ctxIndex].indirect _ indirect;
    END;

  PushRecordCtx: PUBLIC PROCEDURE [rSei: RecordSEIndex, base: Tree.Link, indirect: BOOLEAN] = 
    BEGIN
    IF (ctxIndex _ ctxIndex+1) >= LENGTH[ctxStack] THEN  ExpandStack[];
    ctxStack[ctxIndex] _ [base:base, indirect:indirect, info:record[rSei]];
    END;
    
  UpdateRecordCtx: PUBLIC PROCEDURE [type: RecordSEIndex] =
    BEGIN
    WITH ctxStack[ctxIndex] SELECT FROM
      record => rSei _ type;
      ENDCASE => ERROR;
    END;

  PushHtCtx: PUBLIC PROCEDURE [hti: HTIndex, base: Tree.Link, indirect: BOOLEAN] =
    BEGIN
    IF (ctxIndex _ ctxIndex+1) >= LENGTH[ctxStack] THEN  ExpandStack[];
    ctxStack[ctxIndex] _ [base:base, indirect:indirect, info:hash[hti]];
    END;

  PopCtx: PUBLIC PROCEDURE = BEGIN  ctxIndex _ ctxIndex-1  END;

  TopCtx: PUBLIC PROCEDURE RETURNS [CTXIndex] =
    BEGIN
    RETURN [WITH ctxStack[ctxIndex] SELECT FROM list => ctx, ENDCASE => ERROR]
    END;


-- primary lookup

  FindSe: PUBLIC PROCEDURE [hti: HTIndex] RETURNS [ISEIndex, Tree.Link, BOOLEAN] =
    BEGIN
    i: INTEGER;
    found: BOOLEAN;
    nHits: CARDINAL;
    sei: ISEIndex;
    FOR i DECREASING IN [0 .. ctxIndex]
      DO
      WITH s: ctxStack[i] SELECT FROM
	list =>
	  BEGIN
	  [found, sei] _ SearchCtxList[hti, s.ctx];
	  IF found THEN GO TO Found;
	  END;
	record =>
	  BEGIN
	  [nHits, sei] _ SearchRecord[hti, s.rSei];
	  SELECT nHits FROM
	    = 1 => GO TO Found;
	    > 1 => GO TO Ambiguous;
	    ENDCASE;
	  END;
	hash =>  IF hti = s.ctxHti THEN  BEGIN sei _ ISENull; GO TO Found END;
	ENDCASE;
      REPEAT
	Found =>  RETURN [sei, ctxStack[i].base, ctxStack[i].indirect];
	Ambiguous =>
	  BEGIN
	  Log.ErrorHti[ambiguousId, hti];
	  RETURN [dataPtr.seAnon, Tree.Null, FALSE]
	  END;
	FINISHED =>
	  BEGIN
	  IF hti # HTNull THEN Log.ErrorHti[unknownId, hti];
	  RETURN [dataPtr.seAnon, Tree.Null, FALSE]
	  END;
      ENDLOOP;
    END;


  SearchCtxList: PUBLIC PROCEDURE [hti: HTIndex, ctx: CTXIndex]
      RETURNS [found: BOOLEAN, sei: ISEIndex] =
    BEGIN
    IF ctx = CTXNull THEN RETURN [FALSE, ISENull];
    WITH c: ctxb[ctx] SELECT FROM
      included =>
	IF c.restricted
	  THEN
	    BEGIN
	    sei _ SearchRestrictedCtx[hti, LOOPHOLE[ctx]];
	    found _ (sei # ISENull);
	    IF found AND ~seb[sei].public AND ~mdb[c.module].shared
	     AND sei # dataPtr.seAnon
	      THEN Log.ErrorHti[noAccess, hti];
	    END
	  ELSE
	    BEGIN
	    sei _ SearchContext[hti, ctx];
	    IF sei # ISENull
	      THEN  found _ seb[sei].public OR mdb[c.module].shared
	      ELSE IF ~c.closed AND ~c.reset
		THEN
		  [found, sei] _ Copier.SearchFileCtx[hti, LOOPHOLE[ctx]]
		ELSE found _ FALSE;
	    END;
      imported =>
	BEGIN
	iCtx: IncludedCTXIndex = c.includeLink;
	sei _ SearchContext[hti, ctx];
	IF sei # ISENull
	  THEN
	    found _ ~ctxb[iCtx].restricted
			OR CheckRestrictedCtx[hti, iCtx] # ISENull
	  ELSE
	    BEGIN
	    [found, sei] _ SearchCtxList[hti, iCtx];
	    IF found AND  sei # dataPtr.seAnon THEN
	      SELECT LinkMode[sei] FROM
		val =>  BEGIN  MoveSe[sei, ctx];  ImportSe[sei, ctx]  END;
		ref =>
		  BEGIN
		  MoveSe[sei, ctx];
		  IF ~dataPtr.definitionsOnly THEN
		    BEGIN
		    seb[sei].idType _ MakePointerType[
			cType: seb[sei].idType, readOnly: seb[sei].immutable,
			hint: typeANY];
		    seb[sei].immutable _ TRUE;
		    END;
		  ImportSe[sei, ctx];
		  END;
		ENDCASE;
	    END;
	END;
      ENDCASE =>
	BEGIN  sei _ SearchContext[hti, ctx];  found _ (sei # ISENull)  END;
    RETURN
    END;

  MoveSe: PROCEDURE [sei: ISEIndex, ctx: CTXIndex] =
    BEGIN
    Copier.Delink[sei];  seb[sei].idCtx _ ctx;
    SetSeLink[sei, ctxb[ctx].seList];  ctxb[ctx].seList _ sei;
    END;

  BindTree: PROCEDURE [t: Tree.Link, importCtx: CTXIndex] RETURNS [Tree.Link] =
    BEGIN
    iCtx: IncludedCTXIndex = WITH c: ctxb[importCtx] SELECT FROM
      imported => c.includeLink,
      ENDCASE => ERROR;

    UpdateBinding: Tree.Map =
      BEGIN
      WITH t SELECT FROM
	symbol =>
	  BEGIN
	  oldSei: ISEIndex = index;
	  oldCtx: CTXIndex = seb[oldSei].idCtx;
	  newSei: ISEIndex;
	  type: CSEIndex;
	  WITH c: ctxb[oldCtx] SELECT FROM
	    included =>
	      IF c.level # lG OR LinkMode[oldSei] = manifest
		THEN  newSei _ oldSei
		ELSE
		  BEGIN
		  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 DefaultImportCtx[LOOPHOLE[oldCtx]];
		  newSei _ SearchCtxList[seb[oldSei].hash, targetCtx].sei;
		  mdb[mdi].shared _ saveShared; c.restricted _ saveRestricted;
		  END;
	    ENDCASE =>  newSei _ oldSei;
	  v _ [symbol[index: newSei]];
	  IF ~dataPtr.definitionsOnly
	   AND ctxb[seb[newSei].idCtx].ctxType = imported
	    THEN
	      BEGIN
	      type _ UnderType[seb[newSei].idType];
	      IF seb[type].typeTag = pointer THEN  [v, ] _ DeRef[v, type];
	      END;
	  BumpCount[newSei];
	  END;
	subtree =>  v _ UpdateTree[t, UpdateBinding];
	ENDCASE =>  v _ t;
      RETURN
      END;

    RETURN [UpdateBinding[t]];
    END;

  ImportRecord: PROCEDURE [rSei: RecordSEIndex, importCtx: CTXIndex] =
    BEGIN
    sei: ISEIndex;
    IF rSei # RecordSENull THEN
      FOR sei _ FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull
	DO  ImportSe[sei, importCtx]  ENDLOOP;
    END;

  ImportSe: PROCEDURE [sei: ISEIndex, importCtx: CTXIndex] =
    BEGIN
    t: Tree.Link;
    tag: ExtensionType;
    type: CSEIndex = UnderType[seb[sei].idType];
    WITH t: seb[type] SELECT FROM
      transfer =>
	BEGIN
	ImportRecord[t.inRecord, importCtx];
	ImportRecord[t.outRecord, importCtx];
	END;
      ENDCASE;
    IF seb[sei].extended 
      THEN
	BEGIN
	[tag, t] _ FindExtension[sei];
	EnterExtension[sei, tag, BindTree[t, importCtx]];
	END;
    END;


  DefaultImportCtx: PROCEDURE [iCtx: IncludedCTXIndex] RETURNS [ctx: CTXIndex] =
    BEGIN
    mdi: MDIndex = ctxb[iCtx].module;
    ctx _ mdb[mdi].defaultImport;
    IF ctx = CTXNull
      THEN
	BEGIN
	Log.ErrorHti[missingImport, mdb[mdi].moduleId];
	ctx _ Table.Allocate[ctxType, SIZE[imported CTXRecord]];
	ctxb[ctx] _ CTXRecord[
			mark: FALSE,
			varUpdated: FALSE,
			seList: ISENull,
			level: ctxb[iCtx].level,
			extension: imported[includeLink: iCtx]];
	mdb[mdi].defaultImport _ ctx;
	END;
    RETURN
    END;


-- searching records

  SearchRecordSegment: PROCEDURE
      [hti: HTIndex, rSei: RecordSEIndex, suffixed: BOOLEAN]
      RETURNS [nHits: CARDINAL, sei: ISEIndex] =
    BEGIN
    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
	BEGIN
	tSei _ VariantUnionType[rSei];
	WITH seb[tSei] SELECT FROM
	  union =>
	    BEGIN
	    IF ~suffixed AND ~controlled AND overlayed
	      THEN
		BEGIN
		[n, match] _ SearchOverlays[hti, caseCtx];
		IF ~found THEN sei _ match;
		nHits _ nHits + n;
		END;
	    IF controlled AND seb[tagSei].hash = hti
	      THEN  BEGIN  sei _ tagSei;  nHits _ nHits + 1  END;
	    END;
	  ENDCASE =>  NULL;
	END;
    RETURN
    END;

  SearchOverlays: PROCEDURE [hti: HTIndex, ctx: CTXIndex]
      RETURNS [nHits: CARDINAL, sei: ISEIndex] =
    BEGIN
    vSei: ISEIndex;
    rSei: SEIndex;
    n: CARDINAL;
    match: ISEIndex;
    WITH ctxb[ctx] SELECT FROM
      included => Copier.CompleteContext[LOOPHOLE[ctx], FALSE];
      ENDCASE;
    nHits _ 0;  sei _ ISENull;
    FOR vSei _ FirstCtxSe[ctx], NextSe[vSei] UNTIL vSei = ISENull
      DO
      rSei _ seb[vSei].idInfo;
      WITH r: seb[rSei] SELECT FROM
	id => NULL;
	cons =>
	  WITH r SELECT FROM
	    record =>
	      BEGIN
	      [n, match] _ SearchRecordSegment[hti, LOOPHOLE[rSei], FALSE];
	      IF nHits = 0 THEN sei _ match;
	      nHits _ nHits + n;
	      END;
	    ENDCASE => ERROR;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;

  SearchRecord: PROCEDURE [hti: HTIndex, type: RecordSEIndex]
      RETURNS [nHits: CARDINAL, sei: ISEIndex] =
    BEGIN
    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]
    END;


-- management of restricted contexts

  CtxRestriction: TYPE = RECORD [ctx: IncludedCTXIndex, list: Tree.Link];

  ctxIdTable: DESCRIPTOR FOR ARRAY OF CtxRestriction;
  ctxIdTableSize: CARDINAL;


  CtxHash: PROCEDURE [ctx: IncludedCTXIndex] RETURNS [CARDINAL] = INLINE
    BEGIN
    RETURN [
      (LOOPHOLE[ctx, CARDINAL]/SIZE[included CTXRecord]) MOD ctxIdTableSize]
    END;

  MakeIdTable: PUBLIC PROCEDURE [nIdLists: CARDINAL] =
    BEGIN
    i: CARDINAL;
    ctxIdTable _ DESCRIPTOR[
	SystemDefs.AllocateHeapNode[nIdLists*SIZE[CtxRestriction]],
	nIdLists];
    FOR i IN [0..nIdLists)
      DO ctxIdTable[i] _ [IncludedCTXNull, Tree.Null] ENDLOOP;
    ctxIdTableSize _ nIdLists;
    END;

  EnterIdList: PUBLIC PROCEDURE [ctx: IncludedCTXIndex, list: Tree.Link] =
    BEGIN
    i: CARDINAL;
    i _ CtxHash[ctx];
      DO
      IF ctxIdTable[i].ctx = IncludedCTXNull
	THEN BEGIN  ctxIdTable[i] _ [ctx, list];  EXIT  END;
      IF (i _ i+1) = ctxIdTableSize THEN i _ 0;
      ENDLOOP;
    END;


  CheckRestrictedCtx: PROCEDURE [hti: HTIndex, ctx: IncludedCTXIndex]
      RETURNS [sei: ISEIndex] =
    BEGIN

    TestId: Tree.Test =
      BEGIN
      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]
      END;

    i: CARDINAL;
    i _ CtxHash[ctx];
      DO
      IF ctxIdTable[i].ctx = ctx THEN EXIT;
      IF (i _ i+1) = ctxIdTableSize 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
    END;

  SearchRestrictedCtx: PROCEDURE [hti: HTIndex, ctx: IncludedCTXIndex]
      RETURNS [sei: ISEIndex] =
    BEGIN
    sei _ CheckRestrictedCtx[hti, ctx];
    IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx
      THEN  [ , sei] _ Copier.SearchFileCtx[hti, ctx];
    RETURN
    END;


  CheckDirectoryIds: Tree.Scan =
    BEGIN
    
    CheckId: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
	symbol =>
	  IF seb[index].idCtx = CTXNull THEN Log.WarningSei[unusedId, index];
	ENDCASE;
      END;

    node: Tree.Index = GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex _ tb[node].info;
    ScanList[tb[node].son[3], CheckId];
    dataPtr.textIndex _ saveIndex;
    END;



  CheckDisjoint: PUBLIC PROCEDURE [ctx1, ctx2: CTXIndex] =
    BEGIN
    sei: ISEIndex;
    hti: HTIndex;
    saveIndex: CARDINAL = dataPtr.textIndex;
    IF ctx1 # CTXNull AND ctx2 # CTXNull
      THEN
	FOR sei _ FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull
	  DO
	  hti _ seb[sei].hash;
	  IF hti # HTNull AND SearchContext[hti, ctx1] # ISENull
	    THEN
	      BEGIN
	      IF ~seb[sei].mark3
		THEN dataPtr.textIndex _
		      tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].info;
	      Log.ErrorHti[duplicateId, hti];
	      END;
	  ENDLOOP;
    dataPtr.textIndex _ saveIndex;
    END;


-- basing management

  OpenPointer: PUBLIC PROCEDURE [t: Tree.Link, type: CSEIndex]
      RETURNS [Tree.Link, CSEIndex] =
    BEGIN
    nType, rType: CSEIndex;
    nDerefs: CARDINAL _ 0;
      DO
      nType _ NormalType[type];
      WITH p: seb[nType] SELECT FROM
	pointer =>
	  BEGIN
	  p.dereferenced _ TRUE;  rType _ UnderType[p.refType];
	  IF seb[NormalType[rType]].typeTag # pointer THEN EXIT;
	  IF (nDerefs _ nDerefs+1) > 255 THEN EXIT;
	  END;
	ENDCASE;
      [t, type] _ DeRef[t, type];
      ENDLOOP;
    RETURN [t, rType];
    END;

  BaseTree: PUBLIC PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [val: Tree.Link] =
    BEGIN
    PushTree[t];  PushNode[openx, 1];  SetInfo[type];  SetAttr[1, FALSE];
    val _ PopTree[];  SetShared[val, TRUE];  RETURN
    END;

  OpenBase: PUBLIC PROCEDURE [t: Tree.Link, hti: HTIndex] RETURNS [v: Tree.Link] =
    BEGIN
    type, vType, nType: CSEIndex;
    
    OpenRecord: PROCEDURE [indirect: BOOLEAN] =
      BEGIN
      WITH seb[type] SELECT FROM
	record =>
	  BEGIN
	  v _ BaseTree[v, vType];
	  IF hti # HTNull
	    THEN PushHtCtx[hti, v, indirect]
	    ELSE PushRecordCtx[LOOPHOLE[type, RecordSEIndex], v, indirect];
	  END;
	ENDCASE => IF type # typeANY THEN Log.ErrorTree[typeClash, v];
      END;

    v _ Exp[t, typeANY];
    type _ vType _ RType[];  nType _ NormalType[vType];  RPop[];
    WITH seb[nType] SELECT FROM
      definition =>
	BEGIN
	IF hti # HTNull THEN Log.ErrorHti[openId, hti];
	PushCtx[defCtx];
	END;
      pointer =>
	BEGIN
	[v, type] _ OpenPointer[v, vType];  vType _ OperandType[v];
	OpenRecord[TRUE];
	END;
      ENDCASE =>  OpenRecord[FALSE];
    RETURN
    END;


  CloseBase: PUBLIC PROCEDURE [t: Tree.Link, hti: HTIndex] =
    BEGIN
    type: CSEIndex;
    
    CloseRecord: PROCEDURE =
      BEGIN
      WITH seb[type] SELECT FROM record =>  PopCtx[]; ENDCASE;
      END;

    type _ NormalType[OperandType[t]];
    WITH seb[type] SELECT FROM
      definition =>  BEGIN IF hti # HTNull THEN NULL;  PopCtx[]  END;
      pointer =>  BEGIN  type _ UnderType[refType];  CloseRecord[]  END;
      ENDCASE =>  CloseRecord[];
    END;


-- initialization/finalization

  IdInit: PUBLIC PROCEDURE =
    BEGIN
    refStack _ DESCRIPTOR[SystemDefs.AllocateHeapNode[16*SIZE[RefItem]], 16];
    refIndex _ 0;
    ctxStack _ MakeStack[2*ContextIncr];  ctxIndex _ -1;
    END;

  IdFinish: PUBLIC Tree.Scan =
    BEGIN
    ScanList[t, CheckDirectoryIds];
    SystemDefs.FreeHeapNode[BASE[ctxIdTable]];
    FreeStack[ctxStack];
    SystemDefs.FreeHeapNode[BASE[refStack]];
    END;

  END.