-- File: PackCodeImpl.mesa
-- Last edited by Sweet on 26-Feb-81 16:44:02
-- Last edited by Lewis on 15-May-81 18:08:49
-- Last edited by Levin on September 8, 1982 4:33 pm

DIRECTORY
  Alloc USING [AddNotify, Bounds, DropNotify, Handle, Notifier, Top, Words],
  Ascii,
  BcdDefs,
  BcdOps USING [
    CTHandle, EXPHandle, IMPHandle, MTHandle, NTHandle, ProcessConfigs, 
    ProcessExports, ProcessImports, ProcessModules, ProcessNames],
  BcdUtilDefs,
  CharIO,
  CodePackProcs USING [
    EnumerateCodePacks, EnumerateModules, EnumerateProcs, EnumerateSegments, 
    IsDiscardCodePack, ModuleIndex, SubStringForCodePackNode,
    SubStringForSegmentNode, TreeIndex],
  Error USING [ErrorName, SegmentTooLarge],
  FileTable USING [HandleForFile],
  FramePackModules USING [
    EnumerateFramePacks, EnumerateModules, SubStringForFramePackNode],
  Inline USING [LongCOPY, LongDiv, LongDivMod, LongMult, LowHalf],
  LongStorage USING [Free, FreePages, Node, Pages, PagesForWords],
  ModuleSymbols USING [constArray, innerPackArray, outerPackArray],
  Mopcodes USING [op, zJIB, zJIW, zLCO, zLI0, zLI6, zLIB, zLIW],
  OpTableDefs USING [InstLength],
  PackagerDefs USING [packctreetype, globalData, PackagerDataRecord],
  PackageSymbols USING [
    ConstRecord, IPIndex, IPNull, MaxEntries, OPIndex, WordIndex],
  PackCode USING [
    Address, FinalizeBcdTab, InitBcdTab, NullWordIndex, Problem, SeenModuleRecord, WordIndex],
  PackEnviron USING [
    BcdStringHandle, Byte, BytesPerPage, Copy, PageSize, SetBlock, StreamPosition],
  PackHeap USING [FreeSpace, GetSpace],
  PieceTable USING [
    Append, AppendPage, AppendQuadWord, AppendWord, CopyFromFile, Delete,
    GetByte, GetPlace, GetVPos, GetWord, Initialize, Length, Place,
    Position, PutWord, PutZeros, SetVPos, Store],
  PrincOps USING [CSegPrefix, EntryVectorItem],
  Segments USING [
    FHandle, GetFileTimes, LockFile, NewFile, UnlockFile, Write],
  SourceBcd USING [
    bcdBases, bcdHeader, CTreeIndex, LookupSS, moduleCount, ModuleNum,
    ModuleNumForMti, NullCTreeIndex],
  Streams USING [
    CreateStream, Destroy, GetIndex, Handle, PutByte, 
    PutBlock, Write],
  Strings,
  SymbolOps,
  Symbols,
  Table USING [Base, Limit, OrderedIndex],
  Time USING [Append, Current, Packed, Unpack];

PackCodeImpl: PROGRAM 
  IMPORTS 
    Alloc, BcdOps, BcdUtilDefs, CharIO, CodePackProcs, Error, FileTable,
    FramePackModules, Inline, LongStorage, ModuleSymbols, OpTableDefs,
    PackagerDefs, PackCode, PackEnviron, PackHeap, PieceTable, Segments, SourceBcd,
    Streams, Strings, SymbolOps, Time 
  EXPORTS PackCode =
  BEGIN

  gd: LONG POINTER TO PackagerDefs.PackagerDataRecord;  -- PackagerDefs.globalData
  spb, sgb, fpb, ctreeb: Table.Base;
  itb, etb, ctb, mtb, ntb: Table.Base;
  ssb: PackEnviron.BcdStringHandle;

  table: Alloc.Handle ← NIL;
  
  Notify: Alloc.Notifier =
    BEGIN
    ctreeb ← base[PackagerDefs.packctreetype];
    sgb    ← base[BcdDefs.sgtype];
    spb    ← base[BcdDefs.sptype];
    fpb    ← base[BcdDefs.fptype];
    ssb    ← base[BcdDefs.sstype];
    itb    ← base[BcdDefs.imptype];
    etb    ← base[BcdDefs.exptype];
    ctb    ← base[BcdDefs.cttype];
    mtb    ← base[BcdDefs.mttype];
    ntb    ← base[BcdDefs.nttype];
    END;

  EntryIndex: TYPE = [0..PackageSymbols.MaxEntries);

  PackError: PUBLIC SIGNAL [reason: PackCode.Problem] = CODE;

  cstb: LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.ConstRecord;

  seenModules: LONG DESCRIPTOR FOR ARRAY OF PackCode.SeenModuleRecord;
  newConstants: PUBLIC LONG POINTER TO ARRAY [0..0) OF PackCode.WordIndex;

  oldCodeFile: PUBLIC Segments.FHandle;
  oldCodeBasePosition: PackEnviron.StreamPosition;

  currentModule: BcdDefs.MTIndex;
  firstCodeSgi: BcdDefs.SGIndex;
  currentCodeSegment: PUBLIC BcdDefs.SGIndex;
  currentSpaceIndex: PUBLIC BcdDefs.SPIndex;
  segmentPosition: PUBLIC PieceTable.Position;
  codePackPosition: PUBLIC PieceTable.Position;
  codeBasePosition: PUBLIC PieceTable.Position;
  codeBaseOffset: PUBLIC PackCode.Address; -- from start of code segment
  procOffset: PUBLIC PackCode.Address; -- from codeBase
  procPosition: PUBLIC PieceTable.Position;
  lastProcEnd: PieceTable.Position;
  firstCodePack, currentCodePackResident: BOOLEAN;

  outStream: Streams.Handle;

  WriteChar: PROC [c: CHARACTER] = 
    {IF gd.mapStream # NIL THEN CharIO.PutChar[gd.mapStream, c]};

  WriteString: PROC [s: Strings.String] = 
    {IF gd.mapStream # NIL THEN CharIO.PutString[gd.mapStream, s]};

  WriteSubString: PROC [ss: Strings.SubString] = 
    BEGIN
    FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
      WriteChar[ss.base[i]];
      ENDLOOP;
    END;

  WriteDecimal: PROC [n: CARDINAL] = 
    {IF gd.mapStream # NIL THEN CharIO.PutDecimal[gd.mapStream, n]};

  WriteNumber: PROC [n: CARDINAL, fmt: CharIO.NumberFormat] = 
    {IF gd.mapStream # NIL THEN CharIO.PutNumber[gd.mapStream, n, fmt]};
    
  WriteCR: PROC = INLINE {WriteChar[Ascii.CR]};

  WriteTime: PROC [t: Time.Packed] =
    BEGIN
    s: STRING ← [20];
    Time.Append[s, Time.Unpack[t]];
    WriteString[s];
    END;


  Initialize: PROCEDURE [nModules: CARDINAL] =
    BEGIN
    gd ← PackagerDefs.globalData;
    table ← gd.ownTable;
    table.AddNotify[Notify];
    PackCode.InitBcdTab[];
    seenModules ← DESCRIPTOR [
      LongStorage.Pages[
	LongStorage.PagesForWords[nModules * SIZE[PackCode.SeenModuleRecord]]],
      nModules];
    FOR i: CARDINAL IN [0..nModules) DO seenModules[i] ← [] ENDLOOP;
    nMods ← nModules;
    END;
    
  nMods: CARDINAL;

  Finalize: PUBLIC PROCEDURE =
    BEGIN
    IF table ~= NIL THEN table.DropNotify[Notify];
    FOR i: CARDINAL IN [0..nMods) DO 
      IF seenModules[i].newConstants # NIL THEN PackHeap.FreeSpace[seenModules[i].newConstants];
      ENDLOOP;
    PackCode.FinalizeBcdTab[];
    LongStorage.FreePages[BASE[seenModules]];
    seenModules ← DESCRIPTOR [NIL, 0];
    table ← NIL;
    END;

  GetNewConstants: PROCEDURE [
      mNum: SourceBcd.ModuleNum] RETURNS [new: BOOLEAN] =
    BEGIN
    new ← ~seenModules[mNum].seen;
    cstb ← ModuleSymbols.constArray;
    IF LENGTH[cstb] # 0 AND new THEN
      BEGIN
      seenModules[mNum].newConstants ← PackHeap.GetSpace[LENGTH[cstb]*SIZE[PackCode.WordIndex]];
      PackEnviron.SetBlock[
        p: seenModules[mNum].newConstants,
        v: PackCode.NullWordIndex,
        n: (LENGTH[cstb]) * SIZE[PackCode.WordIndex]];
      END;
    newConstants ← seenModules[mNum].newConstants;
    RETURN
    END;

  NewOffset: PUBLIC PROCEDURE [old: PackCode.WordIndex]
      RETURNS [PackCode.WordIndex] =
    BEGIN -- address in new segment of multiword constant a "old" in old
    l, u, i: INTEGER;
    delta: CARDINAL;
    l ← 0; u ← LENGTH[cstb];
    UNTIL l > u DO
      i ← (l+u)/2;
      SELECT cstb[i].offset FROM
        < old => l ← i+1;
        > old => u ← i-1;
        ENDCASE => EXIT;
      REPEAT
	FINISHED => i ← u;
      ENDLOOP;
    IF i < 0 THEN PackError[InvalidCodeOffset];
    delta ← old - cstb[i].offset;
    IF delta > cstb[i].length THEN PackError[InvalidCodeOffset];
    IF newConstants[i] = PackCode.NullWordIndex THEN
      BEGIN
      savePos: PieceTable.Position = PieceTable.GetVPos[];
      newConstants[i] ← CodeOffset[PieceTable.AppendWord[]];
      PieceTable.CopyFromFile[
        file: oldCodeFile, 
        position: oldCodeBasePosition + cstb[i].offset*2, 
        length: cstb[i].length*2];
      PieceTable.SetVPos[savePos];
      END;
    RETURN[newConstants[i] + delta];
    END;

  CopyBodies: PUBLIC PROCEDURE [root: PackageSymbols.OPIndex]
      RETURNS [stop: BOOLEAN] =
    BEGIN -- copy procedure (and any nested below unless main body)
    i: PackageSymbols.IPIndex;
    IF gd.printMap THEN DisplayNumbers[
      ep: ModuleSymbols.outerPackArray[root].entryIndex,
      length: (ModuleSymbols.outerPackArray[root].length+1)/2,
      hti: ModuleSymbols.outerPackArray[root].hti];
    CopyOneBody[
      ModuleSymbols.outerPackArray[root].entryIndex,
      ModuleSymbols.outerPackArray[root].length];
    i ← ModuleSymbols.outerPackArray[root].firstSon;
    IF i # PackageSymbols.IPNull THEN
      DO
      IF gd.printMap THEN DisplayNumbers[
        ep: ModuleSymbols.innerPackArray[i].entryIndex, 
        length: (ModuleSymbols.innerPackArray[i].length+1)/2, 
	hti: Symbols.HTNull];
        CopyOneBody[
	  ModuleSymbols.innerPackArray[i].entryIndex, 
	  ModuleSymbols.innerPackArray[i].length];
        IF ModuleSymbols.innerPackArray[i].lastSon THEN EXIT;
	i ← i+1;
        ENDLOOP;
    RETURN[FALSE];
    END;

  FullWordBytes: PROCEDURE [n: CARDINAL] RETURNS [CARDINAL] = INLINE
    BEGIN
    RETURN [n MOD 2 + n];
    END;

  SegmentOffset: PROCEDURE [pos: PieceTable.Position]
      RETURNS [PackCode.WordIndex] =
    BEGIN
    new: LONG CARDINAL = pos - segmentPosition;
    IF new > LAST[CARDINAL] THEN PackError[SegmentTooBig];
    RETURN [Inline.LowHalf[new]/2];
    END;

  CodeOffset: PROCEDURE [pos: PieceTable.Position]
      RETURNS [PackCode.WordIndex] =
    BEGIN
    new: LONG CARDINAL = pos - codeBasePosition;
    IF new > LAST[CARDINAL] THEN PackError[SegmentTooBig];
    RETURN [Inline.LowHalf[new]/2];
    END;

  CopyOneBody: PROCEDURE [ep: EntryIndex, length: CARDINAL] =
    BEGIN
    eviOffset: POINTER;
    oldProcOffset: PackCode.WordIndex;
    codeLength: CARDINAL ← length;
    vicinity: PieceTable.Place;
    
    -- copy code into output file
    procPosition ← PieceTable.AppendWord[];
    procOffset ← CodeOffset[procPosition];
    vicinity ← PieceTable.GetPlace[];
    -- for main body, word -1 is global frame size, used by CopyNew
    IF ep = 0 THEN procOffset ← procOffset + 1;
    -- fix up entry vector for module
    eviOffset ← 
      @(LOOPHOLE[1, POINTER TO PrincOps.CSegPrefix].entry[ep].initialpc) - 1;   
    PieceTable.SetVPos[
      codeBasePosition + 2*LOOPHOLE[eviOffset, CARDINAL], @evPlace]; 
    oldProcOffset ← PieceTable.GetWord[];
    PieceTable.Delete[-2];
    PieceTable.PutWord[procOffset];
    PieceTable.SetVPos[procPosition, @vicinity];
    IF ep = 0 THEN {oldProcOffset ← oldProcOffset-1; length ← length + 2};
    PieceTable.CopyFromFile[
      file: oldCodeFile,
      position: oldProcOffset*2 + oldCodeBasePosition,
      length: FullWordBytes[length]];
    IF ep = 0 THEN procPosition ← procPosition + 2;
   
    -- now get ready to look for multiword constants
    PieceTable.SetVPos[procPosition];
    BEGIN OPEN Mopcodes; -- constant search
    op: PackEnviron.Byte;
    lastConstant: CARDINAL ← 0; -- negative constants need not apply
    il: CARDINAL;
    WHILE codeLength > 0 DO
      op ← PieceTable.GetByte[];
      il ← OpTableDefs.InstLength[op];
      BEGIN -- to set up vanilla label
      SELECT op FROM
	IN [zLI0..zLI6] => {lastConstant ← op - zLI0; GO TO vanilla};
	zLIB => lastConstant ← PieceTable.GetByte[];
	zLIW => lastConstant ← PieceTable.GetWord[];
	-- zLINB, zLINI, zLIN1 not interesting for JIB/JIW case
	zJIB, zJIW =>
	  BEGIN
	  newTableOffset: PackCode.WordIndex;
          oldTableOffset: PackCode.WordIndex = PieceTable.GetWord[];
	  savePos: PieceTable.Position = PieceTable.GetVPos[];
	  IF lastConstant = 0 THEN PackError[StrangeJI];
	  IF op = zJIB THEN lastConstant ← (lastConstant+1)/2;
	  -- copy table to output file
	  newTableOffset ← CodeOffset[PieceTable.AppendWord[]];
	  PieceTable.CopyFromFile[
	    file: oldCodeFile,
	    position: oldCodeBasePosition+oldTableOffset*2,
	    length: lastConstant*2];
	  PieceTable.SetVPos[savePos];
	  PieceTable.Delete[-2];
	  PieceTable.PutWord[newTableOffset];
	  lastConstant ← 0;
	  END;
	zLCO =>
	  BEGIN
	  old: CARDINAL = PieceTable.GetWord[];
          new: CARDINAL = NewOffset[old];
	  PieceTable.Delete[-2];
	  PieceTable.PutWord[new];
	  END;
	ENDCASE => GO TO vanilla;
      EXITS vanilla => THROUGH (1..il] DO [] ← PieceTable.GetByte[]; ENDLOOP;
      END;
      codeLength ← codeLength - il;
      ENDLOOP;
    END; -- of constant search
    END;

  CreateNewSegment: PROC [segNode: CodePackProcs.TreeIndex] RETURNS [BOOLEAN] =
    BEGIN
    endPosition: PieceTable.Position;
    base, pages: CARDINAL;
    desc: Strings.SubStringDescriptor;
    CodePackProcs.SubStringForSegmentNode[@desc, segNode];
    IF gd.printMap THEN
      BEGIN
      WriteChar[Ascii.CR];
      WriteString["Segment: "L];  WriteSubString[@desc];
      WriteChar[Ascii.CR];
      WriteChar[Ascii.CR];
      END;
    currentCodeSegment ←
      table.Words[BcdDefs.sgtype, SIZE[BcdDefs.SGRecord]];
    currentSpaceIndex ←
      table.Words[BcdDefs.sptype, SIZE[BcdDefs.SPRecord]];
    spb[currentSpaceIndex] ← [seg: currentCodeSegment, length: 0, spaces: NULL];
    segmentPosition ← PieceTable.AppendPage[];
    firstCodePack ← TRUE;
    CodePackProcs.EnumerateCodePacks[segNode, CreateCodePack 
      ! PackError =>
          IF reason = SegmentTooBig THEN Error.SegmentTooLarge[error, @desc]];
    IF ~firstCodePack THEN FinishCodePack[];
    endPosition ← PieceTable.Length[];
    base ← Inline.LongDiv[segmentPosition, PackEnviron.BytesPerPage];
    pages ← LongStorage.PagesForWords[
      (CARDINAL[Inline.LowHalf[endPosition - segmentPosition]]+1)/2];
    sgb[currentCodeSegment] ← [
      class: code,
      file: BcdDefs.FTSelf,
      base: base,
      pages: pages,
      extraPages: 0];
    RETURN[FALSE]
    END;

  CreateFramePack: PROC [fpNode: CodePackProcs.TreeIndex] RETURNS [BOOLEAN] =
    BEGIN
    fpi: BcdDefs.FPIndex = table.Words[
      BcdDefs.fptype, SIZE[BcdDefs.FPRecord]];
    desc: Strings.SubStringDescriptor;
    nameCopy: STRING ← [80];
    name: BcdDefs.NameRecord;
    totalFrameWords, inLastPage: CARDINAL ← 0;

    AddModToPack: PROC [mti: BcdDefs.MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      n: CARDINAL = fpb[fpi].length;
      offset: CARDINAL ← 0;
      [] ← table.Words[BcdDefs.fptype, SIZE[BcdDefs.MTIndex]];
      fpb[fpi].modules[n] ← mti;
      fpb[fpi].length ← n+1;
      IF gd.printMap THEN
        BEGIN
	mth: BcdOps.MTHandle = @mtb[mti];
	offset ← ((totalFrameWords+3)/4)*4;
	WriteNumber[mth.framesize, Decimal6];
	WriteNumber[offset, Octal7];  WriteChar['B];
	totalFrameWords ← totalFrameWords + mth.framesize;
	WriteString["    "];
	[] ← WriteName[mth.name];
	WriteChar[Ascii.CR];
	END;
      RETURN[FALSE]
      END;

    FramePackModules.SubStringForFramePackNode[@desc, fpNode];
    Strings.AppendSubString[nameCopy, @desc];
    desc ← [base: nameCopy, offset: 0, length: nameCopy.length];
    fpb[fpi].name ← name ← BcdUtilDefs.EnterName[@desc];
    IF gd.printMap THEN
      BEGIN
      WriteChar[Ascii.CR];
      WriteString["Frame Pack: "L];
      [] ← WriteName[name];
      WriteChar[Ascii.CR];
      WriteString["length  offset    Module"L];
      WriteChar[Ascii.CR];
      END;
    fpb[fpi].length ← 0;
    FramePackModules.EnumerateModules[fpNode, AddModToPack];
    IF gd.printMap THEN
      BEGIN
      inLastPage ← totalFrameWords MOD PackEnviron.PageSize;
      IF inLastPage # 0 THEN
        BEGIN
        WriteNumber[PackEnviron.PageSize - inLastPage, Decimal6];
        WriteString["            unused"L];
        WriteChar[Ascii.CR];
        END;
      WriteString["Frame pack pages: "L];
      WriteDecimal[LongStorage.PagesForWords[totalFrameWords]];
      WriteChar[Ascii.CR]; WriteChar[Ascii.CR];
      END;
    RETURN[FALSE]
    END;

  StartModule: PUBLIC PROCEDURE [mti: BcdDefs.MTIndex] =
    BEGIN
    mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
    IF GetNewConstants[mNum].new THEN
      BEGIN
      mth: BcdOps.MTHandle = @mtb[mti];
      cd: BcdDefs.CodeDesc ← mth.code;
      file: BcdDefs.FTIndex = mth.file;
      name: BcdDefs.NameRecord = mth.name;
      sgr: BcdDefs.SGRecord = SourceBcd.bcdBases.sgb[cd.sgi];
      nEntries: CARDINAL = LENGTH[ModuleSymbols.outerPackArray] +
	LENGTH[ModuleSymbols.innerPackArray];
      evWords: CARDINAL = SIZE[PrincOps.CSegPrefix] +
	  nEntries * SIZE[PrincOps.EntryVectorItem];
      oldCodeFile ← FileTable.HandleForFile[sgr.file];
      oldCodeBasePosition ← 2 *
        (Inline.LongMult[sgr.base-1, PackEnviron.PageSize] + LONG[cd.offset]);
      IF mth.linkLoc = code THEN
	BEGIN
	pos: LONG CARDINAL ← PieceTable.AppendWord[];
        fLength: CARDINAL = NLinks[mth];
	delta: CARDINAL ← (CARDINAL[Inline.LowHalf[pos]] + fLength) MOD 4;
        IF delta # 0 THEN delta ← 4 - delta;
        PieceTable.PutZeros[(fLength + delta)*2];
	cd.linkspace ← TRUE;
	END;
      codeBasePosition ← PieceTable.AppendQuadWord[];
      codeBaseOffset ← SegmentOffset[codeBasePosition];
      IF gd.printMap THEN 
        DisplayNumbers[ep: -1, length: evWords, hti: Symbols.HTNull];
      PieceTable.CopyFromFile[
	file: oldCodeFile, 
	position: oldCodeBasePosition,
        length: evWords*2];
      -- update seenModules array entry
      evPlace ← PieceTable.GetPlace[];
      seenModules[mNum] ← [
        seen: TRUE,
	newOffset: codeBaseOffset,
	newPiece: evPlace.pi,
	oldCodeFile: oldCodeFile,
	oldCodePosition: oldCodeBasePosition,
	newConstants: newConstants];
      -- update module table in bcd
      cd.offset ← codeBaseOffset;
      cd.sgi ← currentCodeSegment;
      cd.length  ← 0;
      BEGIN -- look for all prototypes of this name
      desc: Strings.SubStringDescriptor ← [
	base: @ssb.string,
	offset: name,
	length: ssb.size[name]];
      cTreeNode: SourceBcd.CTreeIndex ← SourceBcd.LookupSS[@desc, prototype];
      WHILE cTreeNode # SourceBcd.NullCTreeIndex DO
        WITH ctr: ctreeb[cTreeNode].index SELECT FROM
	  module =>
	    BEGIN
	    pmth: BcdOps.MTHandle = @mtb[ctr.mti];
	    IF pmth.file = file THEN pmth.code ← cd;
	    END;
          ENDCASE;
	cTreeNode ← ctreeb[cTreeNode].prototypePrev;
	ENDLOOP;
      END;
      END
    ELSE
      BEGIN
      [newOffset: codeBaseOffset,
	newPiece: evPlace.pi,
        oldCodeFile: oldCodeFile,
        oldCodePosition: oldCodeBasePosition] ← seenModules[mNum];
      codeBasePosition ← segmentPosition + 2*codeBaseOffset;
      evPlace.pos ← codeBasePosition;
      END;
    END;

  NLinks: PROCEDURE [mth: BcdOps.MTHandle] RETURNS [nLinks: [0..Table.Limit)] =
    BEGIN
    WITH mth: mth SELECT FROM
      direct => RETURN[mth.length];
      indirect => RETURN[SourceBcd.bcdBases.lfb[mth.links].length];
      multiple => RETURN[SourceBcd.bcdBases.lfb[mth.links].length];
      ENDCASE;
    END;

  evPlace: PieceTable.Place;

  CopyFakeModule: PROCEDURE [mti: BcdDefs.MTIndex] =
    BEGIN
    mth: BcdOps.MTHandle = @mtb[mti];
    cd: BcdDefs.CodeDesc ← mth.code;
    file: BcdDefs.FTIndex = mth.file;
    name: BcdDefs.NameRecord = mth.name;
    sgr: BcdDefs.SGRecord = SourceBcd.bcdBases.sgb[cd.sgi];
    oldCodeFile ← FileTable.HandleForFile[sgr.file];
    oldCodeBasePosition ← 2 *
      (Inline.LongMult[sgr.base-1, PackEnviron.PageSize] + LONG[cd.offset]);
    codeBasePosition ← PieceTable.AppendQuadWord[];
    codeBaseOffset ← SegmentOffset[codeBasePosition];
    IF gd.printMap THEN 
      DisplayNumbers[ep: -1, length: (cd.length+1)/2, hti: Symbols.HTNull];
    PieceTable.CopyFromFile[
      file: oldCodeFile, 
      position: oldCodeBasePosition,
      length: cd.length];
    -- update module table in bcd
    cd.offset ← codeBaseOffset;
    cd.sgi ← currentCodeSegment;
    cd.length  ← 0;
    BEGIN -- look for all prototypes of this name
    desc: Strings.SubStringDescriptor ← [
      base: @ssb.string,
      offset: name,
      length: ssb.size[name]];
    cTreeNode: SourceBcd.CTreeIndex ← SourceBcd.LookupSS[@desc, prototype];
    WHILE cTreeNode # SourceBcd.NullCTreeIndex DO
      WITH ctr: ctreeb[cTreeNode].index SELECT FROM
        module =>
          BEGIN
          pmth: BcdOps.MTHandle = @mtb[ctr.mti];
          IF pmth.file = file THEN pmth.code ← cd;
          END;
        ENDCASE;
      cTreeNode ← ctreeb[cTreeNode].prototypePrev;
      ENDLOOP;
    END;
    END;

  DiscardAllInPack: PROC [cpNode: CodePackProcs.TreeIndex] =
    BEGIN
    needEntryVector: BOOLEAN ← FALSE;
    offset, pages: CARDINAL;
    spii: Table.Base RELATIVE POINTER [0..Table.Limit) TO BcdDefs.SpaceID;
    name: BcdDefs.NameRecord;
    nameCopy: STRING ← [80];
    desc: Strings.SubStringDescriptor;
    endPosition: PieceTable.Position;

    CheckModule: PROC [
	mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
      RETURNS [BOOLEAN] =
      BEGIN
      mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
      RETURN[needEntryVector ← ~seenModules[mNum].seen];
      END;

    CodePackProcs.EnumerateModules[cpNode, CheckModule];
    IF needEntryVector THEN
      BEGIN
      CodePackProcs.SubStringForCodePackNode[@desc, cpNode];
      Strings.AppendSubString[nameCopy, @desc];
      desc ← [base: nameCopy, offset: 0, length: nameCopy.length];
      name ← BcdUtilDefs.EnterName[@desc];
      codePackPosition ← PieceTable.AppendPage[];
      END;
    CodePackProcs.EnumerateModules[cpNode, DiscardThisModule];
    IF needEntryVector THEN
      BEGIN
      endPosition ← PieceTable.Length[];
      offset ← Inline.LongDiv[
        codePackPosition - segmentPosition, PackEnviron.BytesPerPage];
      pages ← LongStorage.PagesForWords[
        (CARDINAL[Inline.LowHalf[endPosition - codePackPosition]]+1)/2];
      spii ← table.Words[BcdDefs.sptype, SIZE[BcdDefs.SpaceID]];
      spb[spii] ← [name: name, resident: FALSE, offset: offset, pages: pages];
      spb[currentSpaceIndex].length ← spb[currentSpaceIndex].length + 1;
      END;
    END;

  DiscardThisModule: PROCEDURE [
    mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
      RETURNS [BOOLEAN] =
    BEGIN
    StartModule[mti];
    CodePackProcs.EnumerateProcs[module, DiscardThisProc];
    newConstants ← NIL;
    RETURN[FALSE]
    END;

  DiscardThisProc: PUBLIC PROCEDURE [root: PackageSymbols.OPIndex]
      RETURNS [stop: BOOLEAN] =
    BEGIN -- copy procedure (and any nested below unless main body)
    i: PackageSymbols.IPIndex;
    DiscardOneBody[ModuleSymbols.outerPackArray[root].entryIndex];
    i ←  ModuleSymbols.outerPackArray[root].firstSon;
    IF i # PackageSymbols.IPNull THEN
      DO
        DiscardOneBody[ModuleSymbols.innerPackArray[i].entryIndex];
        IF ModuleSymbols.innerPackArray[i].lastSon THEN EXIT;
	i ← i+1;
        ENDLOOP;
    RETURN[FALSE];
    END;

  DiscardOneBody: PROCEDURE [ep: EntryIndex] =
    BEGIN
    eviOffset: POINTER;
    
    -- fix up entry vector for module
    eviOffset ← 
      @(LOOPHOLE[1, POINTER TO PrincOps.CSegPrefix].entry[ep].initialpc) - 1;   
    PieceTable.SetVPos[codeBasePosition + 2*LOOPHOLE[eviOffset, CARDINAL]]; 
    PieceTable.Delete[2];
    PieceTable.PutWord[0];
    END;

  CreateCodePack: PROCEDURE [cpNode: CodePackProcs.TreeIndex]
      RETURNS [BOOLEAN] =
    BEGIN
    offset, pages: CARDINAL;
    spii: Table.Base RELATIVE POINTER [0..Table.Limit) TO BcdDefs.SpaceID;
    name: BcdDefs.NameRecord;
    nameCopy: STRING ← [80];
    desc: Strings.SubStringDescriptor;
    endPosition: PieceTable.Position;
    discard: BOOLEAN = CodePackProcs.IsDiscardCodePack[cpNode];

    CodePackProcs.SubStringForCodePackNode[@desc, cpNode];
    Strings.AppendSubString[nameCopy, @desc];
    desc ← [base: nameCopy, offset: 0, length: nameCopy.length];
    name ← BcdUtilDefs.EnterName[@desc];
    IF gd.printMap THEN
      BEGIN
      IF firstCodePack THEN firstCodePack ← FALSE
      ELSE FinishCodePack[];
      WriteString["Code Pack: "L];
      [] ← WriteName[name];
      WriteChar[Ascii.CR];
      PrintHeader[];
      END;
    IF discard THEN {DiscardAllInPack[cpNode]; RETURN [FALSE]};
    currentCodePackResident ← FALSE;  -- set TRUE if any modules resident
    lastProcEnd ← codePackPosition ← PieceTable.AppendPage[];
    CodePackProcs.EnumerateModules[cpNode, CopyModuleToPack];
    endPosition ← PieceTable.Length[];
    offset ← Inline.LongDiv[
      codePackPosition - segmentPosition, PackEnviron.BytesPerPage];
    pages ← LongStorage.PagesForWords[
      (CARDINAL[Inline.LowHalf[endPosition - codePackPosition]]+1)/2];
    spii ← table.Words[BcdDefs.sptype, SIZE[BcdDefs.SpaceID]];
    spb[spii] ← [
      name: name, resident: currentCodePackResident, 
      offset: offset, pages: pages];
    spb[currentSpaceIndex].length ← spb[currentSpaceIndex].length + 1;
    RETURN[FALSE]
    END;

  FinishCodePack: PROC =
    BEGIN
    endPosition: PieceTable.Position = PieceTable.AppendWord[];
    totalBytes: CARDINAL ← Inline.LowHalf[endPosition - codePackPosition];
    gap: CARDINAL;
    delta: CARDINAL = CARDINAL[Inline.LowHalf[endPosition]] MOD PackEnviron.BytesPerPage;
    IF lastProcEnd # 0 AND endPosition > lastProcEnd THEN {
      IF gd.printMap THEN NoteData[
	offset: SegmentOffset[lastProcEnd],
	length: (Inline.LowHalf[endPosition-lastProcEnd])/2]};
    IF delta # 0 AND gd.printMap THEN { 
      gap ← (PackEnviron.BytesPerPage - delta)/2;
      WriteNumber[gap, Decimal5];
      WriteString["  unused"L];
      WriteChar[Ascii.CR]};
    IF gd.printMap THEN {
      WriteString["Code pack pages: "L];
      WriteDecimal[
        (totalBytes + PackEnviron.BytesPerPage - 1) / PackEnviron.BytesPerPage];
      WriteChar[Ascii.CR]; WriteChar[Ascii.CR]};
    firstCodePack ← FALSE;
    END;

  CopyModuleToPack: PROCEDURE [
    mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
      RETURNS [BOOLEAN] =
    BEGIN
    currentModule ← mti;
    IF mtb[mti].tableCompiled THEN
      {CopyFakeModule[mti]; RETURN[FALSE]};
    IF mtb[mti].residentFrame THEN
      currentCodePackResident ← TRUE;
    StartModule[mti];
    CodePackProcs.EnumerateProcs[module, CopyBodies];
    newConstants ← NIL;
    RETURN[FALSE]
    END;

  ComputeCodePlacement: PUBLIC PROC =
    BEGIN
    Initialize[SourceBcd.moduleCount];
    RemapOldBcd[];
    IF gd.errors THEN RETURN;
    firstCodeSgi ← LOOPHOLE[table.Top[BcdDefs.sgtype]];
    PieceTable.Initialize[];
    firstCodePack ← TRUE;
    lastProcEnd ← 0;
    IF gd.printMap THEN {
      WriteCR[];  
      WriteString["File "L];  WriteString[gd.mapFileName];
      WriteString[" created by Packager from "L];  WriteString[gd.packName]; 
      WriteString[" on "L];  WriteTime[Time.Current[]];  WriteCR[]};
    CodePackProcs.EnumerateSegments[CreateNewSegment];
    FramePackModules.EnumerateFramePacks[CreateFramePack];
    IF gd.printMap THEN
      {Streams.Destroy[gd.mapStream];  gd.mapStream ← NIL};
    END;

  WriteBcdToFile: PUBLIC PROC =
    BEGIN
    limitSgi: BcdDefs.SGIndex;
    bcdPages, bcdPos, size: CARDINAL;
    desc: Strings.SubStringDescriptor;
    newHeader: LONG POINTER TO BcdDefs.BCD;
    FillToPageBoundary: PROCEDURE =
      BEGIN
      byte: CARDINAL ← Inline.LongDivMod[
             num: Streams.GetIndex[outStream], den: PackEnviron.BytesPerPage].remainder;
      IF byte # 0 THEN
        THROUGH (byte..PackEnviron.BytesPerPage] DO 
          Streams.PutByte[outStream, 0];
          ENDLOOP;
      END;
    -- open output stream as a byte stream
    IF gd.errors THEN RETURN;
    IF PackagerDefs.globalData.outputBcdFile = NIL THEN
      BEGIN
      nameCopy: STRING ← [40];
      Strings.AppendString[to: nameCopy, from: PackagerDefs.globalData.outputBcdName];
      PackagerDefs.globalData.outputBcdFile ← Segments.NewFile[nameCopy, Segments.Write];
      END;
    outStream ← Streams.CreateStream[
      PackagerDefs.globalData.outputBcdFile,
      Streams.Write];
    -- compute size of new bcd
    bcdPos ← SIZE[BcdDefs.BCD];
    newHeader ← LongStorage.Node[bcdPos];
    newHeader↑ ← SourceBcd.bcdHeader↑;

    desc ← [base: gd.packName, offset: 0, length: gd.packName.length];
    newHeader.source ← BcdUtilDefs.EnterName[@desc];
    newHeader.creator ← gd.packagerVersion;
    newHeader.sourceVersion ← gd.packVersion;
    newHeader.version ← [
      time:  Segments.GetFileTimes[
              PackagerDefs.globalData.outputBcdFile].create,
      net: gd.network,
      host: gd.host];
    newHeader.repackaged ← TRUE;
    
    size ← table.Bounds[BcdDefs.sstype].size;
    newHeader.ssOffset ← bcdPos; 
    newHeader.ssLimit ← LOOPHOLE[size]; 
    bcdPos ← bcdPos + size;

    newHeader.ctOffset ← bcdPos; 
    bcdPos ← bcdPos + LOOPHOLE[newHeader.ctLimit, CARDINAL];
 
    newHeader.mtOffset ← bcdPos; 
    bcdPos ← bcdPos + LOOPHOLE[newHeader.mtLimit, CARDINAL];
 
    newHeader.impOffset ← bcdPos;
    bcdPos ← bcdPos + LOOPHOLE[newHeader.impLimit, CARDINAL];
 
    newHeader.expOffset ← bcdPos;
    bcdPos ← bcdPos + LOOPHOLE[newHeader.expLimit, CARDINAL];
 
    newHeader.evOffset ← bcdPos;
    bcdPos ← bcdPos + LOOPHOLE[newHeader.evLimit, CARDINAL];
 
    size ← table.Bounds[BcdDefs.sgtype].size;
    newHeader.sgOffset ← bcdPos; 
    newHeader.sgLimit ← LOOPHOLE[size]; 
    bcdPos ← bcdPos + size;
 
    size ← table.Bounds[BcdDefs.fttype].size;
    newHeader.ftOffset ← bcdPos; 
    newHeader.ftLimit ← LOOPHOLE[size]; 
    bcdPos ← bcdPos + size;
 
    size ← table.Bounds[BcdDefs.sptype].size;
    newHeader.spOffset ← bcdPos; 
    newHeader.spLimit ← LOOPHOLE[size]; 
    bcdPos ← bcdPos + size;
 
    newHeader.ntOffset ← bcdPos;
    bcdPos ← bcdPos + LOOPHOLE[newHeader.ntLimit, CARDINAL];
 
    newHeader.typOffset ← bcdPos;
    bcdPos ← bcdPos + LOOPHOLE[newHeader.typLimit, CARDINAL];
 
    newHeader.tmOffset ← bcdPos;
    bcdPos ← bcdPos + LOOPHOLE[newHeader.tmLimit, CARDINAL];
 
    size ← table.Bounds[BcdDefs.fptype].size;
    newHeader.fpOffset ← bcdPos; 
    newHeader.fpLimit ← LOOPHOLE[size]; 
    bcdPos ← bcdPos + size;

    IF SourceBcd.bcdHeader.extended THEN
      BEGIN
      newHeader.lfOffset ← bcdPos;
      bcdPos ← bcdPos + LOOPHOLE[newHeader.lfLimit, CARDINAL];
      newHeader.rfOffset ← bcdPos;
      bcdPos ← bcdPos + LOOPHOLE[newHeader.rfLimit, CARDINAL];
      newHeader.tfOffset ← bcdPos;
      bcdPos ← bcdPos + LOOPHOLE[newHeader.tfLimit, CARDINAL];
      END;

    bcdPages ← LongStorage.PagesForWords[bcdPos];
    IF SourceBcd.bcdHeader.extended THEN
      BEGIN
      newHeader.rtPages.relPageBase ← bcdPages;
      bcdPages ← bcdPages + newHeader.rtPages.pages;
      END;
    newHeader.nPages ← bcdPages;
    limitSgi ← LOOPHOLE[table.Bounds[BcdDefs.sgtype].size];
    FOR sgi: BcdDefs.SGIndex ← firstCodeSgi, sgi+SIZE[BcdDefs.SGRecord]
      UNTIL sgi = limitSgi DO
      sgb[sgi].base ← sgb[sgi].base + bcdPages + 1;
      ENDLOOP;
    -- write bcd to stream
    [] ← Streams.PutBlock[
      outStream,
      newHeader, 
      SIZE[BcdDefs.BCD]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.sstype].base, 
      LOOPHOLE[newHeader.ssLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.cttype].base, 
      LOOPHOLE[newHeader.ctLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.mttype].base, 
      LOOPHOLE[newHeader.mtLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.imptype].base, 
      LOOPHOLE[newHeader.impLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.exptype].base, 
      LOOPHOLE[newHeader.expLimit]];
    [] ← Streams.PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.evOffset, 
      LOOPHOLE[newHeader.evLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.sgtype].base, 
      LOOPHOLE[newHeader.sgLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.fttype].base, 
      LOOPHOLE[newHeader.ftLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.sptype].base, 
      LOOPHOLE[newHeader.spLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.nttype].base, 
      LOOPHOLE[newHeader.ntLimit]];
    [] ← Streams.PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.typOffset, 
      LOOPHOLE[newHeader.typLimit]];
    [] ← Streams.PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.tmOffset, 
      LOOPHOLE[newHeader.tmLimit]];
    [] ← Streams.PutBlock[
      outStream,
      table.Bounds[BcdDefs.fptype].base, 
      LOOPHOLE[newHeader.fpLimit]];
    IF SourceBcd.bcdHeader.extended THEN
      BEGIN
      [] ← Streams.PutBlock[
        outStream,
        SourceBcd.bcdHeader + SourceBcd.bcdHeader.lfOffset, 
        LOOPHOLE[newHeader.lfLimit]];
      [] ← Streams.PutBlock[
        outStream,
        SourceBcd.bcdHeader + SourceBcd.bcdHeader.rfOffset, 
        LOOPHOLE[newHeader.rfLimit]];
      [] ← Streams.PutBlock[
        outStream,
        SourceBcd.bcdHeader + SourceBcd.bcdHeader.tfOffset, 
        LOOPHOLE[newHeader.tfLimit]];
      FillToPageBoundary[];
      [] ← Streams.PutBlock[
        outStream,
        SourceBcd.bcdHeader +
	  SourceBcd.bcdHeader.rtPages.relPageBase*PackEnviron.PageSize, 
        LOOPHOLE[SourceBcd.bcdHeader.rtPages.pages*PackEnviron.PageSize]];
      END
    ELSE FillToPageBoundary[];
    LongStorage.Free[newHeader];
    -- throw out allocator space and source bcd
    END;

  WriteCodeToBcdFile: PUBLIC PROC =
    BEGIN
    IF gd.errors THEN RETURN;
    -- close piece table
    IF gd.nErrors # 0 THEN Segments.LockFile[gd.outputBcdFile];
    PieceTable.Store[outStream];
    IF gd.nErrors # 0 THEN Segments.UnlockFile[gd.outputBcdFile];
    Finalize[];
    END;

-- procedures to create new name, file, and segment tables for output bcd

  -- update source bcd in place, creating new tables:
  --   name table (ssb), file table, and segment table
  -- after this update, the following is true:

  --   All "name" fields refer to new NameRecords
  --   In module table,
  --      "sseg" refers to new segment table
  --      "code.sgi" refers to old segment table
  --   In new segment table, "file" refers to new file table
  --   In old segment table, "file" refers to old file table

  RemapOldBcd: PUBLIC PROC =
    BEGIN
    NullIndex: Table.OrderedIndex = LOOPHOLE[0];
    BcdUtilDefs.Init[table];
    IF table.Words[
      table: BcdDefs.imptype, 
      size: LOOPHOLE[SourceBcd.bcdHeader.impLimit]] # NullIndex THEN 
      SIGNAL PackError [nonZeroBase];
    PackEnviron.Copy[
      from: SourceBcd.bcdBases.itb, 
      nwords: LOOPHOLE[SourceBcd.bcdHeader.impLimit],
      to: itb];
    IF table.Words[
      table: BcdDefs.exptype,  
      size: LOOPHOLE[SourceBcd.bcdHeader.expLimit]] # NullIndex THEN  
      SIGNAL PackError [nonZeroBase];
    PackEnviron.Copy[
      from: SourceBcd.bcdBases.etb, 
      nwords: LOOPHOLE[SourceBcd.bcdHeader.expLimit],
      to: etb];
    IF table.Words[
      table: BcdDefs.cttype,  
      size: LOOPHOLE[SourceBcd.bcdHeader.ctLimit]] # NullIndex THEN  
      SIGNAL PackError [nonZeroBase];
    PackEnviron.Copy[
      from: SourceBcd.bcdBases.ctb, 
      nwords: LOOPHOLE[SourceBcd.bcdHeader.ctLimit],
      to: ctb];
    IF table.Words[
      table: BcdDefs.mttype,  
      size: LOOPHOLE[SourceBcd.bcdHeader.mtLimit]] # NullIndex THEN  
      SIGNAL PackError [nonZeroBase];
    PackEnviron.Copy[
      from: SourceBcd.bcdBases.mtb, 
      nwords: LOOPHOLE[SourceBcd.bcdHeader.mtLimit],
      to: mtb];
    IF table.Words[
      table: BcdDefs.nttype,  
      size: LOOPHOLE[SourceBcd.bcdHeader.ntLimit]] # NullIndex THEN  
      SIGNAL PackError [nonZeroBase];
    PackEnviron.Copy[
      from: SourceBcd.bcdBases.ntb, 
      nwords: LOOPHOLE[SourceBcd.bcdHeader.ntLimit],
      to: ntb];
    [] ← BcdOps.ProcessImports[SourceBcd.bcdHeader, RemapImports];
    [] ← BcdOps.ProcessExports[SourceBcd.bcdHeader, RemapExports];
    [] ← BcdOps.ProcessConfigs[SourceBcd.bcdHeader, RemapConfigs];
    [] ← BcdOps.ProcessModules[SourceBcd.bcdHeader, RemapModules];
    [] ← BcdOps.ProcessNames[SourceBcd.bcdHeader, RemapInstances];
    END;

  RemapInstances: PROC [nth: BcdOps.NTHandle, nti: BcdDefs.NTIndex] 
      RETURNS [BOOLEAN] =
    BEGIN OPEN nte: ntb[nti];
    nte.name ← BcdUtilDefs.MapName[SourceBcd.bcdBases, nth.name];
    RETURN [FALSE];
    END;

  MapFile: PROC [fti: BcdDefs.FTIndex] RETURNS [BcdDefs.FTIndex] =
    BEGIN
    SELECT fti FROM
      BcdDefs.FTSelf =>
	BEGIN
	new: BcdDefs.FTIndex ← BcdUtilDefs.EnterFile[gd.sourceBcdName];
        BcdUtilDefs.SetFileVersion[new, gd.sourceBcdVersion];
	RETURN[new];
	END;
      BcdDefs.FTNull => RETURN[fti];
      ENDCASE => RETURN[BcdUtilDefs.MergeFile[SourceBcd.bcdBases, fti]];
    END;

  RemapImports: PROC [imph: BcdOps.IMPHandle, impi: BcdDefs.IMPIndex]
      RETURNS [BOOLEAN] =
    BEGIN OPEN impe: itb[impi];
    impe.name ← BcdUtilDefs.MapName[SourceBcd.bcdBases, imph.name];
    impe.file ← MapFile[imph.file];
    RETURN [FALSE]
    END;

  RemapExports: PROC [exph: BcdOps.EXPHandle, expi: BcdDefs.EXPIndex]
      RETURNS [BOOLEAN] =
    BEGIN OPEN expe: etb[expi];
    expe.name ← BcdUtilDefs.MapName[SourceBcd.bcdBases, exph.name];
    expe.file ← MapFile[exph.file];
    RETURN [FALSE]
    END;

  RemapConfigs: PROC [cth: BcdOps.CTHandle, cti: BcdDefs.CTIndex]
      RETURNS [BOOLEAN] =
    BEGIN OPEN cte: ctb[cti];
    cte.name ← BcdUtilDefs.MapName[SourceBcd.bcdBases, cth.name];
    -- Note:  we carry through FTSelf in order to make the config
    -- point to the packaged BCD, not the unpackaged one. (RL)
    IF cth.file ~= BcdDefs.FTSelf THEN cte.file ← MapFile[cth.file];
    RETURN [FALSE]
    END;

  RemapModules: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
      RETURNS [BOOLEAN] =
    BEGIN OPEN mte: mtb[mti];
    sgr: BcdDefs.SGRecord ← SourceBcd.bcdBases.sgb[mth.sseg];
    IF ~mth.packageable THEN
      Error.ErrorName[error, "has already been packaged!"L, mth.name];
    mte.name ← BcdUtilDefs.MapName[SourceBcd.bcdBases, mth.name];
    mte.file ← MapFile[mth.file];
    sgr.file ← MapFile[sgr.file];
    mte.sseg ← BcdUtilDefs.EnterSegment[sgr];
    mte.packageable ← FALSE;
    -- mtb[mti].code will be fixed up later
    RETURN [FALSE]
    END;

  PrintHeader: PROC =
    BEGIN
    -- should print bcd version in file
    WriteString["Words EVI  Offset     IPC  Module"L];
    THROUGH [("Module"L).length..modCols] DO WriteChar[Ascii.SP] ENDLOOP;
    WriteString["Procedure"L];
    WriteChar[Ascii.CR];
    WriteChar[Ascii.CR];
    END;

  -- ** Loadmap stuff

  modCols: CARDINAL ← 20;
  Decimal4: CharIO.NumberFormat =
    [base: 10, zerofill: FALSE, unsigned: TRUE, columns: 4];
  Decimal5: CharIO.NumberFormat =
    [base: 10, zerofill: FALSE, unsigned: TRUE, columns: 5];
  Decimal6: CharIO.NumberFormat =
    [base: 10, zerofill: FALSE, unsigned: TRUE, columns: 6];
  Octal5: CharIO.NumberFormat =
    [base: 8, zerofill: FALSE, unsigned: TRUE, columns: 5];
  Octal7: CharIO.NumberFormat =
    [base: 8, zerofill: FALSE, unsigned: TRUE, columns: 7];

  NoteData: PROC [offset, length: CARDINAL] =
    BEGIN
    WriteNumber[length, Decimal5];
    WriteString["   -"L];
    WriteNumber[offset, Octal7];
    WriteChar['B];
    WriteString["          <data>"L];
    WriteChar[Ascii.CR];
    END;

  DisplayNumbers: PROC [ep: INTEGER, length: CARDINAL, hti: Symbols.HTIndex] =
    BEGIN
    -- write out module, entry, segOffset, codeOffset
    -- called when codeBasePosition and segmentPosition are valid
    pos: PieceTable.Position ← PieceTable.Append[];
    offset, cols: CARDINAL;
    IF ep = 0 THEN pos ← pos + 2;
    IF lastProcEnd # 0 AND pos > lastProcEnd THEN
      NoteData[
	offset: SegmentOffset[lastProcEnd],
	length: Inline.LowHalf[(pos-lastProcEnd)/2]];
    lastProcEnd ← pos + length*2;
    WriteNumber[length, Decimal5];
    IF ep = -1 THEN WriteString["  EV"L]
    ELSE WriteNumber[ep, Decimal4];
    offset ← SegmentOffset[pos];
    WriteNumber[offset, Octal7];
    WriteChar['B];
    IF ep = -1 THEN
      WriteString["        "L]
    ELSE
      BEGIN
      offset ← CodeOffset[pos];
      WriteNumber[offset*2, Octal7];
      WriteChar['B];
      END;
    WriteString["  "L];
    cols ← WriteName[mtb[currentModule].name];
    IF ep # -1 THEN
      BEGIN
      THROUGH [cols..modCols) DO WriteChar[Ascii.SP] ENDLOOP;
      WriteChar[Ascii.SP];
      IF ep = 0 THEN WriteString["MAIN"L]
      ELSE IF hti = Symbols.HTNull THEN
        WriteString[" <nested>"L]
      ELSE [] ← WriteProcName[hti]
      END;
    WriteChar[Ascii.CR];
    END;

  WriteName: PROC [name: BcdDefs.NameRecord] RETURNS [length: CARDINAL] =
    BEGIN
    desc: Strings.SubStringDescriptor;
    desc ← [base: @ssb.string, offset: name, length: ssb.size[name]];
    WriteSubString[@desc];
    RETURN [desc.length];
    END;

  WriteProcName: PROC [hti: Symbols.HTIndex] RETURNS [length: CARDINAL] =
    BEGIN
    desc: Strings.SubStringDescriptor;
    IF hti = Symbols.HTNull THEN RETURN[0];
    SymbolOps.SubStringForHash[@desc, hti];
    WriteSubString[@desc];
    RETURN [desc.length];
    END;

  END.