-- BcdMerge.Mesa  Edited by Sandman on October 2, 1980  5:02 PM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [PageSize],
  BcdDefs USING [
    Base, BCD, BinderNTables, CTIndex, CTNull, CTRecord, cttype, EVIndex, EVNull,
    EVRecord, evtype, EXPIndex, EXPRecord, exptype, FTIndex, FTNull, FTRecord,
    FTSelf, fttype, GFTIndex, IMPIndex, IMPNull, IMPRecord, imptype, Link,
    MTIndex, MTNull, MTRecord, mttype, Namee, NameRecord, NTIndex, NTRecord,
    nttype, NullLink, NullName, NullVersion, SGIndex, SGRecord, sgtype, sstype,
    TMIndex, TMNull, TMRecord, tmtype, TYPIndex, TYPRecord, typtype, UnboundLink,
    VersionID, VersionStamp],
  BcdMergeOps USING [],
  BcdOps USING [
    BcdBase, CTHandle, EVHandle, EXPHandle, IMPHandle, MTHandle, NameString,
    ProcessConfigs, ProcessExports, ProcessImports, ProcessModules, FindName,
    SGHandle, TMHandle],
  SymbolOps: FROM "BcdSymbolOps" USING [
    EnterString, FindEquivalentString, Finalize, FindString, HTIndex, Initialize,
    SubStringForHash],
  ControlDefs USING [ControlLink, GFT, GlobalFrameHandle, NullLink, UnboundLink],
  FrameDefs USING [DeletedFrame],
  FrameOps USING [ValidGlobalFrame],
  ImageDefs USING [ImageVersion],
  InlineDefs USING [COPY],
  LoaderOps USING [CloseLinkSpace, OpenLinkSpace, ReadLink],
  LoadStateFormat USING [ConfigIndex, ModuleTable],
  LoadStateOps USING [Map],
  MiscDefs USING [CurrentTime, GetNetworkNumber, Zero],
  OsStaticDefs USING [OsStatics],
  SegmentDefs USING [
    Append, ChangeDataToFileSegment, DefaultBase, DefaultMDSBase,
    DeleteFileSegment, FileSegmentAddress, HardDown, MakeSwappedIn,
    MoveFileSegment, NewFile, NewFileSegment, Read, SwapOut, Unlock,
    VMtoDataSegment, Write, FileSegmentHandle],
  StringDefs USING [SubString, SubStringDescriptor],
  Storage USING [Node, Pages, Free, FreePages, PagesForWords],
  Table USING [
    AddNotify, Allocate, Base, Bounds, Create, Destroy, DropNotify, Notifier,
    Overflow];

BcdMerge: PROGRAM
  IMPORTS
    BcdOps, SymbolOps, FrameDefs, FrameOps, ImageDefs, InlineDefs, MiscDefs,
    SegmentDefs, Storage, Table, LoaderOps
  EXPORTS BcdMergeOps =PUBLIC

  BEGIN OPEN LoadStateFormat, BcdOps, BcdDefs;

  GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
  HTIndex: TYPE = SymbolOps.HTIndex;
  SubStringDescriptor: TYPE = StringDefs.SubStringDescriptor;
  SubString: TYPE = StringDefs.SubString;
  Map: TYPE = LoadStateOps.Map;
  ControlLink: TYPE = ControlDefs.ControlLink;

  MergeData: TYPE = RECORD [
    bcd: BcdOps.BcdBase,
    mtb, ftb, ctb, itb, etb, evb, ntb, sgb, typb, tmb: Table.Base,
    ssb: NameString,
    configOffset: CARDINAL,
    nextDummyGfi, nextGfi: GFTIndex,
    bcdFile: FTIndex,
    name: STRING,
    table: BcdDefs.Base,
    expandedtable: BOOLEAN,
    tableSegment: SegmentDefs.FileSegmentHandle,
    tablePages: CARDINAL,
    header: BCD];

  data: POINTER TO MergeData;

  Notify: PRIVATE Table.Notifier =
    BEGIN OPEN BcdDefs, data;
    mtb _ base[mttype];
    ftb _ base[fttype];
    ctb _ base[cttype];
    itb _ base[imptype];
    etb _ base[exptype];
    ntb _ base[nttype];
    sgb _ base[sgtype];
    evb _ base[evtype];
    typb _ base[typtype];
    tmb _ base[tmtype];
    ssb _ LOOPHOLE[base[sstype]];
    END;

  EnterName: PROCEDURE [ss: SubString] RETURNS [NameRecord] =
    BEGIN OPEN SymbolOps;
    lss: SubStringDescriptor;
    hti: HTIndex = EnterString[ss];
    SubStringForHash[@lss, hti];
    RETURN[[lss.offset]];
    END;

  MapName: PROCEDURE [bcd: BcdBase, n: NameRecord] RETURNS [NameRecord] =
    BEGIN
    ssb: NameString _ LOOPHOLE[bcd + bcd.ssOffset];
    ss: SubStringDescriptor _ [base: @ssb.string, offset: n, length: ssb.size[n]];
    RETURN[EnterName[@ss]];
    END;

  MapEquivalentName: PROCEDURE [bcd: BcdBase, n: NameRecord]
    RETURNS [NameRecord] =
    BEGIN
    found: BOOLEAN;
    hti: HTIndex;
    ssb: NameString _ LOOPHOLE[bcd + bcd.ssOffset];
    ss: SubStringDescriptor _ [base: @ssb.string, offset: n, length: ssb.size[n]];
    [found, hti] _ SymbolOps.FindEquivalentString[@ss];
    IF found THEN RETURN[NameForHti[hti]];
    RETURN[EnterName[@ss]];
    END;

  HtiName: PROCEDURE [n: NameRecord] RETURNS [HTIndex] =
    BEGIN OPEN data;
    ss: SubStringDescriptor _ [base: @ssb.string, offset: n, length: ssb.size[n]];
    RETURN[SymbolOps.FindString[@ss].hti];
    END;

  NameForHti: PROCEDURE [hti: HTIndex] RETURNS [NameRecord] =
    BEGIN
    ss: SubStringDescriptor;
    SymbolOps.SubStringForHash[@ss, hti];
    RETURN[[ss.offset]];
    END;

  MergeFile: PROCEDURE [bcd: BcdBase, oldfti: FTIndex] RETURNS [fti: FTIndex] =
    BEGIN OPEN data;
    oldftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
    ftLimit: FTIndex = LOOPHOLE[Table.Bounds[fttype].size];
    fn: NameRecord;
    IF oldfti = FTSelf THEN RETURN[WhoIsFTSelf[]];
    fn _ MapEquivalentName[bcd, oldftb[oldfti].name];
    FOR fti _ FIRST[FTIndex], fti + SIZE[FTRecord] UNTIL fti = ftLimit DO
      OPEN new: ftb[fti], old: oldftb[oldfti];
      IF new.name = fn THEN
	BEGIN
	SELECT TRUE FROM
	  (new.version = NullVersion) =>
	    BEGIN new.version _ old.version; RETURN END;
	  (new.version = old.version), (old.version = NullVersion) => RETURN;
	  ENDCASE;
	END;
      ENDLOOP;
    fti _ Table.Allocate[fttype, SIZE[FTRecord]];
    ftb[fti] _ [name: fn, version: oldftb[oldfti].version];
    RETURN
    END;

  MergeSegment: PROCEDURE [bcd: BcdBase, sgh: SGHandle, fti: FTIndex]
    RETURNS [sgi: SGIndex] =
    BEGIN OPEN data;
    sgLimit: SGIndex = LOOPHOLE[Table.Bounds[sgtype].size];
    IF fti = FTNull THEN fti _ MergeFile[bcd, sgh.file];
    FOR sgi _ FIRST[SGIndex], sgi + SIZE[SGRecord] UNTIL sgi = sgLimit DO
      OPEN new: sgb[sgi];
      IF new.class = sgh.class AND new.file = fti AND new.base = sgh.base AND
	new.pages = sgh.pages AND new.extraPages = sgh.extraPages THEN RETURN;
      ENDLOOP;
    sgi _ Table.Allocate[sgtype, SIZE[SGRecord]];
    sgb[sgi] _
      [class: sgh.class, file: fti, base: sgh.base, pages: sgh.pages,
	extraPages: sgh.extraPages];
    RETURN
    END;

  GetDummyGfi: PROCEDURE [n: CARDINAL] RETURNS [gfi: GFTIndex] =
    BEGIN
    gfi _ data.nextDummyGfi;
    data.nextDummyGfi _ data.nextDummyGfi + n;
    RETURN
    END;

  GetGfi: PROCEDURE [n: CARDINAL] RETURNS [gfi: GFTIndex] =
    BEGIN gfi _ data.nextGfi; data.nextGfi _ data.nextGfi + n; RETURN END;

  MergeModule: PUBLIC PROCEDURE [
    frame, copied: GlobalFrameHandle, mt: ModuleTable] =
    BEGIN OPEN data;
    ccgfi: GFTIndex;
    mti, newmti: MTIndex;
    mth, newmth: MTHandle;
    i: CARDINAL;
    ccgfi _ mt[copied.gfi].gfi;
    FOR mti _ FIRST[MTIndex], mti + SIZE[MTRecord] + mtb[mti].frame.length UNTIL
      mti = LOOPHOLE[Table.Bounds[mttype].size, MTIndex] DO
      IF mtb[mti].gfi = ccgfi THEN EXIT; REPEAT FINISHED => ERROR; ENDLOOP;
    newmti _ Table.Allocate[
      mttype, SIZE[MTRecord] + mtb[mti].frame.length !
      Table.Overflow =>
	BEGIN ExpandTable[]; RESUME [[table, tablePages*AltoDefs.PageSize]]; END];
    mth _ @mtb[mti];
    newmth _ @mtb[newmti];
    InlineDefs.COPY[
      from: mth, to: newmth, nwords: SIZE[MTRecord] + mth.frame.length];
    newmth.namedInstance _ FALSE;
    newmth.gfi _ mt[frame.gfi].gfi;
    FOR i IN [0..newmth.frame.length) DO
      IF newmth.frame.frag[i].gfi IN [mth.gfi..mth.gfi + mth.ngfi) THEN
	newmth.frame.frag[i].gfi _ newmth.gfi + mth.frame.frag[i].gfi - mth.gfi;
      ENDLOOP;
    END;

  MergeModuleTable: PROCEDURE [map: Map, config: ConfigIndex, mt: ModuleTable] =
    BEGIN OPEN data;

    MoveModule: PROCEDURE [old: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      rgfi: GFTIndex _ map[old.gfi];
      frame: GlobalFrameHandle _ ControlDefs.GFT[rgfi].frame;
      newmti: MTIndex;
      oldsgb: Table.Base _ LOOPHOLE[bcd + bcd.sgOffset];
      IF ~FrameDefs.DeletedFrame[rgfi] THEN
	BEGIN OPEN m: mtb[newmti];
	header.nModules _ header.nModules + 1;
	newmti _ Table.Allocate[mttype, SIZE[MTRecord] + old.frame.length];
	mtb[newmti] _ old^;
	m.name _ MapName[bcd, old.name];
	IF old.namedInstance THEN
	  BEGIN
	  EnterNameInTable[
	    [module[newmti]], MapName[bcd, FindName[bcd, [module[mti]]]]];
	  m.namedInstance _ TRUE
	  END
	ELSE m.namedInstance _ FALSE;
	m.file _ MergeFile[bcd, old.file];
	m.code.sgi _ MergeSegment[bcd, @oldsgb[old.code.sgi], FTSelf];
	m.sseg _ MergeSegment[bcd, @oldsgb[old.sseg], FTNull];
	m.gfi _ mt[map[old.gfi]].gfi;
	m.variables _ MergeVariables[bcd, old];
	MergeLinks[frame, newmti, old, mt];
	IF old.config # CTNull THEN
	  BEGIN OPEN cti: ctb[m.config];
	  m.config _ old.config + configOffset;
	  IF cti.nControls # 0 AND cti.controls[0] = mti THEN
	    cti.controls[0] _ newmti;
	  END
	ELSE
	  IF bcd.nConfigs = 0 THEN
	    BEGIN
	    m.config _ Table.Allocate[cttype, SIZE[CTRecord]];
	    ctb[m.config] _ CTRecord[
	      name: m.name, namedInstance: FALSE, file: m.file, config: CTNull,
	      nControls: 0, controls:];
	    END
	  ELSE m.config _ CTNull;
	END
      ELSE
	IF old.config # CTNull AND ctb[old.config + configOffset].nControls # 0
	  AND ctb[old.config + configOffset].controls[0] = mti THEN
	  ctb[old.config + configOffset].controls[0] _ MTNull;
      RETURN[FALSE];
      END;

      [] _ ProcessModules[bcd, MoveModule];
    END;

  -- Variables and types are not merged correctly.  After a makeimage, types 
  -- in the frame are not necessarily correct


  MergeLinks: PROCEDURE [
    frame: GlobalFrameHandle, newmti: MTIndex, old: MTHandle, mt: ModuleTable] =
    BEGIN OPEN data, m: mtb[newmti];
    cl: ControlLink;
    link: Link;
    i: CARDINAL;
    LoaderOps.OpenLinkSpace[frame, old];
    FOR i IN [0..old.frame.length) DO
      cl _ LoaderOps.ReadLink[i];
      IF cl = ControlDefs.NullLink OR cl = ControlDefs.UnboundLink THEN
	link _ AddImport[old.frame.frag[i]]
      ELSE link _ MapLink[cl];
      m.frame.frag[i] _ link;
      ENDLOOP;
    LoaderOps.CloseLinkSpace[frame];
    RETURN
    END;

  MapLink: PROCEDURE [cl: ControlLink] RETURNS [bl: Link] =
    BEGIN
    SELECT cl.tag FROM
      frame =>
	BEGIN OPEN f: LOOPHOLE[cl.frame, GlobalFrameHandle];
	IF FrameOps.ValidGlobalFrame[@f] THEN
	  bl _ [variable[vgfi: f.gfi, var: 0, vtag: var]]
	ELSE bl _ NullLink;
	END;
      procedure => bl _ [procedure[gfi: cl.gfi, ep: cl.ep, tag: TRUE]];
      ENDCASE => bl _ UnboundLink;
    RETURN
    END;

  MergeVariables: PROCEDURE [bcd: BcdBase, old: MTHandle] RETURNS [evi: EVIndex] =
    BEGIN
    evh, newevh: EVHandle;
    evLimit: EVIndex = LOOPHOLE[Table.Bounds[evtype].size];
    i: CARDINAL;
    IF old.variables = EVNull THEN RETURN[EVNull];
    evh _ @LOOPHOLE[bcd + bcd.evOffset, Table.Base][old.variables];
    FOR evi _ FIRST[EVIndex], evi + SIZE[EVRecord] + data.evb[evi].length UNTIL
      evi = evLimit DO
      newevh _ @data.evb[evi];
      IF evh.length <= newevh.length THEN
	FOR i IN [1..evh.length] DO
	  IF evh.offsets[i] # newevh.offsets[i] THEN EXIT;
	  REPEAT FINISHED => RETURN[evi];
	  ENDLOOP;
      ENDLOOP;
    evi _ Table.Allocate[evtype, SIZE[EVRecord] + evh.length];
    InlineDefs.COPY[
      from: evh, to: @data.evb[evi], nwords: SIZE[EVRecord] + evh.length];
    RETURN
    END;

  MergeExportTable: PROCEDURE [map: Map, mt: ModuleTable] =
    BEGIN OPEN data;

    MapExport: PROCEDURE [old: EXPHandle, eti: EXPIndex] RETURNS [BOOLEAN] =
      BEGIN
      neweti: EXPIndex;
      oldftb: Table.Base _ LOOPHOLE[bcd + bcd.ftOffset];
      oldssb: NameString _ LOOPHOLE[bcd + bcd.ssOffset];
      i: CARDINAL;
      found: BOOLEAN;
      hti: HTIndex;
      oldname: StringDefs.SubStringDescriptor;
      oldname _
	[base: @oldssb.string, offset: old.name, length: oldssb.size[old.name]];
      [found, hti] _ SymbolOps.FindString[@oldname];
      IF found THEN
	BEGIN
	neweti _ FIRST[EXPIndex];
	DO
	  OPEN new: etb[neweti];
	  IF hti = HtiName[new.name] AND new.port = old.port THEN
	    BEGIN
	    IF oldftb[old.file].version = ftb[new.file].version THEN
	      BEGIN
	      FOR i IN [0..old.size) DO
		IF old.links[i].gfi # 0 THEN
		  -- assumes that most recently loaded config
		  -- merged last
		  BEGIN
		  new.links[i] _ old.links[i];
		  new.links[i].gfi _ mt[map[old.links[i].gfi]].gfi;
		  END;
		ENDLOOP;
	      IF ~new.namedInstance AND old.namedInstance THEN
		BEGIN
		new.namedInstance _ TRUE;
		EnterNameInTable[
		  [export[neweti]], MapName[bcd, FindName[bcd, [export[eti]]]]];
		END;
	      RETURN[FALSE];
	      END;
	    END;
	  neweti _ neweti + new.size + SIZE[EXPRecord];
	  IF neweti = LOOPHOLE[Table.Bounds[exptype].size] THEN EXIT;
	  ENDLOOP;
	END;
      [] _ MakeNewExport[old, eti, map, mt];
      RETURN[FALSE];
      END;

      [] _ ProcessExports[bcd, MapExport];
    END;

  MakeNewExport: PROCEDURE [
    old: EXPHandle, eti: EXPIndex, map: Map, mt: ModuleTable]
    RETURNS [neweti: EXPIndex] =
    BEGIN OPEN data;
    i: CARDINAL;
    header.nExports _ header.nExports + 1;
    neweti _ Table.Allocate[exptype, old.size + SIZE[EXPRecord]];
    FOR i IN [0..old.size) DO
      etb[neweti].links[i] _ old.links[i];
      etb[neweti].links[i].gfi _ mt[map[old.links[i].gfi]].gfi;
      ENDLOOP;
    etb[neweti].name _ MapName[bcd, old.name];
    etb[neweti].file _ MergeFile[bcd, old.file];
    etb[neweti].port _ old.port;
    etb[neweti].size _ old.size;
    IF old.namedInstance THEN
      BEGIN
      etb[neweti].namedInstance _ TRUE;
      EnterNameInTable[
	[export[neweti]], MapName[bcd, FindName[bcd, [export[eti]]]]];
      END
    ELSE etb[neweti].namedInstance _ FALSE;
    END;

  AddImport: PROCEDURE [link: Link] RETURNS [Link] =
    BEGIN OPEN data;

    FindImport: PROCEDURE [imp: IMPHandle, iti: IMPIndex] RETURNS [BOOLEAN] =
      BEGIN RETURN[link.gfi IN [imp.gfi..imp.gfi + imp.ngfi)]; END;

    old: IMPHandle;
    iti, newiti: IMPIndex;
    oldftb: Table.Base _ LOOPHOLE[bcd + bcd.ftOffset];
    olditb: Table.Base _ LOOPHOLE[bcd + bcd.impOffset];
    oldssb: NameString _ LOOPHOLE[bcd + bcd.ssOffset];
    oldname: SubStringDescriptor;
    found: BOOLEAN;
    hti: HTIndex;
    iti _ ProcessImports[bcd, FindImport].iti;
    IF iti = IMPNull THEN RETURN[AddNewImport[link]];
    old _ @olditb[iti];
    oldname _ [@oldssb.string, old.name, oldssb.size[old.name]];
    [found, hti] _ SymbolOps.FindString[@oldname];
    IF found THEN
      FOR newiti _ FIRST[IMPIndex], newiti + SIZE[IMPRecord] UNTIL newiti =
	LOOPHOLE[Table.Bounds[imptype].size] DO
	OPEN new: itb[newiti];
	IF hti = HtiName[new.name] THEN
	  BEGIN OPEN oldfile: oldftb[old.file], newfile: ftb[new.file];
	  oldname.offset _ oldfile.name;
	  oldname.length _ oldssb.size[oldfile.name];
	  IF SymbolOps.FindEquivalentString[@oldname].found AND oldfile.version =
	    newfile.version THEN
	    BEGIN
	    IF ~new.namedInstance AND old.namedInstance THEN
	      BEGIN
	      new.namedInstance _ TRUE;
	      EnterNameInTable[
		[import[newiti]], MapName[bcd, FindName[bcd, [import[iti]]]]];
	      END;
	    link.gfi _ new.gfi + link.gfi - old.gfi;
	    RETURN[link];
	    END;
	  END;
	ENDLOOP;
    header.nImports _ header.nImports + 1;
    newiti _ Table.Allocate[imptype, SIZE[IMPRecord]];
    itb[newiti].name _ MapName[bcd, old.name];
    itb[newiti].file _ MergeFile[bcd, old.file];
    IF old.namedInstance THEN
      BEGIN
      itb[newiti].namedInstance _ TRUE;
      EnterNameInTable[
	[import[newiti]], MapName[bcd, FindName[bcd, [import[iti]]]]];
      END
    ELSE itb[newiti].namedInstance _ FALSE;
    itb[newiti].gfi _ GetDummyGfi[itb[newiti].ngfi _ old.ngfi];
    itb[newiti].port _ old.port;
    link.gfi _ itb[newiti].gfi + link.gfi - old.gfi;
    RETURN[link];
    END;

  AddNewImport: PROCEDURE [link: Link] RETURNS [Link] = {RETURN[UnboundLink]};

  MergeConfigTable: PROCEDURE [size: CARDINAL] RETURNS [delta: CARDINAL] =
    BEGIN OPEN data;

    ConfigMap: PROCEDURE [old: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN new: ctb[cti + delta];
      i: CARDINAL;
      new.name _ MapName[bcd, old.name];
      IF old.namedInstance THEN
	BEGIN
	EnterNameInTable[
	  [config[cti + delta]], MapName[bcd, FindName[bcd, [config[cti]]]]];
	new.namedInstance _ TRUE
	END
      ELSE new.namedInstance _ FALSE;
      new.nControls _ old.nControls;
      FOR i IN [0..new.nControls _ old.nControls) DO
	new.controls[i] _ old.controls[i] ENDLOOP;
      new.file _ IF old.file = FTSelf THEN FTSelf ELSE MergeFile[bcd, old.file];
      new.config _ IF old.config = CTNull THEN CTNull ELSE old.config + delta;
      RETURN[FALSE];
      END;

    delta _ LOOPHOLE[Table.Allocate[cttype, size]];
    header.nConfigs _ header.nConfigs + bcd.nConfigs;
    [] _ ProcessConfigs[bcd, ConfigMap];
    RETURN
    END;

  EnterNameInTable: PROCEDURE [owner: Namee, name: NameRecord] =
    BEGIN
    nti: NTIndex _ Table.Allocate[nttype, SIZE[NTRecord]];
    data.ntb[nti] _ [name, owner];
    END;

  WhoIsFTSelf: PROCEDURE RETURNS [FTIndex] =
    BEGIN OPEN data;
    ss: SubStringDescriptor _ [base: name, offset: 0, length: name.length];
    n: NameRecord;
    IF bcdFile = FTNull THEN
      BEGIN
      bcdFile _ Table.Allocate[fttype, SIZE[FTRecord]];
      n _ EnterName[@ss];
      ftb[bcdFile] _ [n, bcd.version];
      END;
    RETURN[bcdFile];
    END;

  MergeTypeMap: PROCEDURE [bcd: BcdBase] =
    BEGIN OPEN data;
    typLimit: TYPIndex = LOOPHOLE[Table.Bounds[typtype].size];
    typ: TYPIndex;
    oldtypb: Base = LOOPHOLE[bcd + bcd.typOffset];
    ScanTypeMap: PROCEDURE [tmh: TMHandle, tmi: TMIndex] RETURNS [BOOLEAN] =
      BEGIN
      FOR typ _ FIRST[TYPIndex], typ + SIZE[TYPRecord] UNTIL typ = typLimit DO
	IF oldtypb[tmh.map] = typb[typ] THEN EXIT;
	REPEAT
	  FINISHED => {
	    typ _ Table.Allocate[typtype, SIZE[TYPRecord]];
	    typb[typ] _ oldtypb[tmh.map]};
	ENDLOOP;
      tmi _ Table.Allocate[tmtype, SIZE[TMRecord]];
      tmb[tmi] _ [version: tmh.version, offset: tmh.offset, map: typ];
      RETURN[FALSE];
      END;
    [] _ ProcessTypeMap[bcd, ScanTypeMap];
    RETURN
    END;

  ProcessTypeMap: PROCEDURE [
    bcd: BcdBase, proc: PROC [TMHandle, TMIndex] RETURNS [BOOLEAN]]
    RETURNS [tmh: TMHandle, tmi: TMIndex] =
    BEGIN
    tmb: Base = LOOPHOLE[bcd + bcd.tmOffset];
    FOR tmi _ FIRST[TMIndex], tmi + SIZE[TMRecord] UNTIL tmi = bcd.tmLimit DO
      IF proc[tmh _ @tmb[tmi], tmi] THEN RETURN; ENDLOOP;
    RETURN[NIL, TMNull];
    END;

  MergeBcd: PUBLIC PROCEDURE [
    mergee: BcdBase, map: Map, config: ConfigIndex, mt: ModuleTable,
    bcdname: STRING] =
    BEGIN OPEN data;
    BEGIN
    ENABLE
      Table.Overflow =>
	BEGIN ExpandTable[]; RESUME [[table, tablePages*AltoDefs.PageSize]]; END;
    bcd _ mergee;
    bcdFile _ FTNull;
    name _ bcdname;
    configOffset _
      IF bcd.nConfigs = 0 THEN 0
      ELSE MergeConfigTable[LOOPHOLE[bcd.ctLimit, CARDINAL]];
    MergeModuleTable[map, config, mt];
    MergeExportTable[map, mt];
    MergeTypeMap[mergee];
    END;
    END;

  Size: PUBLIC PROCEDURE RETURNS [size: CARDINAL] =
    BEGIN OPEN data.header, BcdDefs, Table;
    s: CARDINAL;
    size _ SIZE[BCD];
    ssOffset _ size;
    size _ size + (ssLimit _ Bounds[sstype].size);
    ctOffset _ size;
    size _ size + (s _ Bounds[cttype].size);
    ctLimit _ LOOPHOLE[s, CTIndex];
    mtOffset _ size;
    size _ size + (s _ Bounds[mttype].size);
    mtLimit _ LOOPHOLE[s, MTIndex];
    impOffset _ size;
    size _ size + (s _ Bounds[imptype].size);
    impLimit _ LOOPHOLE[s, IMPIndex];
    expOffset _ size;
    size _ size + (s _ Bounds[exptype].size);
    expLimit _ LOOPHOLE[s, EXPIndex];
    evOffset _ size;
    size _ size + (s _ Bounds[evtype].size);
    evLimit _ LOOPHOLE[s, EVIndex];
    sgOffset _ size;
    size _ size + (s _ Bounds[sgtype].size);
    sgLimit _ LOOPHOLE[s, SGIndex];
    ftOffset _ size;
    size _ size + (s _ Bounds[fttype].size);
    ftLimit _ LOOPHOLE[s, FTIndex];
    ntOffset _ size;
    size _ size + (s _ Bounds[nttype].size);
    ntLimit _ LOOPHOLE[s, NTIndex];
    typOffset _ size;
    size _ size + (s _ Bounds[typtype].size);
    typLimit _ LOOPHOLE[s, TYPIndex];
    tmOffset _ size;
    size _ size + (s _ Bounds[tmtype].size);
    tmLimit _ LOOPHOLE[s, TMIndex];
    nPages _ Storage.PagesForWords[size];
    nDummies _ GetDummyGfi[0] - firstdummy;
    END;

  Write: PUBLIC PROCEDURE [movewords: PROCEDURE [POINTER, CARDINAL]] =
    BEGIN OPEN BcdDefs;
    base: Table.Base;
    size: CARDINAL;
    movewords[@data.header, SIZE[BCD]];
    [base, size] _ Table.Bounds[sstype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[cttype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[mttype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[imptype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[exptype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[evtype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[sgtype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[fttype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[nttype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[typtype];
    movewords[LOOPHOLE[base], size];
    [base, size] _ Table.Bounds[tmtype];
    movewords[LOOPHOLE[base], size];
    END;

  -- Administrative Procedures


  Initialize: PUBLIC PROCEDURE [sizeoftable: CARDINAL, lastrealgfi: GFTIndex] =
    BEGIN OPEN data, Table;
    net: CARDINAL _ MiscDefs.GetNetworkNumber[];
    tableweights: ARRAY [0..BinderNTables) OF CARDINAL _ ALL[1];
    data _ Storage.Node[SIZE[MergeData]];
    tablePages _ Storage.PagesForWords[sizeoftable];
    table _ LOOPHOLE[Storage.Pages[tablePages]];
    Create[[table, tablePages*AltoDefs.PageSize], DESCRIPTOR[tableweights]];
    AddNotify[Notify];
    SymbolOps.Initialize[];
    nextGfi _ 1;
    MiscDefs.Zero[@data.header, SIZE[BCD]];
    header.firstdummy _ nextDummyGfi _ lastrealgfi + 1;
    header.versionIdent _ BcdDefs.VersionID;
    header.source _ NullName;
    header.creator _ ImageDefs.ImageVersion[];
    header.version _ VersionStamp[
      time: MiscDefs.CurrentTime[], net: net,
      host: OsStaticDefs.OsStatics.SerialNumber];
    header.definitions _ FALSE;
    expandedtable _ FALSE;
    RETURN
    END;

  Finalize: PUBLIC PROCEDURE =
    BEGIN
    SymbolOps.Finalize[];
    Table.DropNotify[Notify];
    Table.Destroy[];
    IF data.expandedtable THEN
      BEGIN OPEN SegmentDefs;
      Unlock[data.tableSegment];
      DeleteFileSegment[data.tableSegment]
      END
    ELSE Storage.FreePages[LOOPHOLE[data.table]];
    Storage.Free[data];
    RETURN
    END;

  ExpandTable: PROCEDURE =
    BEGIN OPEN SegmentDefs, data;
    IF ~expandedtable THEN
      BEGIN
      tableSegment _ NewFileSegment[
	NewFile["swatee"L, Read + Write + Append], 1, tablePages, Read + Write];
      ChangeDataToFileSegment[VMtoDataSegment[LOOPHOLE[table]], tableSegment];
      expandedtable _ TRUE;
      END;
    Unlock[tableSegment];
    SwapOut[tableSegment];
    MoveFileSegment[tableSegment, DefaultBase, tablePages _ tablePages + 1];
    MakeSwappedIn[tableSegment, DefaultMDSBase, HardDown];
    table _ LOOPHOLE[FileSegmentAddress[tableSegment]];
    END;


  END.