-- 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.