-- CIFSBcdWrite.mesa
-- Last edited by Satterthwaite on May 10, 1983 10:14 am

DIRECTORY
  Alloc: TYPE USING [
    AddNotify, Bounds, DropNotify, Handle, Notifier, Top, Trim, Words],
  BcdComData: TYPE USING [
    aborted, binderVersion, codeName, copyCode, copySymbols,
    nConfigs, nExports, nImports, nModules, nPages, objectStamp, op,
    outputFile, sourceName, sourceVersion, symbolName, table,
    typeExported, textIndex, zone],
  BcdControlDefs: TYPE USING [],
  BcdDefs: TYPE USING [
    BCD, ControlItem, CTIndex, CTRecord, cttype, cxtype, EVIndex, evtype,
    EXPIndex, EXPRecord, exptype, FPIndex, FPRecord, fptype,
    FTIndex, FTNull, FTRecord, FTSelf, fttype,
    IMPIndex, IMPNull, imptype, LFNull, lftype, Link,
    MTIndex, MTNull, MTRecord, mttype, Namee, NameRecord, NTIndex, NTRecord, nttype,
    NullName, NullVersion, PackedString, rftype, SegClass, SGIndex, SGNull, SGRecord, sgtype,
    SpaceID, SPIndex, SPRecord, sptype, sstype, sttype, tftype, tmtype, 
    treetype, typtype, VersionID, VersionStamp],
  BcdErrorDefs: TYPE USING [ErrorHti, ErrorName, ErrorNameBase, GetSti],
  BcdLiterals: TYPE USING [
    EnterVersionFiles, LitSegSize, UpdateSegments, WriteLiterals],
  BcdOps: TYPE USING [BcdBase, NameString],
  BcdUtilDefs: TYPE USING [
    BcdBases, ContextForTree, EnterExport, EnterFile, EnterImport, EnterName, 
    GetGfi, MapName, MergeFile, NameForHti, SetFileVersion],
  CIFS: TYPE USING [OpenFile, Close, Error, GetFC, Open, create, read, replace, write],
  ConvertUnsafe: TYPE USING [ToRope],
  Environment: TYPE USING [bytesPerPage, bytesPerWord, wordsPerPage],
  File: TYPE USING [Capability, nullCapability, SetSize],
  FileSegment: TYPE USING [Pages, nullPages],
  FileStream: TYPE USING [FileByteIndex, Create, GetIndex, SetIndex],
--ExecOps: TYPE USING [CheckForAbort],
  HashOps: TYPE USING [Reset],
  Inline: TYPE USING [LongCOPY, LongMult],
  OSMiscOps: TYPE USING [StampToTime],
  Space: TYPE USING [
    Create, Delete, Handle, Map, LongPointer, Unmap, virtualMemory],
  Stream: TYPE USING [Handle, Delete, PutBlock, PutWord],
  Strings: TYPE USING [
    String, SubString, SubStringDescriptor, AppendChar, AppendString],
  Symbols: TYPE USING [CXIndex, HTIndex, htNull, STIndex, stNull],
  Table: TYPE USING [Base, Selector],
  Tree: TYPE USING [Index, Link, Scan, null],
  TreeOps: TYPE USING [GetNode, ListLength, ScanList];

CIFSBcdWrite: PROGRAM
    IMPORTS
      Alloc, BcdErrorDefs, BcdLiterals, BcdUtilDefs, CIFS, ConvertUnsafe,
      --ExecOps,-- File, FileStream, HashOps, Inline, OSMiscOps, Space,
      Stream, Strings, TreeOps,
      data: BcdComData
    EXPORTS BcdControlDefs = {
  OPEN BcdDefs;

  bytesPerWord: CARDINAL = Environment.bytesPerWord;
  nullFile: CIFS.OpenFile = NIL;
  nullPages: FileSegment.Pages = FileSegment.nullPages;
    
  Alignment: CARDINAL = 4;  -- Code Segments must start at 0 MOD Alignment

  BcdWriteError: PUBLIC ERROR = CODE;
  Error: PROC = {ERROR BcdWriteError};
  UserAbort: ERROR = CODE;  -- raised on ↑DEL during code or symbol copying
  

  table: Alloc.Handle;
  tb, stb, ctb, mtb, lfb, etb, itb, sgb, tyb, tmb, ftb, ntb, spb, fpb, cxb: Table.Base;
  ssb: BcdOps.NameString;

  Notifier: Alloc.Notifier = {
    tb  ← base[treetype];  stb ← base[sttype];
    ctb ← base[cttype];    mtb ← base[mttype];  lfb ← base[lftype];
    tyb ← base[typtype];   tmb ← base[tmtype];
    etb ← base[exptype];   itb ← base[imptype];
    sgb ← base[sgtype];    ftb ← base[fttype];
    spb ← base[sptype];    fpb ← base[fptype];
    ntb ← base[nttype];    ssb ← base[sstype];
    cxb ← base[cxtype];
    IF bcd # NIL THEN {
      bcd.ctb ← ctb;  bcd.mtb ← mtb;
      IF ~packing THEN bcd.sgb ← sgb;
      bcd.tyb ← tyb; bcd.tmb ← tmb;  bcd.spb ← spb; bcd.fpb ← fpb}};


 -- inline utilities
 
  Copy: PROC [from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] =
    Inline.LongCOPY;
    
  Zero: PROC [p: LONG POINTER, l: CARDINAL] = INLINE {
    IF l # 0 THEN {p↑ ← 0; Inline.LongCOPY[from: p, to: (p+1), nwords: (l-1)]}};

  PagesForWords: PROC [nWords: CARDINAL] RETURNS [CARDINAL] = INLINE {
    RETURN [(nWords + Environment.wordsPerPage-1)/Environment.wordsPerPage]};
    
    
  bcd: LONG POINTER TO BcdUtilDefs.BcdBases ← NIL;

  header: BcdOps.BcdBase;  -- points to Bcd header and saved tables
  headerSpace: Space.Handle;

  WriteBcd: PUBLIC PROC [root: Tree.Link] = {
    saveIndex: CARDINAL = data.textIndex;
    node, subNode: Tree.Index;
    table ← data.table; table.AddNotify[Notifier];
    node ← TreeOps.GetNode[root];
    packing ← (tb[node].son[2] # Tree.null AND data.copyCode);
    Initialize[];
    IF packing THEN {
      MakePackItem[tb[node].son[2]];
      data.textIndex ← saveIndex;
      FillInSgMap[]};
    CopyConfigs[];
    CopyModules[];
    CopyTypes[];
    CopySpaces[];  CopyFramePacks[];
    subNode ← TreeOps.GetNode[tb[node].son[3]];
    data.textIndex ← tb[subNode].info;
    TreeOps.ScanList[tb[subNode].son[1], CopyImport];
    TreeOps.ScanList[tb[subNode].son[2], CopyExport];
    IF tb[subNode].attrs[$exportsALL] THEN
      ExportCx[BcdUtilDefs.ContextForTree[tb[subNode].son[4]]];
    IF data.copySymbols THEN EnterMissingSymbolFiles[];
    BcdLiterals.EnterVersionFiles[bcd.ftb, FtiForIndex[fileMap.length], MapFile];
    TableOut[];
    CloseOutputFile[];
    Finalize[];  data.textIndex ← saveIndex;
    table.DropNotify[Notifier];  table ← NIL};


  Initialize: PROC = {
    impSize, expSize, sgSize, fSize, nSize, ssSize: CARDINAL;
    nSgis: CARDINAL;
    b: Table.Base;
    desc: Strings.SubStringDescriptor ←
      [base: data.sourceName, offset: 0, length: data.sourceName.length];
    IF data.copyCode OR data.copySymbols THEN InitCodeSymbolCopy[];
    impSize ← table.Bounds[imptype].size;
    expSize ← table.Bounds[exptype].size;
    sgSize ← table.Bounds[sgtype].size;
    nSgis ← sgSize/SGRecord.SIZE;
    IF ~packing THEN sgSize ← 0;
    fSize ← table.Bounds[fttype].size;
    nSize ← table.Bounds[nttype].size;
    ssSize ← table.Bounds[sstype].size;
    bcd ← (data.zone).NEW[BcdUtilDefs.BcdBases];
    fileMap ← (data.zone).NEW[FileMap[fSize/FTRecord.SIZE]];
    FOR i: CARDINAL IN [0..fileMap.length) DO fileMap[i] ← FTNull ENDLOOP;
    headerSpace ← Space.Create[ 
      size: PagesForWords[
        BCD.SIZE + impSize + expSize + sgSize + fSize + nSize + ssSize],
      parent: Space.virtualMemory];
    headerSpace.Map[];
    header ← LOOPHOLE[headerSpace.LongPointer, BcdOps.BcdBase];
    b ← (LOOPHOLE[header, Table.Base] + BCD.SIZE);
    Copy[to: (bcd.etb ← b), from: etb, nwords: expSize];
      b ← b + expSize;  table.Trim[exptype,0];
    Copy[to: (bcd.itb ← b), from: itb, nwords: impSize];
      b ← b + impSize;  table.Trim[imptype,0];
    Copy[to: (bcd.ftb ← b), from: ftb, nwords: fSize];
      b ← b + fSize;  table.Trim[fttype,0];
    Copy[to: (bcd.ntb ← b), from: ntb, nwords: nSize];
      b ← b + nSize;  table.Trim[nttype,0];
    Copy[to: (bcd.ssb ← b), from: ssb, nwords: ssSize];
      b ← b + ssSize;
    HashOps.Reset[];
    IF packing THEN {  -- save old segment table in heap
      Copy[to: (bcd.sgb ← b), from: sgb, nwords: sgSize];
      b ← b + sgSize;  table.Trim[sgtype,0]};
    InitHeader[
      header: header, 
      objectVersion: OSMiscOps.StampToTime[data.objectStamp], 
      source: BcdUtilDefs.EnterName[@desc], 
      sourceVersion: data.sourceVersion];
    bcd.ctb ← table.Bounds[cttype].base;
    bcd.mtb ← table.Bounds[mttype].base;
    bcd.tyb ← table.Bounds[typtype].base;
    bcd.tmb ← table.Bounds[tmtype].base;
    bcd.spb ← table.Bounds[sptype].base;
    bcd.fpb ← table.Bounds[fptype].base;
    IF data.copyCode OR data.copySymbols THEN {MapCodeSymbolFiles[]; InitCopyMap[nSgis]};
    IF packing THEN InitSgMap[nSgis]
    ELSE {
      bcd.sgb ← table.Bounds[sgtype].base;
      IF ~data.copyCode THEN MapSegments[$code];
      IF ~data.copySymbols THEN MapSegments[$symbols]}};

  Finalize: PROC = {
    IF data.copyCode OR data.copySymbols THEN ReleaseCodeSymbolCopy[];
    (data.zone).FREE[@fileMap];  (data.zone).FREE[@bcd];
    Space.Delete[headerSpace];
    FreePackItems[];
    IF packing THEN FreeSgMap[];
    IF data.copyCode OR data.copySymbols THEN FreeCopyMap[]};


 -- BCD (re)construction
 
 
  CopyName: PROC [olditem, newitem: Namee] = {
    newNti: NTIndex = table.Words[nttype, NTRecord.SIZE];
    FOR nti: NTIndex ← NTIndex.FIRST, nti+NTRecord.SIZE DO
      OPEN old: bcd.ntb[nti];
      IF old.item = olditem THEN {
        OPEN new: ntb[newNti];
        new.item ← newitem; new.name ← bcd.MapName[old.name];
        RETURN};
      ENDLOOP};


  CopyConfigs: PROC = {
    -- configs are already copied, only map names and files
    cti: CTIndex ← CTIndex.FIRST;
    ctLimit: CTIndex = table.Top[cttype];
    UNTIL cti = ctLimit DO
      header.nConfigs ← header.nConfigs + 1;
      ctb[cti].name ← bcd.MapName[ctb[cti].name];
      ctb[cti].file ← MapFile[ctb[cti].file];
      IF ctb[cti].namedInstance THEN CopyName[[config[cti]], [config[cti]]];
      cti ← cti + (CTRecord.SIZE + ctb[cti].nControls*ControlItem.SIZE);
      ENDLOOP};


  CopyModules: PROC = {
    -- modules are already copied, only map names and files

    MapOne: PROC [mti: MTIndex] RETURNS [BOOL ← FALSE] = {
      OPEN m: mtb[mti];
      header.nModules ← header.nModules + 1;
      m.name ← bcd.MapName[m.name];
      m.file ← MapFile[m.file];
      IF m.namedInstance THEN CopyName[[module[mti]], [module[mti]]]};

    EnumerateModules[MapOne]};

  EnumerateModules: PROC [p: PROC [MTIndex] RETURNS [BOOL]] = {
    mti: MTIndex ← MTIndex.FIRST;
    mtLimit: MTIndex = table.Top[mttype];
    UNTIL mti = mtLimit DO
      IF p[mti] THEN EXIT;
      mti ← mti + (WITH m: mtb[mti] SELECT FROM
	      direct => MTRecord.direct.SIZE + m.length*Link.SIZE,
	      indirect => MTRecord.indirect.SIZE,
	      multiple => MTRecord.multiple.SIZE,
	      ENDCASE => ERROR);
      ENDLOOP};


  CopyTypes: PROC = {};  -- types are already copied, nothing need be done (current typeIds)


  CopySpaces: PROC = {
    -- spaces are already copied, only map names (and segments?)

    MapOne: PROC [spi: SPIndex] RETURNS [BOOL ← FALSE] = {
      FOR i: CARDINAL IN [0..spb[spi].length) DO
	spb[spi].spaces[i].name ← bcd.MapName[spb[spi].spaces[i].name];
	ENDLOOP};

    EnumerateSpaces[MapOne]};

  EnumerateSpaces: PROC [p: PROC [SPIndex] RETURNS [BOOL]] = {
    spi: SPIndex ← SPIndex.FIRST; 
    spLimit: SPIndex = table.Top[sptype];
    UNTIL spi = spLimit DO
      IF p[spi] THEN EXIT;
      spi ← spi + SPRecord.SIZE + spb[spi].length*SpaceID.SIZE;
      ENDLOOP};


  CopyFramePacks: PROC = {
    -- framepacks are already copied, only map names

    MapOne: PROC [fpi: FPIndex] RETURNS [BOOL ← FALSE] = {
      fpb[fpi].name ← bcd.MapName[fpb[fpi].name]};

    EnumerateFramePacks[MapOne]};

  EnumerateFramePacks: PROC [p: PROC [FPIndex] RETURNS [BOOL]] = {
    fpi: FPIndex ← FPIndex.FIRST;
    fpLimit: FPIndex = table.Top[fptype];
    UNTIL fpi = fpLimit DO
      IF p[fpi] THEN RETURN;
      fpi ← fpi + FPRecord.SIZE + fpb[fpi].length*MTIndex.SIZE;
      ENDLOOP};


  CopyImport: Tree.Scan = {
    OPEN Symbols;
    sti: STIndex ← stNull;
    olditi, iti: IMPIndex;
    WITH t SELECT FROM
      symbol => sti ← index;
      subtree =>
        WITH s1:tb[index].son[1] SELECT FROM
          symbol => sti ← s1.index;
          ENDCASE => Error[];
      ENDCASE => Error[];
    olditi ← stb[sti].impi;
    IF sti = stNull OR olditi = IMPNull THEN RETURN;
    iti ← bcd.EnterImport[olditi, TRUE];
    itb[iti].file ← MapFile[itb[iti].file];
    IF header.firstdummy = 0 THEN header.firstdummy ← itb[iti].gfi;
    header.nImports ← header.nImports + 1;
    header.nDummies ← header.nDummies + itb[iti].ngfi};

  CopyExport: Tree.Scan = {
    OPEN Symbols;
    sti: STIndex ← stNull;
    hti: HTIndex ← htNull;
    neweti: EXPIndex;
    oldeti: EXPIndex;
    WITH t SELECT FROM
      symbol => sti ← index;
      subtree =>
	WITH s1:tb[index].son[1] SELECT FROM
	  symbol => {sti ← s1.index; hti ← stb[sti].hti};
	  ENDCASE => Error[];
      ENDCASE => Error[];
    WITH s:stb[sti] SELECT FROM
      external => 
        WITH m:s.map SELECT FROM
          interface => {
            OPEN new: etb[neweti];
            oldeti ← m.expi;
            neweti ← bcd.EnterExport[oldeti, TRUE];
            Copy[from: @bcd.etb[oldeti].links, to: @new.links, nwords: new.size];
            new.file ← MapFile[new.file]};
          module => [] ← NewExportForModule[m.mti, htNull];
          ENDCASE => RETURN;
      ENDCASE => RETURN;
    header.nExports ← header.nExports + 1};

  NewExportForModule: PROC [mti: MTIndex, name: Symbols.HTIndex]
      RETURNS [eti: EXPIndex] = {
    OPEN Symbols;
    eti ← table.Words[exptype, EXPRecord.SIZE+1*Link.SIZE];
    etb[eti] ← [
      name: mtb[mti].name,
      size: 1,
      port: $module,
      namedInstance: name # htNull,
      typeExported: FALSE,
      file: mtb[mti].file,
      links: ];
    etb[eti].links[0] ← [variable[vgfi: mtb[mti].gfi, var: 0, vtag: $var]];
    IF name # htNull THEN {
      nti: NTIndex = table.Words[nttype, NTRecord.SIZE];
      ntb[nti] ← [name: BcdUtilDefs.NameForHti[name], item: [module[mti]]]};
    RETURN};

  ExportCx: PROC [cx: Symbols.CXIndex] = {
    OPEN Symbols;
    neweti, oldeti: EXPIndex;
    FOR sti: STIndex ← cxb[cx].link, stb[sti].link UNTIL sti = stNull DO {
      IF ~stb[sti].filename THEN 
	WITH s: stb[sti] SELECT FROM
	  external =>
	    WITH m: s.map SELECT FROM
	      interface => {  
		OPEN old: bcd.etb[oldeti], new: etb[neweti];
		-- first make sure that old is not already exported
		existingEti: EXPIndex ← EXPIndex.FIRST;
		etLimit: EXPIndex = table.Top[exptype];
		oldeti ← m.expi;
		UNTIL existingEti = etLimit DO
		  IF old = etb[existingEti] THEN GO TO AlreadyExported;
		  existingEti ← existingEti + EXPRecord.SIZE+etb[existingEti].size;
		  ENDLOOP;  
		neweti ← bcd.EnterExport[oldeti, TRUE];
		Copy[from: @old.links, to: @new.links, nwords: new.size];
		new.file ← MapFile[new.file];
		header.nExports ← header.nExports + 1};
	      ENDCASE;
	  ENDCASE;
      EXITS
	AlreadyExported => NULL}; 
      ENDLOOP};


 -- file mapping
 
  FileMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF FTIndex];
  fileMap: LONG POINTER TO FileMap ← NIL;

  IndexForFti: PROC [fti: FTIndex] RETURNS [CARDINAL] = INLINE {
    RETURN [LOOPHOLE[fti,CARDINAL]/FTRecord.SIZE]};

  FtiForIndex: PROC [n: CARDINAL] RETURNS [FTIndex] = INLINE {
    RETURN [FTIndex.FIRST + n*FTRecord.SIZE]};

  MapFile: PROC [fti: FTIndex] RETURNS [FTIndex] = {
    SELECT fti FROM
      FTNull, FTSelf => RETURN [fti];
      ENDCASE => {
	fileIndex: CARDINAL = IndexForFti[fti];
	IF fileMap[fileIndex] = FTNull THEN fileMap[fileIndex] ← bcd.MergeFile[fti];
	RETURN [fileMap[fileIndex]]}};

 -- header processing
 
   InitHeader: PROC [
      header: BcdOps.BcdBase,
      objectVersion: VersionStamp,
      source: NameRecord ← NullName,
      sourceVersion: VersionStamp ← NullVersion] = {
    Zero[header, BcdDefs.BCD.SIZE];
    header.versionIdent ← BcdDefs.VersionID;
    header.version ← objectVersion;
    header.creator ← data.binderVersion;
    header.definitions ← (data.op = $conc);
    header.typeExported ← data.typeExported;
    header.source ← source;  header.sourceVersion ← sourceVersion;
    header.repackaged ← 
      table.Bounds[sptype].size # 0 OR table.Bounds[fptype].size # 0;
    header.tableCompiled ← FALSE;
    header.spare1 ← TRUE};

    
  codeMap, symbolMap: REF Map ← NIL;

  Map: TYPE = RECORD [
    fti: FTIndex,
    type: SegClass,
    filename: Strings.String,
    filehandle: CIFS.OpenFile];

  InitCodeSymbolCopy: PROC = {

    Setup: PROC [file: Strings.String, type: SegClass] RETURNS [REF Map] = {
      RETURN [--(data.zone).--NEW[Map ← [
	type: type,
	filename: file,
	filehandle: nullFile,
	fti: IF file = NIL THEN FTSelf ELSE BcdUtilDefs.EnterFile[file]]]]};

    IF data.copyCode THEN codeMap ← Setup[data.codeName, $code];
    IF data.copySymbols THEN symbolMap ← Setup[data.symbolName, $symbols]};

  MapCodeSymbolFiles: PROC = {
    IF data.copyCode THEN codeMap.fti ← MapFile[codeMap.fti];
    IF data.copySymbols THEN symbolMap.fti ← MapFile[symbolMap.fti]};

  ReleaseCodeSymbolCopy: PROC = {

    Release: PROC [p: REF Map] = {
      IF p.filehandle # nullFile THEN {
        CIFS.Close[p.filehandle];  p.filehandle ← nullFile}};
	
    IF codeMap # NIL THEN {Release[codeMap]; --(data.zone).--FREE[@codeMap]};
    IF symbolMap # NIL THEN {Release[symbolMap]; --(data.zone).--FREE[@symbolMap]}};


  EnumerateSegments: PROC [proc: PROC[SGIndex]] = {
    sgLimit: SGIndex = table.Top[sgtype];
    FOR sgi: SGIndex ← SGIndex.FIRST, sgi + SGRecord.SIZE UNTIL sgi = sgLimit DO 
      proc[sgi] ENDLOOP};

  EnumerateOldSegments: PROC [proc: PROC[SGIndex]] = {
    IF ~packing THEN EnumerateSegments[proc]
    ELSE FOR i: NAT IN [0..sgMap.length) DO proc[SgiForIndex[i]] ENDLOOP};

  MapSegments: PROC [type: SegClass] = {
    CopySegment: PROC [sgi: SGIndex] = {
      IF sgb[sgi].class = type THEN 
        sgb[sgi].file ← MapFile[sgb[sgi].file]};
    EnumerateSegments[CopySegment]};


  InitFile: PROC [p: REF Map, copiedPages: CARDINAL]
      RETURNS [stream: Stream.Handle, page: CARDINAL] = {
    lh: BcdDefs.BCD;
    bcdPages: CARDINAL = PagesForWords[BcdDefs.BCD.SIZE];
    file: File.Capability;
    version: VersionStamp = BumpVersion[
      OSMiscOps.StampToTime[data.objectStamp], (IF p.type=$code THEN 1 ELSE 2)];
    BcdUtilDefs.SetFileVersion[p.fti, version];
    p.filehandle ← CIFS.Open[
	ConvertUnsafe.ToRope[p.filename], CIFS.create+CIFS.replace+CIFS.write];
    file ← CIFS.GetFC[p.filehandle];
    file.SetSize[1 + bcdPages + copiedPages];
    stream ← FileStream.Create[file];
    InitHeader[header: @lh, objectVersion: version];
    lh.version ← ftb[p.fti].version;
    stream.PutBlock[[@lh, 0, BcdDefs.BCD.SIZE*bytesPerWord]];
    page ← 1 + bcdPages};

  BumpVersion: PROC [v: VersionStamp, n: CARDINAL] RETURNS [VersionStamp] = {
    v.time ← v.time + n;  RETURN [v]};

  MoveToPageBoundary: PROC [stream: Stream.Handle, page: CARDINAL] = {
    FileStream.SetIndex[stream, Inline.LongMult[page, Environment.bytesPerPage]]};


 -- Code Packing

  PackHandle: TYPE = LONG POINTER TO PackItem;

  PackItem: TYPE = RECORD [
    link: PackHandle,
    newsgi: SGIndex,  -- in the new table
    item: SEQUENCE count: CARDINAL OF MTIndex];

  packing: BOOL;
  phHead, phTail: PackHandle ← NIL;


  MakePackItem: Tree.Scan = {
    -- t is Tree.null, a list of ids, or a list of lists of ids
    ph: PackHandle ← NIL;
    i, nsons: CARDINAL;

    Item: Tree.Scan = {
      itemId: Symbols.HTIndex;
      WITH t SELECT FROM
	symbol => {
	  itemId ← stb[index].hti;
	  WITH stb[index] SELECT FROM
	    external =>
	      WITH m: map SELECT FROM
		module => {
		  ph.item[i] ← m.mti;
		  SELECT TRUE FROM
		    ~mtb[m.mti].packageable =>
			BcdErrorDefs.ErrorNameBase[
				$error, "is packaged and cannot be PACKed"L,
				mtb[m.mti].name, bcd.ssb];
		    (ReadSgMap[mtb[m.mti].code.sgi] # SGNull) =>
			BcdErrorDefs.ErrorNameBase[
				$error, "cannot be PACKed twice"L,
				mtb[m.mti].name, bcd.ssb];
		    ENDCASE => SetSgMap[old: mtb[m.mti].code.sgi, new: ph.newsgi]};
		ENDCASE => GOTO cant;
	    ENDCASE => GOTO cant;
	  EXITS
	    cant => 
		BcdErrorDefs.ErrorHti[$error, "cannot be PACKed"L, itemId
		  ! BcdErrorDefs.GetSti => {RESUME [errorSti: Symbols.stNull]}]};
        ENDCASE;
      i ← i+1};

    IF t = Tree.null THEN RETURN;
    WITH t SELECT FROM
      subtree => {
	OPEN tt: tb[index];
	IF tt.name # $list THEN Error[];
	data.textIndex ← tt.info;
	IF tt.son[1].tag = $subtree THEN {TreeOps.ScanList[t,MakePackItem]; RETURN}};
      ENDCASE;
    nsons ← TreeOps.ListLength[t];
    ph ← (data.zone).NEW[PackItem[nsons] ← [ 
           link: NIL, newsgi: table.Words[sgtype, SGRecord.SIZE], item:]];
    FOR j: CARDINAL IN [0..nsons) DO ph.item[j] ← MTNull ENDLOOP;
    sgb[ph.newsgi] ← [class: $code, file: codeMap.fti, base:0, pages:0, extraPages:0];
    i ← 0;  TreeOps.ScanList[t, Item];
    IF phTail = NIL THEN phHead ← phTail ← ph
		    ELSE {phTail.link ← ph; phTail ← ph}};

  FreePackItems: PROC = {
    next: PackHandle ← phHead;
    UNTIL next = NIL DO
      p: PackHandle ← next;
      next ← next.link; (data.zone).FREE[@p]
      ENDLOOP;
    phHead ← phTail ← NIL};


  WriteFromPages: PROC [
      stream: Stream.Handle, pages: FileSegment.Pages, words: CARDINAL] = {
    bufferPages: CARDINAL = MIN[pages.span.pages, 16];
    bufferSpace: Space.Handle ← Space.Create[size: bufferPages, parent: Space.virtualMemory];
    base: CARDINAL ← pages.span.base;
    WHILE words # 0 DO
      wordsToTransfer: CARDINAL = MIN[words, bufferPages*Environment.wordsPerPage];
      pagesToTransfer: CARDINAL = PagesForWords[wordsToTransfer];
      bufferSpace.Map[[file: pages.file, base: base]];
      stream.PutBlock[[bufferSpace.LongPointer, 0, wordsToTransfer*bytesPerWord]];
      base ← (base + pagesToTransfer);
      words ← (words - wordsToTransfer);
      bufferSpace.Unmap[];
      ENDLOOP;
    Space.Delete[bufferSpace]};
    
      
  PackCodeSegments: PROC [out: Stream.Handle, startpage: CARDINAL]
      RETURNS [nextpage: CARDINAL] = {
    offset, validlength: CARDINAL;
    oldsgi: SGIndex;
    file: CIFS.OpenFile;
    pages: FileSegment.Pages;

    FixUpOneModule: PROC [mti: MTIndex] RETURNS [BOOL ← FALSE] = {
      OPEN module: mtb[mti];
      length: CARDINAL;
      IF module.code.sgi = oldsgi THEN {
	length ← module.code.offset + module.code.length/2;
	module.code.offset ← module.code.offset + offset;
	module.code.packed ← TRUE;
	IF length > validlength THEN validlength ← length};
      RETURN};

    nextpage ← startpage;
    FOR ph: PackHandle ← phHead, ph.link UNTIL ph = NIL DO
      MoveToPageBoundary[stream: out, page: (nextpage-1)];
      offset ← 0;
      sgb[ph.newsgi].base ← nextpage;
      FOR pi: CARDINAL IN [0..ph.count) DO {
	mti: MTIndex = ph.item[pi];
	IF mtb[mti].linkLoc = $code AND ~mtb[mti].code.linkspace THEN {
	  offset ← (AddLinksToCodeSegment[out, mti, offset, TRUE] + offset);
	  GOTO ignore};
        oldsgi ← mtb[mti].code.sgi;
        [file, pages] ← SegmentForOldCodeSgi[oldsgi];
	IF file = nullFile THEN GOTO ignore;
	IF (offset MOD Alignment) # 0 THEN
	  FOR i: CARDINAL IN [(offset MOD Alignment)..Alignment) DO
	    out.PutWord[0];  offset ← offset + 1 
	    ENDLOOP;
	validlength ← 0;  EnumerateModules[FixUpOneModule];
        WriteFromPages[stream: out, pages: pages, words: validlength];
        offset ← offset + validlength;
        CIFS.Close[file];
	EXITS
	  ignore => NULL};
        ENDLOOP;
      sgb[ph.newsgi].pages ← PagesForWords[offset]; 
      nextpage ← nextpage + sgb[ph.newsgi].pages;
      ENDLOOP;
    RETURN};

  SegmentForOldCodeSgi: PROC [sgi: SGIndex]
      RETURNS [f: CIFS.OpenFile ← nullFile, s: FileSegment.Pages ← nullPages] = {
    OPEN seg: bcd.sgb[sgi];
    IF Copied[sgi] OR seg.file = FTNull THEN RETURN;
    f ← FileForFti[seg.file];
    IF f = nullFile THEN 
      BcdErrorDefs.ErrorNameBase[
	class: $error, s: "could not be opened to copy code"L, 
	name: bcd.ftb[seg.file].name, base: bcd.ssb]
    ELSE {
      s ← [
	file: CIFS.GetFC[f],
	span: [base: seg.base, pages: (seg.pages + seg.extraPages)]];
      IF WrongOldSegVersion[s, bcd.ftb[seg.file].version] THEN {
	BcdErrorDefs.ErrorNameBase[
	  class: $error, s: "on disk has an incorrect version"L,
      	  name: bcd.ftb[seg.file].name, base: bcd.ssb];
        CIFS.Close[f];
	f ← nullFile;  s ← nullPages}};
    IF s.file = File.nullCapability THEN header.versionIdent ← 0;
    SetCopied[sgi]};

  WrongOldSegVersion: PROC [s: FileSegment.Pages, version: BcdDefs.VersionStamp] 
        RETURNS [reply: BOOL] = {
    h: BcdOps.BcdBase;
    headerSpace: Space.Handle ← Space.Create[size: 1, parent: Space.virtualMemory];
    headerSpace.Map[[file: s.file, base: 1]];
    h ← headerSpace.LongPointer;
    reply ← (h.version # version);
    Space.Delete[headerSpace];
    RETURN [reply]};


 -- Segment Mapping

  SGMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF SGIndex];
  CopyMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF BOOL];
  
  sgMap:   LONG POINTER TO SGMap ← NIL;
  copyMap: LONG POINTER TO CopyMap ← NIL;

  IndexForSgi: PROC [sgi: SGIndex] RETURNS [CARDINAL] = INLINE {
    RETURN [LOOPHOLE[sgi,CARDINAL]/SGRecord.SIZE]};

  SgiForIndex: PROC [i: CARDINAL] RETURNS [SGIndex] = INLINE {
    RETURN [SGIndex.FIRST + i*SGRecord.SIZE]};

  InitCopyMap: PROC [nsgis: CARDINAL] = {
    copyMap ← (data.zone).NEW[CopyMap[nsgis]];
    FOR i: CARDINAL IN [0..nsgis) DO copyMap[i] ← FALSE ENDLOOP};

  FreeCopyMap: PROC = {
    IF copyMap # NIL THEN (data.zone).FREE[@copyMap]};

  SetCopied: PROC [sgi: SGIndex] = {
    copyMap[IndexForSgi[sgi]] ← TRUE};

  Copied: PROC [sgi: SGIndex] RETURNS [BOOL] = {
    RETURN [copyMap[IndexForSgi[sgi]]]};


  InitSgMap: PROC [nsgis: CARDINAL] = {
    sgMap ← (data.zone).NEW[SGMap[nsgis]];
    FOR i: CARDINAL IN [0..nsgis) DO sgMap[i] ← BcdDefs.SGNull ENDLOOP};

  FreeSgMap: PROC = {IF sgMap # NIL THEN (data.zone).FREE[@sgMap]};

  SetSgMap: PROC [old, new: SGIndex] = {
    IF (packing AND old # SGNull) THEN sgMap[IndexForSgi[old]] ← new};

  ReadSgMap: PROC [old: SGIndex] RETURNS [SGIndex] = {
    RETURN [IF (~packing OR old = SGNull) THEN old ELSE sgMap[IndexForSgi[old]]]};


  FillInSgMap: PROC = {
    -- called only when packing (i.e. packing requested AND copyCode = TRUE)
    FOR i: CARDINAL IN [0..sgMap.length) DO
      IF sgMap[i] = SGNull THEN {
	oldsgi: SGIndex = SgiForIndex[i];
	newsgi: SGIndex = table.Words[sgtype, SGRecord.SIZE];
	sgb[newsgi] ← bcd.sgb[oldsgi];
	sgb[newsgi].file ←
	  (IF sgb[newsgi].class = $symbols THEN 
             (IF data.copySymbols THEN symbolMap.fti
	      ELSE MapFile[sgb[newsgi].file])
	   ELSE codeMap.fti);
	sgMap[i] ← newsgi};
      ENDLOOP};

  FixAllSgis: PROC = {
    -- replace all sgis with ReadSgMap[sgi]

    FixModule: PROC [mti: MTIndex] RETURNS [BOOL ← FALSE] = {
      OPEN m: mtb[mti];
      m.code.sgi ← ReadSgMap[m.code.sgi];
      m.sseg ← ReadSgMap[m.sseg]};

    FixSpace: PROC [spi: SPIndex] RETURNS [BOOL ← FALSE] = {
      OPEN sp: spb[spi];
      sp.seg ← ReadSgMap[sp.seg]};

    EnumerateModules[FixModule];
    EnumerateSpaces[FixSpace]};


 -- Code Links

  LinkCount: PROC [mti: MTIndex] RETURNS [CARDINAL] = INLINE {
    RETURN [WITH m: mtb[mti] SELECT FROM
      direct => m.length,
      indirect => IF m.links = LFNull THEN 0 ELSE lfb[m.links].length,
      multiple => IF m.links = LFNull THEN 0 ELSE lfb[m.links].length,
      ENDCASE => ERROR]};
      
  AlignOffset: PROC [offset: CARDINAL] RETURNS [CARDINAL] = INLINE {
    RETURN [((offset + (Alignment-1))/Alignment)*Alignment]};
    
    
  AddLinksToCodeSegment: PROC [
        stream: Stream.Handle, mti: MTIndex, offset: CARDINAL, packed: BOOL]
      RETURNS [CARDINAL] = {
    sgi: SGIndex = mtb[mti].code.sgi;
    codeLength: CARDINAL = mtb[mti].code.length/2;
    linkSpace: CARDINAL;
    f: CIFS.OpenFile;
    s: FileSegment.Pages;
    prefixWords: CARDINAL ← 0;

    FixOffset: PROC [mti: MTIndex] RETURNS [BOOL ← FALSE] = {
      OPEN c: mtb[mti].code;
      IF c.sgi = sgi THEN { 
        c.linkspace ← TRUE; c.offset ← c.offset+offset; c.packed ← packed}};

    [f, s] ← SegmentForOldCodeSgi[sgi];
    IF f = nullFile THEN RETURN [0];
    linkSpace ← LinkCount[mti];
    IF offset = 0 AND linkSpace # 0 THEN {
      prefixWords ← 1;
      stream.PutWord[linkSpace + Alignment - (linkSpace MOD Alignment)];
      offset ← offset+1};
    IF (offset+linkSpace) MOD Alignment # 0 THEN
      linkSpace ← linkSpace + Alignment - ((offset+linkSpace) MOD Alignment);
    offset ← offset + linkSpace;
    EnumerateModules[FixOffset];
    FOR i: CARDINAL IN [0..linkSpace) DO stream.PutWord[0] ENDLOOP;
    WriteFromPages[stream: stream, pages: s, words: codeLength];
    CIFS.Close[f];
    RETURN [prefixWords + linkSpace + codeLength]};


 -- code and symbol copying
 
  EstimateCopiedPages: PROC RETURNS [codePages, symbolPages: CARDINAL ← 0] = {
    -- estimates ignore possible packing of code
    packaged: BOOL ← FALSE;
    
    AddModule: PROC [mti: MTIndex] RETURNS [BOOL ← FALSE] = {
      OPEN m: mtb[mti];
      IF data.copyCode AND m.code.sgi # SGNull THEN {
        OPEN seg: bcd.sgb[m.code.sgi];
        IF ~m.packageable THEN packaged ← TRUE
        ELSE {
          IF m.linkLoc = $code AND ~m.code.linkspace THEN {
	    nLinks: CARDINAL = LinkCount[mti];
	    offset: CARDINAL = AlignOffset[IF nLinks=0 THEN 0 ELSE 1+nLinks];
	    codePages ← codePages + PagesForWords[offset + m.code.length/2]}
	  ELSE codePages ← codePages + seg.pages;
	codePages ← codePages + seg.extraPages}};
      IF data.copySymbols AND m.sseg # SGNull THEN {
        OPEN seg: bcd.sgb[m.sseg];
        symbolPages ← symbolPages + seg.pages + seg.extraPages};
      RETURN};
      
    AddSegment: PROC [oldSgi: SGIndex] = {
      OPEN seg: bcd.sgb[oldSgi];
      IF seg.class = $code THEN {
        package: BOOL ← FALSE;
        
        TestModule: PROC [mti: MTIndex] RETURNS [BOOL] = {
          OPEN m: mtb[mti];
          IF ~m.packageable AND m.code.sgi = oldSgi THEN package ← TRUE;
          RETURN [m.code.sgi = oldSgi]};
          
        EnumerateModules[TestModule];
        IF package THEN codePages ← codePages + seg.pages + seg.extraPages}};
        
    IF data.copyCode OR data.copySymbols THEN
      EnumerateModules[AddModule];
    IF data.copyCode AND packaged THEN
      EnumerateOldSegments[AddSegment];
    RETURN};
    
    
  MoveCodeSegments: PROC [copiedPages: CARDINAL] = {
    stream: Stream.Handle;
    nextPage: CARDINAL;

    AddLinks: PROC [mti: MTIndex] RETURNS [BOOL ← FALSE] = {
      OPEN m: mtb[mti];
      wordsWritten, pagesWritten: CARDINAL;
      newSgi: SGIndex;
--    IF ExecOps.CheckForAbort[] THEN ERROR UserAbort;
      IF m.linkLoc = $code AND ~m.code.linkspace AND m.packageable THEN {
	IF m.code.packed THEN BcdErrorDefs.ErrorName[
	  $error, "was previously PACKed and can not now have code links added"L, m.name]
	ELSE {
  	  MoveToPageBoundary[stream: stream, page: (nextPage-1)];
          wordsWritten ← AddLinksToCodeSegment[
  	    stream: stream, mti: mti, offset: 0, packed: FALSE];
          pagesWritten ← PagesForWords[wordsWritten];
          newSgi ← ReadSgMap[m.code.sgi];
          sgb[newSgi].file ← codeMap.fti;
          sgb[newSgi].base ← nextPage;
          sgb[newSgi].pages ← pagesWritten;
          nextPage ← nextPage + pagesWritten}}};

    MoveOne: PROC [oldSgi: SGIndex] = { 
      OPEN seg: bcd.sgb[oldSgi];
--    IF ExecOps.CheckForAbort[] THEN ERROR UserAbort;
      IF seg.class = $code THEN {
	f: CIFS.OpenFile;
	s: FileSegment.Pages;
        [f, s] ← SegmentForOldCodeSgi[oldSgi];
	IF f # nullFile THEN {
	  segPages: CARDINAL = s.span.pages;
	  newSgi: SGIndex = ReadSgMap[oldSgi];
	  sgb[newSgi].file ← codeMap.fti;
	  sgb[newSgi].base ← nextPage;
	  MoveToPageBoundary[stream: stream, page: (nextPage-1)];
	  WriteFromPages[
	    stream: stream, pages: s, 
            words: (segPages * Environment.wordsPerPage)];
          nextPage ← nextPage + segPages;
	  CIFS.Close[f]}}};

    IF codeMap.fti = FTSelf THEN {stream ← bcdStream; nextPage ← nextBcdPage}
    ELSE [stream, nextPage] ← InitFile[codeMap, copiedPages];
    nextPage ← PackCodeSegments[stream, nextPage];
    EnumerateModules[AddLinks];
    EnumerateOldSegments[MoveOne];
    IF codeMap.fti = FTSelf THEN nextBcdPage ← nextPage
    ELSE Stream.Delete[stream]};


  EnterMissingSymbolFiles: PROC = {

    CheckOneSymbolsFileSeg: PROC [oldSgi: SGIndex] = { 
      OPEN seg: bcd.sgb[oldSgi];
      IF (seg.class = $symbols) AND ~Copied[oldSgi] AND (seg.file # FTNull) THEN
	-- insure that a file entry exists for this file 
	[] ← MapFile[bcd.sgb[oldSgi].file]};

    EnumerateOldSegments[CheckOneSymbolsFileSeg]};

  MoveSymbolSegments: PROC [copiedPages: CARDINAL] = {
    stream: Stream.Handle;
    nextPage: CARDINAL;

    MoveOne: PROC [oldSgi: SGIndex] = { 
      OPEN seg: bcd.sgb[oldSgi];
      f: CIFS.OpenFile ← nullFile;
      newSgi: SGIndex;
--    IF ExecOps.CheckForAbort[] THEN ERROR UserAbort;
      IF (seg.class # $symbols) OR Copied[oldSgi] OR (seg.file = FTNull) THEN RETURN;
      newSgi ← ReadSgMap[oldSgi];
      f ← FileForFti[seg.file];
      IF f = nullFile THEN {
        BcdErrorDefs.ErrorNameBase[
	  class: $warning, s: "could not be opened to copy symbols"L, 
	  name: bcd.ftb[seg.file].name, base: bcd.ssb];
        sgb[newSgi] ← bcd.sgb[oldSgi];
        sgb[newSgi].file ← MapFile[bcd.sgb[oldSgi].file]}
      ELSE {
        s: FileSegment.Pages = [
	  file: CIFS.GetFC[f],
	  span: [base: seg.base, pages: (seg.pages + seg.extraPages)]];
        IF WrongOldSegVersion[s, bcd.ftb[seg.file].version] THEN {
	  BcdErrorDefs.ErrorNameBase[
	    class: $error, s: "on disk has incorrect version"L,
      	    name: bcd.ftb[seg.file].name, base: bcd.ssb];
          header.versionIdent ← 0}
        ELSE {
	  segPages: CARDINAL = s.span.pages;
	  sgb[newSgi].file ← symbolMap.fti;
          sgb[newSgi].base ← nextPage;
          MoveToPageBoundary[stream: stream, page: (nextPage-1)];
          WriteFromPages[
            stream: stream, pages: s, 
            words: (segPages * Environment.wordsPerPage)];
          nextPage ← nextPage + segPages};
	CIFS.Close[f]};
      SetCopied[oldSgi]};

    IF symbolMap.fti = FTSelf THEN {stream ← bcdStream; nextPage ← nextBcdPage}
    ELSE [stream, nextPage] ← InitFile[symbolMap, copiedPages];
    EnumerateOldSegments[MoveOne];
    IF symbolMap.fti = FTSelf THEN nextBcdPage ← nextPage
    ELSE Stream.Delete[stream]};


  FileForFti: PROC [oldFti: BcdDefs.FTIndex] RETURNS [f: CIFS.OpenFile] = {
    name: BcdDefs.NameRecord = bcd.ftb[oldFti].name;
    ssd: Strings.SubStringDescriptor ← [
      base: @bcd.ssb.string, offset: name, length: bcd.ssb.size[name]];
    nameStr: Strings.String ← [100];
    f ← nullFile;
    NormalizeFileName[in: @ssd, out: nameStr];
    f ← CIFS.Open[ConvertUnsafe.ToRope[nameStr], CIFS.read
	  ! CIFS.Error => TRUSTED {CONTINUE}];
    RETURN};

  NormalizeFileName: PROC [in: Strings.SubString, out: Strings.String] = {
    char: CHAR;
    dot: BOOL ← FALSE;
    out.length ← 0;
    FOR i: CARDINAL IN [in.offset .. in.offset+in.length) DO
      SELECT (char ← in.base[i]) FROM
	IN ['A..'Z] =>  char ← char + ('a-'A);
	'. =>  dot ← TRUE;
	ENDCASE;
      Strings.AppendChar[out, char];
      ENDLOOP;
    IF ~dot THEN Strings.AppendString[out, ".bcd"L]};
    
  -- Bcd Output Routines

  bcdStream: Stream.Handle;
  nextBcdPage: CARDINAL;

  WriteSubTable: PROC [selector: Table.Selector] = {
    base: Table.Base;
    size: CARDINAL;
    [base, size] ← table.Bounds[selector];
    bcdStream.PutBlock[[base, 0, size*bytesPerWord]]};

  TableOut: PROC = { 
    d, s: CARDINAL;
    bcdPages, codePages, symbolPages: CARDINAL;
    basePages: CARDINAL;
    rtPageCount: CARDINAL;
    saveNextPage: CARDINAL;
    saveIndex: FileStream.FileByteIndex;
    rtPageCount ← PagesForWords[BcdLiterals.LitSegSize[]];
      BEGIN OPEN header;
      IF firstdummy = 0 THEN firstdummy ← BcdUtilDefs.GetGfi[0];
      d ← BCD.SIZE;
      ssOffset ← d;  d ← d + (ssLimit ← table.Bounds[sstype].size);
      ctOffset ← d;  d ← d + (s ← table.Bounds[cttype].size);
      ctLimit ← LOOPHOLE[s];
      mtOffset ← d;  d ← d + (s ← table.Bounds[mttype].size);  
      mtLimit ← LOOPHOLE[s];  
      impOffset ← d;  d ← d + (s ← table.Bounds[imptype].size);
      impLimit ← LOOPHOLE[s];
      expOffset ← d;  d ← d + (s ← table.Bounds[exptype].size);
      expLimit ← LOOPHOLE[s];
      evOffset ← d;  d ← d + (s ← table.Bounds[evtype].size);
      evLimit ← LOOPHOLE[s, EVIndex];
      sgOffset ← d;  d ← d + (s ← table.Bounds[sgtype].size);
      sgLimit ← LOOPHOLE[s];
      ftOffset ← d;  d ← d + (s ← table.Bounds[fttype].size);
      ftLimit ← LOOPHOLE[s];
      ntOffset ← d;  d ← d + (s ← table.Bounds[nttype].size);
      ntLimit ← LOOPHOLE[s];
      typOffset ← d;  d ← d + (s ← table.Bounds[typtype].size);
      typLimit ← LOOPHOLE[s];
      tmOffset ← d;  d ← d + (s ← table.Bounds[tmtype].size);
      tmLimit ← LOOPHOLE[s];
      spOffset ← d;  d ← d + (s ← table.Bounds[sptype].size);
      spLimit ← LOOPHOLE[s];
      fpOffset ← d;  d ← d + (s ← table.Bounds[fptype].size);
      fpLimit ← LOOPHOLE[s];
      lfOffset ← d;  d ← d + (s ← table.Bounds[lftype].size);
      lfLimit ← LOOPHOLE[s];
      rfOffset ← d;  d ← d + (s ← table.Bounds[rftype].size);
      rfLimit ← LOOPHOLE[s];
      tfOffset ← d;  d ← d + (s ← table.Bounds[tftype].size);
      tfLimit ← LOOPHOLE[s];
      basePages ← PagesForWords[d];
      rtPages ← [relPageBase: basePages, pages: rtPageCount];
      extended ← TRUE;
      nPages ← bcdPages ← basePages + rtPageCount;
      END;
    [codePages, symbolPages] ← EstimateCopiedPages[];
    IF data.copyCode AND codeMap.fti = FTSelf THEN
      bcdPages ← bcdPages + codePages;
    IF data.copySymbols AND symbolMap.fti = FTSelf THEN
      bcdPages ← bcdPages + symbolPages;
    OpenOutputFile[1 + bcdPages];
    IF rtPageCount # 0 THEN {
      MoveToPageBoundary[stream: bcdStream, page: basePages];
      IF packing THEN BcdLiterals.UpdateSegments[ReadSgMap];
      BcdLiterals.WriteLiterals[bcdStream];
      saveIndex ← FileStream.GetIndex[bcdStream]};
    saveNextPage ← nextBcdPage ← header.nPages + 1;
    IF data.copyCode THEN MoveCodeSegments[codePages
      ! UserAbort => {GO TO AbortRequested}];
    IF data.copySymbols THEN MoveSymbolSegments[symbolPages
      ! UserAbort => {GO TO AbortRequested}];
    IF packing THEN FixAllSgis[];
    FileStream.SetIndex[bcdStream, 0];
    bcdStream.PutBlock[[header, 0, BCD.SIZE*bytesPerWord]];
    WriteSubTable[sstype];
    WriteSubTable[cttype];
    WriteSubTable[mttype];
    WriteSubTable[imptype];
    WriteSubTable[exptype];
    WriteSubTable[evtype];
    WriteSubTable[sgtype];
    WriteSubTable[fttype];
    WriteSubTable[nttype];
    WriteSubTable[typtype];
    WriteSubTable[tmtype];
    WriteSubTable[sptype];
    WriteSubTable[fptype];
    WriteSubTable[lftype];
    WriteSubTable[rftype];
    WriteSubTable[tftype];
    IF nextBcdPage # saveNextPage THEN
      MoveToPageBoundary[stream: bcdStream, page: (nextBcdPage-1)]
    ELSE IF rtPageCount # 0 THEN FileStream.SetIndex[bcdStream, saveIndex];
    data.nConfigs ← header.nConfigs; data.nModules ← header.nModules;
    data.nImports ← header.nImports; data.nExports ← header.nExports;
    data.nPages ← header.nPages;
    EXITS
      AbortRequested => data.aborted ← TRUE};


  OpenOutputFile: PROC [initialPages: CARDINAL] = INLINE {
    file: File.Capability ← data.outputFile;
    IF file = File.nullCapability THEN ERROR;
    file.SetSize[initialPages];
    bcdStream ← FileStream.Create[file]};

  CloseOutputFile: PROC = INLINE {Stream.Delete[bcdStream]; bcdStream ← NIL};

  }.