-- file SymbolCopier.Mesa
-- last modified by Johnsson, July 16, 1980  8:55 AM
-- last modified by Satterthwaite, October 17, 1980  2:51 PM
-- last modified by Bruce, September 1, 1980  8:28 PM

DIRECTORY
  Copier USING [
    SEToken, NullSEToken, FindMdEntry, FreeSymbolTable, GetSymbolTable],
  Strings USING [SubString, SubStringDescriptor],
  Inline USING [LongDivMod, LongMult],
  LiteralOps USING [CopyLiteral],
  Storage USING [Words, FreeWords],
  SymbolTable USING [Base, SetCacheSize],
  Symbols,
  SymbolOps USING [
    EnterExtension, EnterString, LinkBti, MakeCtxSe, MakeNonCtxSe,
    MakeSeChain, NewCtx, NextSe, ParentBti, ResetCtxList, SearchContext,
    SetSeLink, SubStringForHash, UnderType],
  SymbolPack,
  Table USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify],
  Tree USING [treeType, Index, Link, Map, NullIndex],
  TreeOps USING [
    CopyTree, GetNode, OpName, PopTree, PushNode, PushTree, SetAttr, SetInfo];

SymbolCopier: PROGRAM
    IMPORTS
      Copier, Inline, LiteralOps, SymbolTable, Storage, Table, TreeOps,
      ownSymbols: SymbolPack, SymbolOps
    EXPORTS Copier SHARES Copier = 
  BEGIN
  OPEN SymbolOps, Symbols;

 -- tables defining the current symbol table

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

  CopierNotify: Table.Notifier = {
    -- called whenever the main symbol table is repacked
    seb _ base[seType]; ctxb _ base[ctxType];
    mdb _ base[mdType];  bb _ base[bodyType];
    tb _ base[Tree.treeType];
    IF iBase # NIL AND iBase = ownSymbols THEN INotify[]};

   
 -- table bases for the current include module

  iBase: SymbolTable.Base;

  iHt: LONG DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;
  iSeb: Table.Base;
  iCtxb: Table.Base;

  INotify: PROC = {
    -- called whenever iBase switches or tables moved
    iHt _ iBase.ht;  iSeb _ iBase.seb;  iCtxb _ iBase.ctxb};


  MemoCacheSize: CARDINAL = 509;  -- prime < 512
  SearchCache: TYPE = ARRAY [0..MemoCacheSize) OF RECORD[
    hti: HTIndex,
    ctx: CTXIndex];

  memoCache: POINTER TO SearchCache;


 -- initialization/finalization

  CopierInit: PUBLIC PROC [cache: BOOLEAN] = {
    iBase _ NIL;
    Table.AddNotify[CopierNotify];
    IF cache
      THEN {
	memoCache _ Storage.Words[SIZE[SearchCache]];
	memoCache^ _ ALL[ [hti:HTNull, ctx:CTXNull] ];
	typeCache _ Storage.Words[SIZE[TypeCache]];
	typeCache^ _ ALL[ [mdi:MDNull, iSei:SENull, sei: SENull] ]}
      ELSE {memoCache _ NIL; typeCache _ NIL};
    SymbolTable.SetCacheSize[100];
    currentBody _ BTNull};

  ResetCaches: PROC = INLINE {	-- see ResetIncludeContexts
    SymbolTable.SetCacheSize[0];
    IF typeCache # NIL THEN Storage.FreeWords[typeCache];
    IF memoCache # NIL THEN Storage.FreeWords[memoCache]};

  CopierReset: PUBLIC PROC = {
    ResetIncludeContexts[];
    IF iBase # NIL THEN CloseIncludedTable[];
    Table.DropNotify[CopierNotify]};


 -- manipulation of symbol tokens (without copying)

  SEToken: TYPE = Copier.SEToken;
  NullSEToken: SEToken = Copier.NullSEToken;

  CtxValue: PUBLIC PROC [ctx: CTXIndex, value: CARDINAL] RETURNS [t: SEToken] = {
    mdi: MDIndex;
    iCtx: CTXIndex;
    [mdi, iCtx] _ InverseMapCtx[ctx];
    IF OpenIncludedTable[mdi]
      THEN  {t _ [iBase.SeiForValue[value, iCtx]]; CloseIncludedTable[]}
      ELSE  t _ NullSEToken;
    RETURN};

  CtxFirst: PUBLIC PROC [ctx: CTXIndex] RETURNS [t: SEToken] = {
    mdi: MDIndex;
    iCtx: CTXIndex;
    [mdi, iCtx] _ InverseMapCtx[ctx];
    IF OpenIncludedTable[mdi]
      THEN  {t _ [iBase.FirstCtxSe[iCtx]]; CloseIncludedTable[]}
      ELSE  t _ NullSEToken;
    RETURN};

  CtxNext: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [next: SEToken] = {
    mdi: MDIndex;
    iCtx: CTXIndex;
    [mdi, iCtx] _ InverseMapCtx[ctx];
    IF t # NullSEToken AND OpenIncludedTable[mdi]
      THEN  {next _ [iBase.NextSe[t]]; CloseIncludedTable[]}
      ELSE  next _ NullSEToken;
    RETURN};

  TokenHash: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [hti: HTIndex] = {
    mdi: MDIndex = InverseMapCtx[ctx].mdi;
    IF t # NullSEToken AND OpenIncludedTable[mdi]
      THEN  {hti _ MapHti[iBase.seb[t].hash];  CloseIncludedTable[]}
      ELSE  hti _ HTNull;
    RETURN};
   
  TokenValue: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [v: WORD] = {
    mdi: MDIndex = InverseMapCtx[ctx].mdi;
    IF t # NullSEToken AND OpenIncludedTable[mdi]
      THEN {v _ iBase.seb[t].idValue;  CloseIncludedTable[]}
      ELSE  v _ 0;
    RETURN};
   
  TokenSymbol: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [sei: ISEIndex] = {
    mdi: MDIndex = InverseMapCtx[ctx].mdi;
    SELECT TRUE FROM
      (mdi = OwnMdi) =>  sei _ t;
      OpenIncludedTable[mdi] => {
	sei _ LOOPHOLE[CopyIncludedSymbol[t, mdi, TRUE]];  CloseIncludedTable[]};
      ENDCASE =>  sei _ ISENull;
    RETURN};
   

 -- copying across table boundaries

  SubString: TYPE = Strings.SubString;
  SubStringDescriptor: TYPE = Strings.SubStringDescriptor;

  SearchFileCtx: PUBLIC PROC [hti: HTIndex, ctx: IncludedCTXIndex]
      RETURNS [found: BOOLEAN, sei: ISEIndex] = {
    desc: SubStringDescriptor;
    s: SubString = @desc;
    hash: [0..MemoCacheSize);
    iHti: HTIndex;
    iSei: ISEIndex;
    mdi: MDIndex = ctxb[ctx].module;
    ignorePrivate: BOOLEAN = TRUE;  -- for debugger
    SubStringForHash[s, hti];
    hash _ Inline.LongDivMod[
		Inline.LongMult[LOOPHOLE[hti], LOOPHOLE[ctx]],
		MemoCacheSize].remainder;
    IF memoCache # NIL AND memoCache[hash].hti = hti AND memoCache[hash].ctx = ctx
      THEN RETURN [FALSE, ISENull];
    IF OpenIncludedTable[mdi]
      THEN {
	iHti _ iBase.FindString[s];
	IF iHti # HTNull
	  AND
	 (iHt[iHti].anyPublic OR (ignorePrivate --AND iHt[iHti].anyInternal--))
	  THEN {
	    iSei _ iBase.SearchContext[iHti, ctxb[ctx].map];
	    found _ iSei # SENull AND (iSeb[iSei].public OR ignorePrivate);
	    IF found THEN sei _ CopyCtxSe[iSei, hti, ctx, mdi]}
	  ELSE found _ FALSE;
	CloseIncludedTable[]}
      ELSE {found _ FALSE; sei _ ISENull};
    IF ~found AND memoCache # NIL THEN  memoCache[hash] _ [hti:hti, ctx:ctx];
    RETURN};


  CompleteContext: PUBLIC PROC [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] = {
    IF ~ctxb[ctx].reset AND OpenIncludedTable[ctxb[ctx].module]
      THEN  {FillContext[ctx, ignorePrivate]; CloseIncludedTable[]}};


  CopyUnion: PUBLIC PROC [ctx: CTXIndex] = {
    iSei, iRoot: ISEIndex;
    WITH ctxb[ctx] SELECT FROM
      included =>
	IF ~reset AND OpenIncludedTable[module]
	  THEN {
	    iSei _ iRoot _ iCtxb[map].seList;
	      DO
	      IF iSei = SENull THEN EXIT;
	      SELECT iBase.TypeForm[iSeb[iSei].idType] FROM
		union, sequence => {
		  IF iSeb[iSei].hash # HTNull
		    THEN [] _ CopyIncludedSymbol[iSei, module]
		    ELSE FillContext[LOOPHOLE[ctx], TRUE];
		  EXIT};
		ENDCASE;
	      IF (iSei _ iBase.NextSe[iSei]) = iRoot THEN EXIT;
	      ENDLOOP;
	    CloseIncludedTable[]};
      ENDCASE};


  AugmentContext: PUBLIC PROC [
      ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN, mdi: MDIndex] = {
    mdRoot: MDIndex;
    target: CTXIndex;
    [mdRoot, target] _ InverseMapCtx[ctx];
    IF ~ctxb[ctx].reset AND OpenIncludedTable[mdi]
      THEN {
	newMdi: MDIndex = iBase.FindMdi[mdb[mdRoot].stamp];
	IF newMdi # MDNull
	  THEN
	    FOR iCtx: IncludedCTXIndex _ iBase.mdb[newMdi].ctx,
	     iBase.ctxb[iCtx].chain UNTIL iCtx = CTXNull
	      DO
	      IF iBase.ctxb[iCtx].map = target
		THEN {
		  CopyCtxEntries[ctx, iCtx, mdi, ignorePrivate];
		  IF ~iBase.ctxb[iCtx].complete THEN ctxb[ctx].complete _ FALSE;
		  IF ctxb[ctx].complete THEN ResetCtx[ctx];
		  EXIT};
	      ENDLOOP;
	CloseIncludedTable[]}};


  FillContext: PROC [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] = {
    mdi: MDIndex = ctxb[ctx].module;
    CopyCtxEntries[ctx, ctxb[ctx].map, mdi, TRUE];  -- for debugger
    ResetCtx[ctx]};

  CopyCtxEntries: PROC [
      ctx: IncludedCTXIndex, iCtx: CTXIndex, mdi: MDIndex, ignorePrivate: BOOLEAN] = {
    complete: BOOLEAN _ TRUE;
    pSei: ISEIndex _ ISENull;
    FOR iSei: ISEIndex _ iBase.FirstCtxSe[iCtx], iBase.NextSe[iSei] UNTIL iSei = SENull
      DO
      IF ~(iSeb[iSei].public OR ignorePrivate)
	THEN complete _ FALSE
	ELSE {
	  hti: HTIndex = MapHti[iSeb[iSei].hash];
	  sei: ISEIndex _ SearchContext[hti, ctx];
	  IF sei = SENull THEN sei _ CopyCtxSe[iSei, hti, ctx, mdi];
	  IF pSei # SENull AND NextSe[pSei] # sei
	    THEN {Delink[sei]; SetSeLink[sei, NextSe[pSei]]; SetSeLink[pSei, sei]};
	  ctxb[ctx].seList _ pSei _ sei};
      ENDLOOP;
    ctxb[ctx].complete _ complete};

  Delink: PUBLIC PROC [sei: ISEIndex] = {
    prev, next: ISEIndex;
    ctx: CTXIndex = seb[sei].idCtx;	-- assumed not reset
    prev _ ctxb[ctx].seList;
      DO
      next _ NextSe[prev];
      SELECT next FROM
	sei => EXIT;
	ctxb[ctx].seList, ISENull => ERROR;
	ENDCASE => prev _ next;
      ENDLOOP;
    IF NextSe[sei] = sei
      THEN ctxb[ctx].seList _ ISENull
      ELSE {
	IF sei = ctxb[ctx].seList THEN ctxb[ctx].seList _ prev;
	SetSeLink[prev, NextSe[sei]]};
    SetSeLink[sei, ISENull]};

  FillRecord: PROC [sei: CSEIndex, mdi: MDIndex] = {
    WITH type: seb[sei] SELECT FROM
      record => {
	WITH type SELECT FROM
	  linked => FillRecord[UnderType[linkType], mdi];
	  ENDCASE => NULL;
	WITH c: ctxb[type.fieldCtx] SELECT FROM
	  included =>
	    IF ~c.reset
	      THEN {
		IF c.module = mdi
		  THEN FillContext[LOOPHOLE[type.fieldCtx], TRUE]
		  ELSE {
		    CloseIncludedTable[];
		    CompleteContext[LOOPHOLE[type.fieldCtx], TRUE];
		    [] _ OpenIncludedTable[mdi]}};
	  ENDCASE => NULL};
      ENDCASE => NULL};


  MapHti: PROC [iHti: HTIndex] RETURNS [hti: HTIndex] = {
    desc: SubStringDescriptor;
    s: SubString = @desc;
    IF iHti = HTNull
      THEN hti _ HTNull
      ELSE {
	iBase.SubStringForHash[s, iHti];
	hti _ EnterString[s ! TableRelocated => s.base _ iBase.ssb]};
    RETURN};

  MissingHti: ERROR = CODE;

  InverseMapHti: PROC [hti: HTIndex] RETURNS [iHti: HTIndex] = {
    desc: SubStringDescriptor;
    s: SubString = @desc;
    IF hti = HTNull
      THEN  iHti _ HTNull
      ELSE {
	SubStringForHash[s, hti];
	iHti _ iBase.FindString[s];
	IF iHti = HTNull THEN ERROR MissingHti};
    RETURN};


  FindExternalCtx: PUBLIC PROC [mdi: MDIndex, iCtx: CTXIndex]
      RETURNS [ctx: IncludedCTXIndex] = {
    IF mdi # MDNull AND OpenIncludedTable[mdi]
      THEN  {ctx _ MapCtx[mdi, iCtx]; CloseIncludedTable[]}
      ELSE  ctx _ IncludedCTXNull;
    RETURN};

  MapCtx: PROC [mdi: MDIndex, iCtx: CTXIndex] RETURNS [IncludedCTXIndex] = {
    ctx, last: IncludedCTXIndex;
    target: CTXIndex;
    mdRoot: MDIndex;
    IF iCtx = CTXNull
      THEN {mdRoot _ mdi; target _ CTXNull; last _ IncludedCTXNull}
      ELSE {
	WITH iCtxb[iCtx] SELECT FROM
	  included => [mdRoot, target] _ IncludedTargets[LOOPHOLE[iCtx]];
--	  imported => {
--	    IF iBase.mdb[iCtxb[includeLink].module].defaultImport # iCtx
--	      THEN  ERROR;	 need a signal to raise
--	    [mdRoot, target] _ IncludedTargets[includeLink]};
	  ENDCASE => {mdRoot _ mdi; target _ iCtx};
	last _ IncludedCTXNull;
	FOR ctx _ mdb[mdRoot].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull
	  DO
	  IF ctxb[ctx].map = target THEN RETURN [ctx];
	  last _ ctx;
	  ENDLOOP};
    ctx _ Table.Allocate[ctxType, SIZE[included CTXRecord]];
    ctxb[ctx] _ CTXRecord[
	mark: FALSE,  varUpdated: FALSE,
	seList: ISENull,
	level: IF iCtx = CTXNull THEN lZ ELSE iCtxb[iCtx].level,
	extension: included[
	  chain:  IncludedCTXNull,
	  module: mdRoot,
	  map:  target,
	  restricted: FALSE,  complete: FALSE,
	  closed: FALSE,  reset: FALSE]];
    IF last = IncludedCTXNull THEN mdb[mdRoot].ctx _ ctx ELSE ctxb[last].chain _ ctx;
    RETURN [ctx]};

  InverseMapCtx: PROC [ctx: CTXIndex] RETURNS [mdi: MDIndex, iCtx: CTXIndex] = {
    WITH ctxb[ctx] SELECT FROM
      included =>  {mdi _ module; iCtx _ map};
      imported =>  [mdi, iCtx] _ InverseMapCtx[includeLink];
      ENDCASE =>  {mdi _ OwnMdi; iCtx _ ctx};
    RETURN};


  IncludedTargets: PROC [iCtx: IncludedCTXIndex]
      RETURNS [mdi: MDIndex, ctx: CTXIndex] = {
    oldMdi: MDIndex = iCtxb[iCtx].module;
    desc: SubStringDescriptor;
    s: SubString = @desc;
    iBase.SubStringForHash[s, iBase.mdb[oldMdi].fileId];
    mdi _ Copier.FindMdEntry[
	    id: MapHti[iBase.mdb[oldMdi].moduleId],
	    version: iBase.mdb[oldMdi].stamp,
	    file: MapHti[iBase.mdb[oldMdi].fileId]];
    ctx _ iCtxb[iCtx].map;
    RETURN};


  UnknownModule: PUBLIC SIGNAL [HTIndex] = CODE;

  DummyCtxSe: PROC [sei: ISEIndex] = {
    seb[sei].idType _ typeANY;  seb[sei].idInfo _ seb[sei].idValue _ 0;
    seb[sei].extended _ seb[sei].public _ seb[sei].linkSpace _ FALSE;
    seb[sei].immutable _ seb[sei].constant _ TRUE;
    seb[sei].mark3 _ seb[sei].mark4 _ TRUE};


 -- caching of (cons) types

  TypeCacheSize: CARDINAL = 83;		-- prime < 256/3
  TypeCacheIndex: TYPE = [0..TypeCacheSize);
  TypeCache: TYPE = ARRAY TypeCacheIndex OF RECORD [
    mdi: MDIndex,  iSei: SEIndex,	-- the search keys
    sei: SEIndex];			-- the result

  typeCache: POINTER TO TypeCache;

  TypeHash: PROC [mdi: MDIndex, iSei: SEIndex] RETURNS [TypeCacheIndex] =  INLINE {
    RETURN [(LOOPHOLE[mdi,CARDINAL]*LOOPHOLE[iSei,CARDINAL]) MOD TypeCacheSize]};


 -- copying symbols

  CopyIncludedSymbol: PROC [iSei: SEIndex, mdi: MDIndex, compressed: BOOLEAN _ FALSE]
    RETURNS [sei: SEIndex] = {
    IF iSei = SENull THEN RETURN [SENull];
    WITH iSeb[iSei] SELECT FROM
      id => {
	ctx: IncludedCTXIndex;
	hti: HTIndex;
	iMdi: MDIndex;
	tSei: ISEIndex;
	IF idCtx IN (CTXNull .. LAST[StandardContext]] AND ~compressed THEN RETURN [iSei];
	ctx _ MapCtx[mdi, idCtx];
	hti _ MapHti[hash];
	sei _ tSei _ SearchContext[hti, ctx];
	IF sei # SENull
	  THEN seb[tSei].idCtx _ ctx
	  ELSE {
	    iMdi _ ctxb[ctx].module;
	    IF iMdi = mdi OR ~mdb[iMdi].shared
	      THEN sei _ CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, mdi]
	      ELSE {
		CloseIncludedTable[];
		IF OpenIncludedTable[iMdi]
		  THEN iSei _ iBase.SearchContext[InverseMapHti[hti], ctxb[ctx].map]
		  ELSE [] _ OpenIncludedTable[iMdi_mdi];
		sei _ CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, iMdi];
		CloseIncludedTable[];
		[] _ OpenIncludedTable[mdi]}}};
      cons =>
	SELECT typeTag FROM
	  mode =>  sei _ typeTYPE;
	  basic =>  sei _ iSei;
	  transfer =>  sei _ CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi];
	  ENDCASE => {
	    i: TypeCacheIndex = TypeHash[mdi, iSei];
	    IF typeCache # NIL AND typeCache[i].iSei = iSei AND typeCache[i].mdi = mdi
	      THEN sei _ typeCache[i].sei
	      ELSE {
		sei _ CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi];
		IF typeCache # NIL THEN typeCache[i] _ [mdi:mdi, iSei:iSei, sei:sei]}};
      ENDCASE;
    RETURN};


  CopyCtxSe: PROC [iSei: ISEIndex, hti: HTIndex, ctx: CTXIndex, mdi: MDIndex]
      RETURNS [sei: ISEIndex] = {
    sei _ MakeCtxSe[hti, ctx]; CopyCtxSeInfo[sei, iSei, mdi]; RETURN};

  CopyCtxSeInfo: PROC [sei, iSei: ISEIndex, mdi: MDIndex] = {
    OPEN id: seb[sei];
    IF iSeb[iSei].idCtx = CTXNull THEN id.idCtx _ CTXNull;
    id.extended _ iSeb[iSei].extended;
    id.public _ iSeb[iSei].public;
    id.immutable _ iSeb[iSei].immutable;
    id.constant _ iSeb[iSei].constant;
    id.linkSpace _ iSeb[iSei].linkSpace;
    id.idType _ CopyIncludedSymbol[iSeb[iSei].idType, mdi];
    IF iSeb[iSei].idType = typeTYPE
      THEN id.idInfo _ CopyIncludedSymbol[iSeb[iSei].idInfo, mdi]
      ELSE IF iSeb[iSei].constant AND
	 (SELECT iBase.XferMode[iSeb[iSei].idType] FROM
	  proc, program => TRUE,
	  ENDCASE => FALSE)
	THEN id.idInfo _ CopyIncludedBody[iSeb[iSei].idInfo, sei, mdi]
	ELSE id.idInfo _ iSeb[iSei].idInfo;
    id.idValue _ iSeb[iSei].idValue;
    id.mark3 _ id.mark4 _ TRUE;
    IF id.extended
      THEN  CopyExtension[sei, iSei, mdi]};
--      ELSE IF id.linkSpace THEN id.idInfo _ 0};


  currentBody: BTIndex;

  CopyExtension: PROC [sei, iSei: ISEIndex, mdi: MDIndex] = {
    iType: ExtensionType;
    iTree: Tree.Link;
    saveCurrentBody: BTIndex = currentBody;
    currentBody _ BTNull;
    [iType, iTree] _ iBase.FindExtension[iSei];
    WITH iTree SELECT FROM
      subtree =>  IF iBase.tb[index].name = body THEN currentBody _ seb[sei].idInfo;
      ENDCASE;
    EnterExtension[sei, iType, InputExtension[iTree, mdi]];
    currentBody _ saveCurrentBody};

  InputExtension: PROC [t: Tree.Link, mdi: MDIndex] RETURNS [Tree.Link] = {

    InputTree: Tree.Map = {
      WITH link: t SELECT FROM
	hash => v _ [hash[index: MapHti[link.index]]];
	symbol => v _ [symbol[index: LOOPHOLE[CopyIncludedSymbol[link.index, mdi]]]];
	literal => v _ InputLiteral[link];
	subtree => {
	  iNode: Tree.Index = link.index;
	  v _ SELECT iBase.tb[iNode].name FROM
	    block => InputBlock[iNode],
	    IN [forseq .. downthru] => InputBlock[iNode],
	    openx =>
	      TreeOps.CopyTree[[baseP:@iBase.tb, link:iBase.tb[iNode].son[1]], InputTree],
	    ENDCASE => TreeOps.CopyTree[[baseP:@iBase.tb, link:link], InputTree];
	  WITH v SELECT FROM
	    subtree => {
	      node: Tree.Index = index;
	      SELECT tb[node].name FROM
		body => tb[node].info _ currentBody;
		block => ExitBlock[node];
		IN [basicTC..discrimTC], cdot,
		IN [callx..typecode], exlist => {
		  tb[node].info _ CopyIncludedSymbol[iBase.tb[iNode].info, mdi];
		  SELECT tb[node].name FROM
		    construct, exlist => FillRecord[tb[node].info, mdi];
		    union =>
		      WITH tb[node].son[1] SELECT FROM
			symbol =>  FillRecord[UnderType[index], mdi];
			ENDCASE => ERROR;
		    ENDCASE};
		IN [forseq..downthru] => NULL;
		do => {
		  tb[node].info _ LAST[CARDINAL];
		  IF TreeOps.OpName[tb[node].son[1]] IN [forseq..downthru]
		    THEN ExitBlock[TreeOps.GetNode[tb[node].son[1]]]};
 		IN [assign..join] => tb[node].info _ LAST[CARDINAL];
		ENDCASE => NULL};
	    ENDCASE => NULL};
	ENDCASE => ERROR;
      RETURN};

    InputLiteral: PROC [t: literal Tree.Link] RETURNS [Tree.Link] = {
      WITH t.info SELECT FROM
	word => index _ LiteralOps.CopyLiteral[[baseP:@iBase.ltb, index:index]];
	ENDCASE => ERROR;
      RETURN [t]};

    InputBlock: PROC [iNode: Tree.Index] RETURNS [v: Tree.Link] = {
      OPEN TreeOps;
      iBti: BTIndex = iBase.tb[iNode].info;
      n: CARDINAL = iBase.tb[iNode].nSons;
      bti: BTIndex;
      IF iBti = BTNull
	THEN bti _ BTNull
	ELSE {
	  ctx: IncludedCTXIndex = MapCtx[mdi, iBase.bb[iBti].localCtx];
	  bti _ Table.Allocate[bodyType, SIZE[Other BodyRecord]];
	  bb[bti] _ BodyRecord[
			link: ,
			firstSon: BTNull,
			type: RecordSENull,
			localCtx: ctx,  level: iBase.bb[iBti].level,
			sourceIndex: LAST[CARDINAL],  info: ,
			extension: Other[relOffset: ]];
	  LinkBti[bti: bti, parent: currentBody];  currentBody _ bti};
      FOR i: CARDINAL IN [1 .. n] DO PushTree[InputTree[iBase.tb[iNode].son[i]]] ENDLOOP;
      PushNode[iBase.tb[iNode].name, n];
      SetAttr[1, iBase.tb[iNode].attr1]; SetAttr[2, iBase.tb[iNode].attr2];
      SetAttr[3, iBase.tb[iNode].attr3];  SetInfo[bti];  v _ PopTree[];
      IF bti # BTNull
	THEN bb[bti].info _ BodyInfo[Internal[
			bodyTree: GetNode[v], thread: Tree.NullIndex, frameSize: ]];
      RETURN};

    ExitBlock: PROC [node: Tree.Index] = INLINE {
      IF tb[node].info # BTNull THEN currentBody _ ParentBti[tb[node].info]};

    RETURN [InputTree[t]]};


  CopyExternalBody: PUBLIC PROC [mdi: MDIndex, iBti: CBTIndex]
      RETURNS [bti: CBTIndex] = {
    IF iBti # CBTNull AND mdi # MDNull AND OpenIncludedTable[mdi]
      THEN {
	sei: ISEIndex;
	iSei: ISEIndex = iBase.bb[iBti].id;
	IF iSei # ISENull
	  THEN {sei _ LOOPHOLE[CopyIncludedSymbol[iSei, mdi, TRUE]]; bti _ seb[sei].idInfo}
	  ELSE  bti _ CopyIncludedBody[iBti, ISENull, mdi];
	CloseIncludedTable[]}
      ELSE bti _ CBTNull;
    RETURN};

  CopyIncludedBody: PROC [iBti: CBTIndex, sei: ISEIndex, mdi: MDIndex]
      RETURNS [bti: CBTIndex] = {
    iCtx: CTXIndex;
    IF iBti = BTNull
      THEN bti _ CBTNull
      ELSE {
	iCtx _ iBase.bb[iBti].localCtx;
	WITH body: iBase.bb[iBti] SELECT FROM
	  Outer => {
	    bti _ Table.Allocate[bodyType, SIZE[Outer Callable BodyRecord]];
	    bb[LOOPHOLE[bti, OCBTIndex]] _ body};
	  Inner => {
	    bti _ Table.Allocate[bodyType, SIZE[Inner Callable BodyRecord]];
	    bb[LOOPHOLE[bti, ICBTIndex]] _ body};
	  ENDCASE => ERROR;
	bb[bti].link _ [parent, BTNull];  bb[bti].firstSon _ BTNull;
	bb[bti].id _ sei;
	IF iBase.bb[iBti].inline
	  THEN {
	    bb[bti].ioType _ CopyBodyType[iBase.bb[iBti].ioType, mdi];
	    WITH body: bb[bti].info SELECT FROM
	      Internal =>  body.thread _ body.bodyTree _ Tree.NullIndex;
	      ENDCASE}
	  ELSE
	    bb[bti].ioType _ IF sei = ISENull OR seb[seb[sei].idType].seTag = id
		THEN CopyBodyType[iBase.bb[iBti].ioType, mdi]
		ELSE UnderType[seb[sei].idType];
	bb[bti].localCtx _ IF iCtx = CTXNull THEN CTXNull ELSE MapCtx[mdi, iCtx]};
    RETURN};


  CopyNonCtxSe: PROC [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = {
    tSei1, tSei2: SEIndex;
    WITH  iType: iSeb[iSei] SELECT FROM
      enumerated => {
	tCtx: CTXIndex;
	sei _ MakeNonCtxSe[SIZE[enumerated cons SERecord]];
	tCtx _ IF iType.valueCtx IN StandardContext
			THEN  iType.valueCtx
			ELSE  CopyIncludedValues[iType.valueCtx, mdi, sei];
	seb[sei].typeInfo _ enumerated[
	    ordered: iType.ordered,
	    machineDep: iType.machineDep,
	    sparse: iType.sparse,
	    valueCtx: tCtx,
	    nValues: iType.nValues]};
      record => {
	tCtx: CTXIndex = IF iType.fieldCtx IN StandardContext
		  	THEN  iType.fieldCtx
		  	ELSE  MapCtx[mdi, iType.fieldCtx];
	WITH iType SELECT FROM
	  notLinked => {
	    sei _ MakeNonCtxSe[SIZE[notLinked record cons SERecord]];
	    seb[sei].typeInfo _ record[
		machineDep: iType.machineDep,
		painted: iType.painted,
		argument: iType.argument,
		hints: iType.hints,
		fieldCtx: tCtx,
		length: iType.length,
		monitored: iType.monitored,
		linkPart: notLinked[]]};
	  linked => {
	    sei _ MakeNonCtxSe[SIZE[linked record cons SERecord]];
	    tSei1 _ CopyIncludedSymbol[linkType, mdi];
	    seb[sei].typeInfo _ record[
		machineDep: iType.machineDep,
		painted: iType.painted,
		argument: iType.argument,
		hints: iType.hints,
		fieldCtx: tCtx,
		length: iType.length,
		monitored: iType.monitored,
		linkPart: linked[linkType: tSei1]]};
	  ENDCASE};
      ref => {
	sei _ MakeNonCtxSe[SIZE[ref cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.refType, mdi];
	seb[sei].typeInfo _ ref[
	    refType: tSei1,
	    counted: iType.counted,
	    readOnly: iType.readOnly,
	    ordered: iType.ordered,
	    list: iType.list,
	    basing: iType.basing]};
      array => {
	sei _ MakeNonCtxSe[SIZE[array cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.indexType, mdi];
	tSei2 _ CopyIncludedSymbol[iType.componentType, mdi];
	seb[sei].typeInfo _ array[
	    packed: iType.packed,
	    indexType: tSei1,
	    componentType: tSei2]};
      arraydesc => {
	sei _ MakeNonCtxSe[SIZE[arraydesc cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.describedType, mdi];
	seb[sei].typeInfo _ arraydesc[
	    readOnly: iType.readOnly,
	    describedType: tSei1]};
      transfer => {
	rSei1, rSei2: RecordSEIndex;
	sei _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
	rSei1 _ CopyArgRecord[iType.inRecord, mdi, FALSE];
	rSei2 _ CopyArgRecord[iType.outRecord, mdi, FALSE];
	seb[sei].typeInfo _ transfer[
	    mode: iType.mode,
	    inRecord: rSei1,
	    outRecord: rSei2]};
      definition => {
	sei _ MakeNonCtxSe[SIZE[definition cons SERecord]];
	seb[sei].typeInfo _ definition[
		nGfi: iType.nGfi,
		named: iType.named,
		defCtx: MapCtx[mdi, iType.defCtx]]};
      union => {
	tag: ISEIndex;
	tCtx: CTXIndex;
	sei _ MakeNonCtxSe[SIZE[union cons SERecord]];
	tCtx _ MapCtx[mdi, iType.caseCtx];
	tag _ CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi];
	seb[sei].typeInfo _ union[
	    caseCtx: tCtx,
	    machineDep: iType.machineDep,
	    overlaid: iType.overlaid,
	    controlled: iType.controlled,
	    tagSei: tag,
	    hints: iType.hints]};
      sequence => {
	tag: ISEIndex;
	tSei1 _ CopyIncludedSymbol[iType.componentType, mdi];
	sei _ MakeNonCtxSe[SIZE[sequence cons SERecord]];
	tag _ CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi];
	seb[sei].typeInfo _ sequence[
	    packed: iType.packed,
	    controlled: iType.controlled,
	    machineDep: iType.machineDep,
	    tagSei: tag,
	    componentType: tSei1]};
      relative => {
	tSei3: SEIndex;
	sei _ MakeNonCtxSe[SIZE[relative cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.baseType, mdi];
	tSei2 _ CopyIncludedSymbol[iType.offsetType, mdi];
	tSei3 _ IF iType.resultType = iType.offsetType
		  THEN tSei2
		  ELSE CopyIncludedSymbol[iType.resultType, mdi];
	seb[sei].typeInfo _ relative[
		baseType: tSei1,
		offsetType: tSei2,
		resultType: tSei3]};
      opaque => {
	sei _ MakeNonCtxSe[SIZE[opaque cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.id, mdi];
	seb[sei].typeInfo _ opaque[
		lengthKnown: iType.lengthKnown,
		length: iType.length,
		id: LOOPHOLE[tSei1]]};
      zone => {
	sei _ MakeNonCtxSe[SIZE[zone cons SERecord]];
	seb[sei].typeInfo _ zone[mds: iType.mds, counted: iType.counted]};
      subrange => {
	sei _ MakeNonCtxSe[SIZE[subrange cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.rangeType, mdi];
	seb[sei].typeInfo _ subrange[
	    filled: iType.filled,
	    empty: iType.empty,
	    rangeType: tSei1,
	    origin: iType.origin,
	    range: iType.range]};
      long => {
	sei _ MakeNonCtxSe[SIZE[long cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.rangeType, mdi];
	seb[sei].typeInfo _ long[rangeType: tSei1]};
      real => {
	sei _ MakeNonCtxSe[SIZE[real cons SERecord]];
	tSei1 _ CopyIncludedSymbol[iType.rangeType, mdi];
	seb[sei].typeInfo _ real[rangeType: tSei1]};
      any => {
	sei _ MakeNonCtxSe[SIZE[any cons SERecord]];  seb[sei].typeInfo _ any[]};
      ENDCASE => ERROR;
    seb[sei].mark3 _ seb[sei].mark4 _ TRUE;  RETURN};


  CopyBodyType: PROC [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = {
    rSei1, rSei2: RecordSEIndex;
    WITH iType: iSeb[iSei] SELECT FROM
      transfer => {
	sei _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
	rSei1 _ CopyArgRecord[iType.inRecord, mdi, TRUE];
	rSei2 _ CopyArgRecord[iType.outRecord, mdi, TRUE];
	seb[sei].typeInfo _ transfer[
	    mode: iType.mode,
	    inRecord: rSei1,
	    outRecord: rSei2]};
      ENDCASE => ERROR;
    seb[sei].mark3 _ seb[sei].mark4 _ TRUE;  RETURN};

  CopyArgRecord: PROC [irSei: RecordSEIndex, mdi: MDIndex, mapped: BOOLEAN]
      RETURNS [rSei: RecordSEIndex] = {
    ctx, iCtx: CTXIndex;
    sei, iSei, seChain: ISEIndex;
    i: TypeCacheIndex;
    IF irSei = SENull
      THEN rSei _ RecordSENull
      ELSE {
	rSei _ LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]];
	iCtx _ iSeb[irSei].fieldCtx;
	IF ~mapped
	  THEN  ctx _ NewCtx[iCtxb[iCtx].level]
	  ELSE {
	    tCtx: IncludedCTXIndex = MapCtx[mdi, iCtx];
	    ctxb[tCtx].complete _ TRUE; ResetCtx[tCtx]; ctx _ tCtx};
	IF ctxb[ctx].seList = ISENull
	  THEN {
	    seChain _ MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE];
	    ctxb[ctx].seList _ seChain;
	    FOR iSei _ iCtxb[iCtx].seList, iBase.NextSe[iSei] UNTIL iSei = ISENull
	      DO
	      sei _ seChain;  seChain _ NextSe[seChain];
	      seb[sei].hash _ MapHti[iSeb[iSei].hash];
	      CopyCtxSeInfo[sei, iSei, mdi];
	      ENDLOOP};
	seb[rSei] _ SERecord[
		mark3: TRUE,
		mark4: TRUE,
		body: cons[
		  record[
		    machineDep: FALSE,
		    painted: FALSE, argument: TRUE,
		    hints: iSeb[irSei].hints,
		    fieldCtx: ctx,
		    length: iSeb[irSei].length,
		    monitored: FALSE,
		    linkPart: notLinked[]]]];
	i _ TypeHash[mdi, irSei];
	IF typeCache # NIL THEN typeCache[i] _ [mdi:mdi, iSei:irSei, sei:rSei]};
    RETURN};


  CopyIncludedValues: PROC [iCtx: CTXIndex, mdi: MDIndex, type: SEIndex]
      RETURNS [ctx: IncludedCTXIndex] = {
    iSei, sei, seChain: ISEIndex;
    ctx _ MapCtx[mdi, iCtx];
    iSei _ iCtxb[iCtx].seList;
    IF iSei # SENull AND iSeb[iSeb[iSei].idType].seTag # id
      THEN {
	seChain _ MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE];
	ctxb[ctx].seList _ seChain;
	ctxb[ctx].closed _ ctxb[ctx].reset _ TRUE;
	UNTIL iSei = SENull
	  DO
	  sei _ seChain;  seChain _ NextSe[seChain];
	  seb[sei].hash _ MapHti[iSeb[iSei].hash];
	  seb[sei].extended _ seb[sei].linkSpace _ FALSE;
	  seb[sei].immutable _ seb[sei].constant _ TRUE;
	  seb[sei].public _ iSeb[iSei].public;
	  seb[sei].idType _ type;  seb[sei].idInfo _ 0;
	  seb[sei].idValue _ iSeb[iSei].idValue;
	  seb[sei].mark3 _ seb[sei].mark4 _ TRUE;
	  iSei _ iBase.NextSe[iSei];
	  ENDLOOP;
	ctxb[ctx].complete _ TRUE};
    RETURN};


 -- included module accounting

  ResetCtx: PROC [ctx: IncludedCTXIndex] = {
    IF ~ctxb[ctx].reset THEN {ResetCtxList[ctx]; ctxb[ctx].closed _ ctxb[ctx].reset _ TRUE}};

  ResetIncludeContexts: PROC = {
    mdi: MDIndex;
    limit: MDIndex = LOOPHOLE[Table.Bounds[mdType].size];
    ctx: IncludedCTXIndex;
    FOR mdi _ FIRST[MDIndex], mdi + SIZE[MDRecord] UNTIL mdi = limit
      DO
      FOR ctx _ mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull
	DO  ResetCtx[ctx]  ENDLOOP;
      ENDLOOP;
    ResetCaches[]};

  WrongTable: ERROR = CODE;

  Outer: PUBLIC PROC [mdi: MDIndex, inner: PROC [SymbolTable.Base]] = {
    IF mdi = LOOPHOLE[0] THEN ERROR WrongTable;
    IF mdi # MDNull AND OpenIncludedTable[mdi]
      THEN {inner[iBase ! UNWIND => CloseIncludedTable[]]; CloseIncludedTable[]}};


  TableRelocated: PUBLIC SIGNAL = CODE;

  OpenIncludedTable: PROC [mdi: MDIndex] RETURNS [success: BOOLEAN] = {
    base: SymbolTable.Base =
	IF mdi = OwnMdi THEN ownSymbols ELSE Copier.GetSymbolTable[mdi];
    IF success _ (base # NIL)
      THEN  {iBase _ base; IF mdi # OwnMdi THEN iBase.notifier _ IRelocNotify; INotify[]};
    RETURN};

  IRelocNotify: PROC [base: SymbolTable.Base] = {
    IF base = iBase THEN {INotify[]; SIGNAL TableRelocated}};

  CloseIncludedTable: PROC = {
    IF iBase # ownSymbols
      THEN {iBase.notifier _ iBase.NullNotifier; Copier.FreeSymbolTable[iBase]};
    iBase _ NIL};

  END.