-- file SymbolCopier.Mesa
-- last modified by Satterthwaite, October 31, 1979  1:12 PM

DIRECTORY
  Copier: FROM "copier"
    USING [FindMdEntry, FreeSymbolTable, GetSymbolTable, HtiToMdi],
  InlineDefs: FROM "inlinedefs" USING [LongDivMod, LongMult],
  LiteralOps: FROM "literalops" USING [CopyLiteral],
  StringDefs: FROM "stringdefs" USING [SubString, SubStringDescriptor],
  SymbolTable: FROM "symboltable" USING [Base, SetCacheSize],
  Symbols: FROM "symbols",
  SymbolOps: FROM "symbolops"
    USING [
      CtxEntries, EnterExtension, EnterString, LinkBti, MakeCtxSe,
      MakeNonCtxSe, MakeSeChain, NewCtx, NextSe, ParentBti,
      ResetCtxList, SearchContext, SetSeLink, SubStringForHash, UnderType],
  SystemDefs: FROM "systemdefs" USING [AllocateSegment, FreeSegment],
  Table: FROM "table"
    USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify],
  Tree: FROM "tree" USING [treeType, Index, Link, Map, NullIndex],
  TreeOps: FROM "treeops"
    USING [CopyTree, GetNode, PopTree, PushNode, PushTree, SetAttr, SetInfo];

SymbolCopier: PROGRAM
    IMPORTS
      Copier, InlineDefs, LiteralOps,
      SymbolTable, SymbolOps, SystemDefs, Table, TreeOps
    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 =
    BEGIN  -- called whenever the main symbol table is repacked
    seb ← base[seType]; ctxb ← base[ctxType];
    mdb ← base[mdType];  bb ← base[bodyType];
    tb ← base[Tree.treeType];
    END;

   
 -- table bases for the current include module

  iBase: SymbolTable.Base;

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

  INotify: PROCEDURE =
    BEGIN  -- called whenever iBase switches or tables moved
    iHt ← iBase.ht;  iSeb ← iBase.seb;  iCtxb ← iBase.ctxb;
    END;


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

  memoCache: POINTER TO SearchCache;


 -- initialization/finalization

  CopierInit: PUBLIC PROCEDURE =
    BEGIN
    Table.AddNotify[CopierNotify];
    memoCache ← SystemDefs.AllocateSegment[SIZE[SearchCache]];
    memoCache↑ ← ALL[ [hti:HTNull, ctx:CTXNull] ];
    typeCache ← SystemDefs.AllocateSegment[SIZE[TypeCache]];
    typeCache↑ ← ALL[ [mdi:MDNull, iSei:SENull, sei: SENull] ];
    SymbolTable.SetCacheSize[100];
    currentBody ← BTNull;
    END;

  ResetCaches: PROCEDURE = INLINE	-- see ResetIncludeContexts
    BEGIN
    SymbolTable.SetCacheSize[0];
    SystemDefs.FreeSegment[typeCache];
    SystemDefs.FreeSegment[memoCache];
    END;

  CopierReset: PUBLIC PROCEDURE = BEGIN Table.DropNotify[CopierNotify] END;


 -- copying within current table

  CopyXferType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [copy: CSEIndex] =
    BEGIN
    WITH master: seb[type] SELECT FROM
      transfer =>
	BEGIN
	copy ← MakeNonCtxSe[SIZE[transfer cons SERecord]];
	seb[copy].mark3 ← master.mark3;  seb[copy].mark4 ← master.mark4;
	seb[copy] ← SERecord[
	    mark3: master.mark3, mark4: master.mark4,
	    body: cons[transfer[
		mode: master.mode,
		inRecord: CopyArgs[master.inRecord],
		outRecord: CopyArgs[master.outRecord]]]];
	END;
      ENDCASE => copy ← typeANY;
    RETURN
    END;

  CopyArgs: PROCEDURE [rSei: RecordSEIndex] RETURNS [copy: RecordSEIndex] =
    BEGIN
    ctx1, ctx2: CTXIndex;
    sei1, sei2, seChain: ISEIndex;
    IF rSei = RecordSENull
      THEN copy ← RecordSENull
      ELSE
	BEGIN
	copy ← LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]];
	ctx1 ← seb[rSei].fieldCtx;  ctx2 ← NewCtx[ctxb[ctx1].level];
	seChain ← MakeSeChain[ctx2, CtxEntries[ctx1], FALSE];
	sei1 ← ctxb[ctx1].seList;
	sei2 ← ctxb[ctx2].seList ← seChain;
	UNTIL sei1 = SENull
	  DO
	  CopyArgSe[sei2, sei1]; sei1 ← NextSe[sei1];  sei2 ← NextSe[sei2];
	  ENDLOOP;
	seb[copy] ← SERecord[mark3: seb[rSei].mark3, mark4: seb[rSei].mark4,
		body: cons[
		  record[
		    machineDep: FALSE,
		    argument: TRUE,
		    hints: seb[rSei].hints,
		    fieldCtx: ctx2,
		    length: seb[rSei].length,
		    lengthUsed: FALSE,
		    monitored: FALSE,
		    linkPart: notLinked[]]]];
	END;
    RETURN
    END;

  CopyArgSe: PUBLIC PROCEDURE [copy, master: ISEIndex] =
    BEGIN
    seb[copy].hash ← seb[master].hash;
    seb[copy].extended ← FALSE;
    seb[copy].public ← seb[master].public;
    seb[copy].immutable ← seb[master].immutable;
    seb[copy].constant ← seb[master].constant;
    seb[copy].linkSpace ← seb[master].linkSpace;
    seb[copy].idType ← seb[master].idType;
    seb[copy].idInfo ←  seb[master].idInfo;
    seb[copy].idValue ← seb[master].idValue;
    seb[copy].mark3 ← seb[master].mark3; seb[copy].mark4 ← seb[master].mark4;
    END;


 -- copying across table boundaries

  SubString: TYPE = StringDefs.SubString;
  SubStringDescriptor: TYPE = StringDefs.SubStringDescriptor;


  SearchFileCtx: PUBLIC PROCEDURE [hti: HTIndex, ctx: IncludedCTXIndex]
      RETURNS [found: BOOLEAN, sei: ISEIndex] =
    BEGIN
    desc: SubStringDescriptor;
    s: SubString = @desc;
    hash: [0..MemoCacheSize);
    iHti: HTIndex;
    iSei: ISEIndex;
    mdi: MDIndex = ctxb[ctx].module;
    ignorePrivate: BOOLEAN = mdb[mdi].shared;
    SubStringForHash[s, hti];
    hash ← InlineDefs.LongDivMod[
		InlineDefs.LongMult[LOOPHOLE[hti], LOOPHOLE[ctx]],
		MemoCacheSize].remainder;
    IF memoCache[hash].hti = hti AND memoCache[hash].ctx = ctx
      THEN RETURN [FALSE, ISENull];
    IF OpenIncludedTable[mdi]
      THEN
	BEGIN
	iHti ← iBase.FindString[s];
	IF iHti # HTNull
	  AND
	 (iHt[iHti].anyPublic OR (ignorePrivate AND iHt[iHti].anyInternal))
	  THEN
	    BEGIN
	    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];
	    END
	  ELSE found ← FALSE;
	CloseIncludedTable[];
	END
      ELSE  BEGIN  found ← FALSE;  sei ← ISENull  END;
    IF ~found THEN  memoCache[hash] ← [hti:hti, ctx:ctx];
    RETURN
    END;


  CompleteContext: PUBLIC PROCEDURE [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] =
    BEGIN
    IF ~ctxb[ctx].reset AND OpenIncludedTable[ctxb[ctx].module]
      THEN  BEGIN FillContext[ctx, ignorePrivate]; CloseIncludedTable[] END;
    END;


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


  FillContext: PROCEDURE [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] =
    BEGIN
    sei, iSei, pSei: ISEIndex;
    complete: BOOLEAN;
    mdi: MDIndex = ctxb[ctx].module;
    hti: HTIndex;
    ignorePrivate ← ignorePrivate OR mdb[mdi].shared;
    complete ← TRUE;  pSei ← ISENull;
    FOR iSei ← iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = SENull
      DO
      IF ~(iSeb[iSei].public OR ignorePrivate)
	THEN  complete ← FALSE
	ELSE
	  BEGIN  hti ← MapHti[iSeb[iSei].hash];
	  sei ← SearchContext[hti, ctx];
	  IF sei = SENull THEN sei ← CopyCtxSe[iSei, hti, ctx, mdi];
	  IF pSei # SENull AND NextSe[pSei] # sei
	    THEN
	      BEGIN
	      Delink[sei]; SetSeLink[sei, NextSe[pSei]]; SetSeLink[pSei, sei];
	      END;
	  ctxb[ctx].seList ← pSei ← sei;
	  END;
      ENDLOOP;
    ResetCtx[ctx];  ctxb[ctx].complete ← complete;
    END;

  Delink: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN
    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
	BEGIN
	IF sei = ctxb[ctx].seList THEN ctxb[ctx].seList ← prev;
	SetSeLink[prev, NextSe[sei]];
	END;
    SetSeLink[sei, ISENull];
    END;

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


  MapHti: PROCEDURE [iHti: HTIndex] RETURNS [hti: HTIndex] =
    BEGIN
    desc: SubStringDescriptor;
    s: SubString = @desc;
    IF iHti = HTNull
      THEN  hti ← HTNull
      ELSE
	BEGIN
	iBase.SubStringForHash[s, iHti];
	hti ← EnterString[s ! TableRelocated => s.base ← iBase.ssb];
	END;
    RETURN
    END;

  MissingHti: ERROR = CODE;

  InverseMapHti: PROCEDURE [hti: HTIndex] RETURNS [iHti: HTIndex] =
    BEGIN
    -- N.B.  assumes that the included table has been selected
    desc: SubStringDescriptor;
    s: SubString = @desc;
    IF hti = HTNull
      THEN  iHti ← HTNull
      ELSE
	BEGIN
	SubStringForHash[s, hti];
	iHti ← iBase.FindString[s];
	IF iHti = HTNull THEN ERROR MissingHti;
	END;
    RETURN
    END;


  FindIncludedCtx: PUBLIC PROCEDURE [mdi: MDIndex, iCtx: CTXIndex] RETURNS [IncludedCTXIndex] =
    BEGIN
    ctx, last: IncludedCTXIndex;
    target: CTXIndex;
    mdRoot: MDIndex;
    WITH iCtxb[iCtx] SELECT FROM
      included =>  [mdRoot, target] ← IncludedTargets[LOOPHOLE[iCtx]];
      imported =>
	BEGIN
	IF iBase.mdb[iCtxb[includeLink].module].defaultImport # iCtx
	  THEN  ERROR;	-- need a signal to raise
	[mdRoot, target] ← IncludedTargets[includeLink];
	END;
      ENDCASE =>  BEGIN  mdRoot ← mdi;  target ← iCtx  END;
    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: iCtxb[iCtx].level,
	extension: included[
	  chain:  IncludedCTXNull,
	  module: mdRoot,
	  map:  target,
	  restricted: FALSE,
	  complete: FALSE,
	  closed: FALSE,
	  reset: FALSE]];
    IF last = CTXNull THEN mdb[mdRoot].ctx ← ctx ELSE ctxb[last].chain ← ctx;
    RETURN [ctx]
    END;

  IncludedTargets: PROCEDURE [iCtx: IncludedCTXIndex] RETURNS [mdi: MDIndex, ctx: CTXIndex] =
    BEGIN
    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
    END;


  UnknownModule: PUBLIC SIGNAL [HTIndex] = CODE;

  FillModule: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN
    mdi: MDIndex = Copier.HtiToMdi[seb[sei].hash];
    iHti: HTIndex;
    iSei: ISEIndex;
    IF mdi = MDNull OR ~OpenIncludedTable[mdi]
      THEN DummyCtxSe[sei]
      ELSE
	BEGIN
	  BEGIN
	  iHti ← InverseMapHti[seb[sei].hash !MissingHti => GO TO failed];
	  iSei ← iBase.SearchContext[iHti, iBase.stHandle.directoryCtx];
	  IF iSei = SENull OR ~iSeb[iSei].public THEN GO TO failed;
	  CopyCtxSeInfo[sei, iSei, mdi];  seb[sei].public ← FALSE;
	  EXITS
	    failed =>
	      BEGIN SIGNAL UnknownModule[seb[sei].hash]; DummyCtxSe[sei] END;
	  END;
	CloseIncludedTable[];
	END;
    END;

  DummyCtxSe: PROCEDURE [sei: ISEIndex] =
    BEGIN OPEN seb[sei];
    idType ← typeANY;  idInfo ← idValue ← 0;
    extended ← public ← linkSpace ← FALSE;
    mark3 ← mark4 ← immutable ← constant ← TRUE;
    END;


 -- 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: PROCEDURE [mdi: MDIndex, iSei: SEIndex] RETURNS [TypeCacheIndex] =
    BEGIN
    RETURN [(LOOPHOLE[mdi, CARDINAL]*LOOPHOLE[iSei, CARDINAL]) MOD TypeCacheSize]
    END;


 -- copying symbols

  CopyIncludedSymbol: PUBLIC PROCEDURE [iSei: SEIndex, mdi: MDIndex] RETURNS [sei: SEIndex] =
    BEGIN
    IF iSei = SENull THEN RETURN [SENull];
    WITH iSeb[iSei] SELECT FROM
      id =>
	BEGIN
	ctx: IncludedCTXIndex;
	hti, iHti: HTIndex;
	iMdi: MDIndex;
	tSei: ISEIndex;
	IF idCtx IN StandardContext THEN RETURN [iSei];
	ctx ← FindIncludedCtx[mdi, idCtx];
	hti ← MapHti[hash];
	sei ← tSei ← SearchContext[hti, ctx];
	IF sei # SENull
	  THEN  seb[tSei].idCtx ← ctx
	  ELSE
	    BEGIN  iMdi ← ctxb[ctx].module;
	    IF iMdi = mdi OR ~mdb[iMdi].shared
	      THEN  sei ← CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, mdi]
	      ELSE
		BEGIN
		CloseIncludedTable[];
		IF OpenIncludedTable[iMdi]
		  THEN
		    BEGIN  iHti ← InverseMapHti[hti];
		    iSei ← iBase.SearchContext[iHti, ctxb[ctx].map];
		    END
		  ELSE [] ← OpenIncludedTable[iMdi←mdi];
		sei ← CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, iMdi];
		CloseIncludedTable[];
		[] ← OpenIncludedTable[mdi];
		END;
	    END;
	END;
      cons =>
	SELECT typeTag FROM
	  mode =>  sei ← typeTYPE;
	  basic =>  sei ← iSei;
	  transfer =>  sei ← CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi];
	  ENDCASE =>
	    BEGIN
	    i: TypeCacheIndex = TypeHash[mdi, iSei];
	    IF typeCache[i].iSei = iSei AND typeCache[i].mdi = mdi
	      THEN  sei ← typeCache[i].sei
	      ELSE
		BEGIN
		sei ← CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi];
		typeCache[i] ← [mdi:mdi, iSei:iSei, sei:sei];
		END;
	    END;
      ENDCASE;
    RETURN
    END;


  CopyCtxSe: PROCEDURE [iSei: ISEIndex, hti: HTIndex, ctx: CTXIndex, mdi: MDIndex]
      RETURNS [sei: ISEIndex] =
    BEGIN
    sei ← MakeCtxSe[hti, ctx];  CopyCtxSeInfo[sei, iSei, mdi];  RETURN
    END;

  CopyCtxSeInfo: PROCEDURE [sei, iSei: ISEIndex, mdi: MDIndex] =
    BEGIN
    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
	  procedure, 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;
    END;


  currentBody: BTIndex;

  CopyExtension: PROCEDURE [sei, iSei: ISEIndex, mdi: MDIndex] =
    BEGIN
    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;
    END;

  InputExtension: PROCEDURE [t: Tree.Link, mdi: MDIndex] RETURNS [Tree.Link] =
    BEGIN

    InputTree: Tree.Map =
      BEGIN
      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 =>
	  BEGIN
	  iNode: Tree.Index = link.index;
	  node: Tree.Index;
	  SELECT iBase.tb[iNode].name FROM
	    block =>  v ← InputBlock[iNode];
	    openx =>
	      v ← TreeOps.CopyTree[
		[baseP:@iBase.tb, link:iBase.tb[iNode].son[1]], InputTree];
	    ENDCASE =>
	      BEGIN
	      v ← TreeOps.CopyTree[[baseP:@iBase.tb, link:link], InputTree];
	      WITH v SELECT FROM
		subtree =>
		  BEGIN  node ← index;
		  SELECT tb[node].name FROM
		    body =>  tb[node].info ← currentBody;
		    IN [basicTC..discrimTC], cdot,
		    IN [callx..typecode], exlist =>
		      BEGIN
		      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;
		      END;
		    IN [assign..join] =>  tb[node].info ← LAST[CARDINAL];
 		    ENDCASE;
		  END;
		ENDCASE => NULL;
	      END;
	  END;
	ENDCASE => ERROR;
      RETURN
      END;

    InputLiteral: PROCEDURE [t: literal Tree.Link] RETURNS [Tree.Link] =
      BEGIN
      WITH t.info SELECT FROM
	word =>
	  index ← LiteralOps.CopyLiteral[[baseP:@iBase.ltb, index:index]];
	ENDCASE => ERROR;
      RETURN [t]
      END;

    InputBlock: PROCEDURE [iNode: Tree.Index] RETURNS [v: Tree.Link] =
      BEGIN  OPEN TreeOps;
      iBti: BTIndex = iBase.tb[iNode].info;
      bti: BTIndex = Table.Allocate[bodyType, SIZE[Other BodyRecord]];
      ctx: IncludedCTXIndex = FindIncludedCtx[mdi, iBase.bb[iBti].localCtx];
      bb[bti] ← BodyRecord[
	  link: ,
	  firstSon: BTNull,
	  localCtx: ctx,
	  level: iBase.bb[iBti].level,
	  info: ,
	  extension: Other[]];
      LinkBti[bti: bti, parent: currentBody];  currentBody ← bti;
      PushTree[InputTree[iBase.tb[iNode].son[1]]];
      PushTree[InputTree[iBase.tb[iNode].son[2]]];
      PushNode[block, 2];
      SetAttr[1, iBase.tb[iNode].attr1]; SetAttr[2, iBase.tb[iNode].attr2];
      SetAttr[3, iBase.tb[iNode].attr3];  SetInfo[bti];  v ← PopTree[];
      bb[bti].info ← BodyInfo[Internal[
			bodyTree: GetNode[v],
		 	sourceIndex: ,
			thread: Tree.NullIndex,
			frameSize: ]];
      currentBody ← ParentBti[bti];
      RETURN
      END;

    RETURN [InputTree[t]]
    END;


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


  CopyNonCtxSe: PROCEDURE [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] =
    BEGIN
    tSei1, tsei2, tsei3: SEIndex;
    rSei1, rSei2: RecordSEIndex;
    tag: ISEIndex;
    tCtx: CTXIndex;
    WITH  iType: iSeb[iSei] SELECT FROM
      enumerated =>
	BEGIN
	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,
	    valueCtx: tCtx,
	    nValues: iType.nValues];
	END;
      record =>
	BEGIN
	tCtx ← IF iType.fieldCtx IN StandardContext
		  THEN  iType.fieldCtx
		  ELSE  FindIncludedCtx[mdi, iType.fieldCtx];
	WITH iType SELECT FROM
	  notLinked =>
	    BEGIN
	    sei ← MakeNonCtxSe[SIZE[notLinked record cons SERecord]];
	    seb[sei].typeInfo ← record[
		machineDep: iType.machineDep,
		argument: iType.argument,
		hints: iType.hints,
		fieldCtx: tCtx,
		length: iType.length,
		lengthUsed: FALSE,
		monitored: iType.monitored,
		linkPart: notLinked[]];
	    END;
	  linked =>
	    BEGIN
	    sei ← MakeNonCtxSe[SIZE[linked record cons SERecord]];
	    tSei1 ← CopyIncludedSymbol[linkType, mdi];
	    seb[sei].typeInfo ← record[
		machineDep: iType.machineDep,
		argument: iType.argument,
		hints: iType.hints,
		fieldCtx: tCtx,
		length: iType.length,
		lengthUsed: FALSE,
		monitored: iType.monitored,
		linkPart: linked[linkType: tSei1]];
	    END;
	  ENDCASE;
	END;
      pointer =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[pointer cons SERecord]];
	tSei1 ← CopyIncludedSymbol[iType.refType, mdi];
	seb[sei].typeInfo ← pointer[
	    refType: tSei1,
	    readOnly: iType.readOnly,
	    ordered: iType.ordered,
	    basing: iType.basing,
	    dereferenced: FALSE];
	END;
      array =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[array cons SERecord]];
	tSei1 ← CopyIncludedSymbol[iType.indexType, mdi];
	tsei2 ← CopyIncludedSymbol[iType.componentType, mdi];
	seb[sei].typeInfo ← array[
	    oldPacked: iType.oldPacked,
	    indexType: tSei1,
	    componentType: tsei2,
	    comparable: iType.comparable,
	    lengthUsed: FALSE];
	END;
      arraydesc =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[arraydesc cons SERecord]];
	tSei1 ← CopyIncludedSymbol[iType.describedType, mdi];
	seb[sei].typeInfo ← arraydesc[
	    readOnly: iType.readOnly,
	    describedType: tSei1];
	END;
      transfer =>
	BEGIN
	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];
	END;
      definition =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[definition cons SERecord]];
	tCtx ← FindIncludedCtx[mdi, iType.defCtx];
	seb[sei].typeInfo ← definition[
		nGfi: iType.nGfi,
		named: iType.named,
		defCtx: tCtx];
	END;
      union =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[union cons SERecord]];
	tCtx ← FindIncludedCtx[mdi, iType.caseCtx];
	tag ← CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi];
	seb[sei].typeInfo ← union[
	    caseCtx: tCtx,
	    overlayed: iType.overlayed,
	    controlled: iType.controlled,
	    tagSei: tag,
	    equalLengths: iType.equalLengths];
	END;
      relative =>
	BEGIN
	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];
	END;
      subrange =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[subrange cons SERecord]];
	tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi];
	seb[sei].typeInfo ← subrange[
	    filled: iType.filled,
	    empty: iType.empty,
	    flexible: iType.flexible,
	    rangeType: tSei1,
	    origin: iType.origin,
	    range: iType.range];
	END;
      long =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[long cons SERecord]];
	tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi];
	seb[sei].typeInfo ← long[rangeType: tSei1];
	END;
      real =>
	BEGIN
	sei ← MakeNonCtxSe[SIZE[real cons SERecord]];
	tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi];
	seb[sei].typeInfo ← real[rangeType: tSei1];
	END;
      ENDCASE =>  ERROR;
    seb[sei].mark3 ← seb[sei].mark4 ← TRUE;  RETURN
    END;


  CopyBodyType: PROCEDURE [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] =
    BEGIN
    rSei1, rSei2: RecordSEIndex;
    WITH iType: iSeb[iSei] SELECT FROM
      transfer =>
	BEGIN
	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];
	END;
      ENDCASE =>  ERROR;
    seb[sei].mark3 ← seb[sei].mark4 ← TRUE;  RETURN
    END;

  CopyArgRecord: PROCEDURE [
	irSei: RecordSEIndex, mdi: MDIndex, mapped: BOOLEAN]
      RETURNS [rSei: RecordSEIndex] =
    BEGIN
    ctx, iCtx: CTXIndex;
    sei, iSei, seChain: ISEIndex;
    i: TypeCacheIndex;
    IF irSei = SENull
      THEN rSei ← RecordSENull
      ELSE
	BEGIN
	rSei ← LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]];
	iCtx ← iSeb[irSei].fieldCtx;
	IF ~mapped
	  THEN  ctx ← NewCtx[iCtxb[iCtx].level]
	  ELSE
	    BEGIN
	    ctx ← FindIncludedCtx[mdi, iCtx];  ResetCtx[LOOPHOLE[ctx]];
	    END;
	IF ctxb[ctx].seList = ISENull
	  THEN
	    BEGIN
	    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;
	    END;
	seb[rSei] ← SERecord[
		mark3: TRUE,
		mark4: TRUE,
		body: cons[
		  record[
		    machineDep: FALSE,
		    argument: TRUE,
		    hints: iSeb[irSei].hints,
		    fieldCtx: ctx,
		    length: iSeb[irSei].length,
		    lengthUsed: FALSE,
		    monitored: FALSE,
		    linkPart: notLinked[]]]];
	i ← TypeHash[mdi, irSei];
	typeCache[i] ← [mdi:mdi, iSei:irSei, sei:rSei];
	END;
    RETURN
    END;


  CopyIncludedValues: PROCEDURE [iCtx: CTXIndex, mdi: MDIndex, type: SEIndex]
      RETURNS [ctx: IncludedCTXIndex] =
    BEGIN
    iSei, sei, seChain: ISEIndex;
    ctx ← FindIncludedCtx[mdi, iCtx];
    iSei ← iCtxb[iCtx].seList;
    IF iSei # SENull AND iSeb[iSeb[iSei].idType].seTag # id
      THEN
	BEGIN
	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;
	END;
    RETURN
    END;


 -- included module accounting


  ResetCtx: PROCEDURE [ctx: IncludedCTXIndex] =
    BEGIN
    IF ~ctxb[ctx].reset
      THEN
	BEGIN  ResetCtxList[ctx];
	ctxb[ctx].closed ← ctxb[ctx].reset ← TRUE;
	END;
    END;

  ResetIncludeContexts: PUBLIC PROCEDURE =
    BEGIN
    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[];
    END;


  TableRelocated: PUBLIC SIGNAL = CODE;

  OpenIncludedTable: PUBLIC PROCEDURE [mdi: MDIndex] RETURNS [success: BOOLEAN] =
    BEGIN
    base: SymbolTable.Base = Copier.GetSymbolTable[mdi];
    IF success ← (base # NIL)
      THEN  BEGIN iBase ← base; iBase.notifier ← IRelocNotify; INotify[] END;
    RETURN
    END;

  IRelocNotify: PROCEDURE [base: SymbolTable.Base] =
    BEGIN
    IF base = iBase THEN BEGIN INotify[]; SIGNAL TableRelocated END;
    END;

  CloseIncludedTable: PUBLIC PROCEDURE =
    BEGIN
    iBase.notifier ← iBase.NullNotifier;
    Copier.FreeSymbolTable[iBase];
    END;

  END.