-- file PackCodeImplA.mesa
--  last edited by Lewis	 6-Dec-82 14:09:07
--  last edited by Satterthwaite, December 29, 1982 12:06 pm

DIRECTORY
  Alloc USING [AddNotify, Bounds, DropNotify, Handle, Notifier, Top, Words],
  BcdDefs,
  BcdOps USING [MTHandle, NameString],
  BcdUtilDefs: TYPE USING [EnterName],
  CatchFormat USING [EnableHandle, EnableItem, EnableTableBody],
  CharIO,
  CIFS: TYPE USING [OpenFile, GetFC],
  CodePackProcs USING [
    EnumerateCodePacks, EnumerateModules, EnumerateProcs, EnumerateSegments, 
    HtiForCodePackNode, IsDiscardCodePack, ModuleIndex, SubStringForCodePackNode,
    SubStringForSegmentNode, TreeIndex],
  Environment USING [Byte, bytesPerPage, bytesPerWord, wordsPerPage],
  Error USING [EmptyCodePack, ErrorFile, SegmentTooLarge],
  FileStream: TYPE USING [Create, GetIndex, GetLeaderProperties],
  FileTable USING [HandleForFile, UnknownFile],
  FramePackModules USING [
    EnumerateFramePacks, EnumerateModules, SubStringForFramePackNode],
  HashOps USING [HTIndex],
  Inline USING [LongCOPY, LongDiv, LongDivMod, LongMult, LowHalf],
  ModuleSymbols,
  Mopcodes USING [zJIB],
  PackagerDefs USING [packtreetype, globalData, GlobalData],
  PackageSymbols,
  PackCode,
  PieceTable USING [
    Append, AppendPage, AppendQuadWord, AppendWord, CopyFromFile, Delete,
    Finalize, GetByte, GetPlace, GetVPos, GetWord, Initialize, Length,
    Move, NullPiece, PieceIndex, Place, Position, PutWord, PutZeros, SetVPos, Store],
  PrincOps USING [BytePC, CSegPrefix, EntryVectorItem, PrefixHeader],
  SourceBcd USING [
    bcdBases, bcdHeader, BcdTableLoc, CTreeIndex, Index, LookupSS, moduleCount,
    ModuleNum, ModuleNumForMti, nullCTreeIndex, Prev],
  Stream USING [Delete, Handle, PutByte, PutBlock],
  String,
  SymbolOps,
  Symbols,
  Table USING [Base, Limit],
  Time USING [Append, Current, Packed, Unpack],
  Tree: FROM "PackTree" USING [Index];

PackCodeImplA: PROGRAM 
  IMPORTS 
    Alloc, BcdUtilDefs, CharIO, CIFS, CodePackProcs, Error, FileStream, FileTable,
    FramePackModules, Inline, ModuleSymbols, PackagerDefs, PackCode,
    PieceTable, SourceBcd, Stream, String, SymbolOps, Time 
  EXPORTS PackCode =
  BEGIN OPEN PackCode;
  
 -- private data structures
 
  WordIndexSeqBody: TYPE = RECORD [SEQUENCE COMPUTED NAT OF WordIndex];
  WordIndexSeq: TYPE = LONG POINTER TO WordIndexSeqBody;
  
  SeenModuleSeqBody: TYPE = RECORD[
    SEQUENCE COMPUTED [0..1024) OF SeenModuleHandle];
  SeenModuleSeq: TYPE = LONG POINTER TO SeenModuleSeqBody;

  Address: TYPE = [0..77777b];  -- max of 32K
  WordIndex: TYPE = PackageSymbols.WordIndex;
  NullWordIndex: WordIndex = WordIndex.LAST;
  
  BodyDataRec: TYPE = RECORD [
    oldPC: PrincOps.BytePC, bytes: CARDINAL, 
    newPC: PrincOps.BytePC _ [0], pending: FixupHandle _ NIL];
  
  FixupRec: TYPE = RECORD [
    next: FixupHandle,
    loc: LONG CARDINAL,
    target: PrincOps.BytePC];
  FixupHandle: TYPE = LONG POINTER TO FixupRec;

  SeenModuleRecord: TYPE = RECORD [
    newOffset: Address, -- of entry vector within segment
    newPiece: PieceTable.PieceIndex, -- of beginning of vector
    oldCodeFile: CIFS.OpenFile,
    oldCodePosition: LONG CARDINAL,
    newConstants: WordIndexSeq _ NIL, -- of new constant values
    enablePlace: PieceTable.Place _ [PieceTable.NullPiece, 0, 0],
    discarded: BOOL _ FALSE,
    thisSeg: BOOL _ TRUE,
    body: SEQUENCE nBodies: [0..128] OF BodyDataRec _ NULL];
  SeenModuleHandle: TYPE = LONG POINTER TO SeenModuleRecord;

 -- state variables
 
  gd: PackagerDefs.GlobalData;
  z: UNCOUNTED ZONE _ NIL;

  table: Alloc.Handle _ NIL;
  tb, spb, sgb, fpb: Table.Base;
  itb, etb, ctb, mtb, ntb, lfb: Table.Base;
  ssb: BcdOps.NameString;

  NotifyA: Alloc.Notifier =
    BEGIN
    tb     _ base[PackagerDefs.packtreetype];
    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];
    lfb    _ base[BcdDefs.lftype];
    NotifyB[base];
    END;

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

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

  cstb: LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.ConstRecord;

  seenModules: SeenModuleSeq _ NIL;
  cur: SeenModuleHandle;
  newConstants: WordIndexSeq _ NIL;

  oldCodeFile: PUBLIC CIFS.OpenFile;
  oldCodeBasePosition: LONG CARDINAL;

  currentModule: BcdDefs.MTIndex;
  currentCodePackHti: HashOps.HTIndex;
  firstCodeSgi: BcdDefs.SGIndex;
  currentCodeSegment: BcdDefs.SGIndex;
  currentSpaceIndex: BcdDefs.SPIndex;
  segmentPosition: PieceTable.Position;
  codePackPosition: PieceTable.Position;
  codeBasePosition: PieceTable.Position;
  codeBaseOffset: Address; -- from start of code segment
  procOffset, oldProcOffset: CARDINAL; -- from codeBase
  procPosition: PieceTable.Position;
  lastProcEnd: PieceTable.Position;
  firstCodePack, currentCodePackResident: BOOL;
  

  outStream: Stream.Handle;

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

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

  WriteSubString: PROC [ss: String.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]};

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

  WriteNumber: PROC [n: CARDINAL, fmt: CharIO.NumberFormat] = 
    {IF gd.mapStream # NIL THEN CharIO.PutNumber[gd.mapStream, n, fmt]};
    
  WriteTime: PROC [t: Time.Packed] =
    BEGIN
    s: STRING _ [20];
    Time.Append[s, Time.Unpack[t]];
    WriteString[s];
    END;

  PagesForWords: PROC [nWords: CARDINAL] RETURNS [CARDINAL] = {
    RETURN [(nWords + (Environment.wordsPerPage-1))/Environment.wordsPerPage]};
    
    
  Initialize: PROC [nModules: CARDINAL] =
    BEGIN
    gd _ PackagerDefs.globalData;
    table _ gd.ownTable;
    z _ gd.zone;
    table.AddNotify[NotifyA];
    PackCode.InitBcdTab[];
    seenModules _ z.NEW[SeenModuleSeqBody[nModules]];
    FOR i: CARDINAL IN [0..nModules) DO seenModules[i] _ NIL ENDLOOP;
    nMods _ nModules;
    END;
    
  nMods: CARDINAL;
  
  FixupCodeByteOffset: PROC =
    BEGIN
    loc: LONG CARDINAL = PieceTable.GetVPos[];
    target: PrincOps.BytePC = PieceTable.GetWord[];
    FOR ep: CARDINAL IN [0..cur.nBodies) DO
      old, new: PrincOps.BytePC;
      bytes: CARDINAL;
      [oldPC: old, newPC: new, bytes: bytes] _ cur[ep];
      IF target IN [old..old+bytes) THEN
        BEGIN
	IF new = 0 THEN {
	  f: FixupHandle = z.NEW[FixupRec _ [
	    next: cur[ep].pending, loc: loc, target: target]];
	  cur[ep].pending _ f;
	  RETURN};
	PieceTable.Delete[-2];
	PieceTable.PutWord[target - old + new];
	RETURN;
	END;
      ENDLOOP;
    ERROR PackError[StrangeLIO];
    END;
    
  NoteNewPC: PROC [ep: CARDINAL, new: PrincOps.BytePC] =
    BEGIN
    IF cur[ep].pending # NIL THEN 
      BEGIN
      vicinity: PieceTable.Place _ PieceTable.GetPlace[];
      savePos: LONG CARDINAL = PieceTable.GetVPos[];
      old: PrincOps.BytePC;
      f: FixupHandle;
      [oldPC: old, pending: f] _ cur[ep];
      WHILE f # NIL DO
        fn: FixupHandle = f.next;
	PieceTable.SetVPos[f.loc];
	PieceTable.Delete[2];
	PieceTable.PutWord[f.target - old + new];
	z.FREE[@f];
	f _ fn;
	ENDLOOP;
      PieceTable.SetVPos[savePos, @vicinity];
      cur[ep].pending _ NIL;
      END;
    cur[ep].newPC _ new;
    END;

  FixupCodeOffset: PROC =
    BEGIN
    old: CARDINAL = PieceTable.GetWord[];
    new: CARDINAL = NewOffset[old];
    PieceTable.Delete[-2];
    PieceTable.PutWord[new];
    END;
    
  Finalize: PUBLIC PROC =
    BEGIN
    IF table # NIL THEN table.DropNotify[NotifyA];
    IF seenModules = NIL THEN RETURN;
    FOR i: CARDINAL IN [0..nMods) DO 
      cur _ seenModules[i];
      IF cur = NIL THEN LOOP;
      IF cur.newConstants # NIL THEN z.FREE[@cur.newConstants];
      IF cur.oldCodeFile # NIL THEN cur.oldCodeFile _ NIL;
      FOR ep: CARDINAL IN [0..cur.nBodies) DO
        IF cur[ep].pending # NIL THEN
	  BEGIN
	  f: FixupHandle _ cur[ep].pending;
	  IF ~cur.discarded THEN SIGNAL PackError[StrangeLIO];
	  WHILE f # NIL DO
	    fn: FixupHandle _ f.next;
	    z.FREE[@f];  f _ fn;
	    ENDLOOP;
	  END;
	ENDLOOP;
      z.FREE[@cur];
      ENDLOOP;
    PackCode.FinalizeBcdTab[];
    IF seenModules # NIL THEN z.FREE[@seenModules];
    table _ NIL;
    END;

  FixLoads: PROC [
    lc: PackageSymbols.PCSeq, start: PrincOps.BytePC, bytes: CARDINAL, 
    FixProc: PROC] =
    BEGIN
    l, u, i: INTEGER;
    stop: PrincOps.BytePC = [start + bytes];
    pci: PrincOps.BytePC;
    l _ 0; u _ lc.length;
    IF u = 0 THEN RETURN;
    UNTIL l > u DO
      i _ (l+u)/2;
      SELECT lc[i] FROM
        < start => l _ i+1;
        > start => u _ i-1;
        ENDCASE => EXIT;
      REPEAT
	FINISHED => i _ l;
      ENDLOOP;
    -- lc[i] >= start;
    WHILE CARDINAL[i] < lc.length AND (pci _ lc[i]) < stop DO
      IF pci >= start THEN {
        PieceTable.SetVPos[procPosition + pci - oldProcOffset + 1];
	FixProc[]};
      i _ i + 1;
      ENDLOOP;
    END;

  FixJumpImmediates: PROC [
    jc: PackageSymbols.JISeq, start: PrincOps.BytePC, bytes: CARDINAL] =
    BEGIN
    l, u, i: INTEGER;
    op: Environment.Byte;
    stop: PrincOps.BytePC = [start + bytes];
    pci: PrincOps.BytePC;
    l _ 0; u _ jc.length;
    IF u = 0 THEN RETURN;
    UNTIL l > u DO
      i _ (l+u)/2;
      SELECT jc[i].pc FROM
        < start => l _ i+1;
        > start => u _ i-1;
        ENDCASE => EXIT;
      REPEAT
	FINISHED => i _ l;
      ENDLOOP;
    -- jc[i].pc >= start;
    IF i < 0 THEN ERROR PackError[InvalidCodeOffset];
    WHILE CARDINAL[i] < jc.length AND (pci _ jc[i].pc) < stop DO
      IF pci >= start THEN {
        size: CARDINAL _ jc[i].tableSize;
	savePos: PieceTable.Position;
	newTableOffset, oldTableOffset: WordIndex;
        PieceTable.SetVPos[procPosition + pci - oldProcOffset];
	op _ PieceTable.GetByte[];
	oldTableOffset _ PieceTable.GetWord[];
	savePos _ PieceTable.GetVPos[];
	IF op = Mopcodes.zJIB THEN size _ (size+1)/2;
	newTableOffset _ CodeOffset[PieceTable.AppendWord[]];
	PieceTable.CopyFromFile[
	    file: oldCodeFile,
	    position: oldCodeBasePosition+oldTableOffset*2,
	    length: size*2];
	PieceTable.SetVPos[savePos];
	PieceTable.Delete[-2];
	PieceTable.PutWord[newTableOffset]};
      i _ i + 1;
      ENDLOOP;
    END;

  NewOffset: PROC [old: WordIndex] RETURNS [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 ERROR PackError[InvalidCodeOffset];
    delta _ old - cstb[i].offset;
    IF delta > cstb[i].length THEN ERROR PackError[InvalidCodeOffset];
    IF newConstants[i] = 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;

  firstBody: BOOL;
  
  CopyModuleBodies: PROC [root: PackageSymbols.OPIndex] RETURNS [stop: BOOL] =
    BEGIN OPEN PackageSymbols;
    SELECT root FROM
      OPEntry => CopyEV[currentModule];
      OPCatch => {
        length: CARDINAL = cur[cur.nBodies-1].bytes;
	IF length # 0 
	 AND cur[cur.nBodies-1].oldPC # 0
	 THEN {
          IF gd.printMap THEN DisplayNumbers[
	    ep: epCatch, length: length, hti: Symbols.HTNull];
          IF firstBody THEN SetupCurrentOffsets[];
	  CopyOneBody[ep: cur.nBodies-1, length: length, 
	    catch: TRUE, needsFixup: TRUE];
	  CopyNestedBodies[LENGTH[ModuleSymbols.outerPackArray]-1]}};
      ENDCASE => {
        IF firstBody THEN SetupCurrentOffsets[];
	CopyBodies[root]};
    RETURN[FALSE];
    END;
    
  SetupCurrentOffsets: PROC =
    BEGIN
    IF cur = NIL THEN ERROR PackError[EVNotPlaced];
    [newOffset: codeBaseOffset,
      newPiece: evPlace.pi,
      oldCodeFile: oldCodeFile,
      oldCodePosition: oldCodeBasePosition,
      newConstants: newConstants] _ cur^;
    codeBasePosition _ segmentPosition + 2*codeBaseOffset;
    evPlace.pos _ codeBasePosition;
    evPlace.filePos _ evPlace.pi.position; -- first two words don't get deleted
    firstBody _ FALSE;
    END;

  CopyBodies: PROC [root: PackageSymbols.OPIndex] =
    BEGIN -- copy procedure (and any nested below unless main body)
    IF gd.printMap THEN DisplayNumbers[
      ep: ModuleSymbols.outerPackArray[root].entryIndex,
      length: ModuleSymbols.outerPackArray[root].length,
      hti: ModuleSymbols.outerPackArray[root].hti];
    CopyOneBody[
      ep: ModuleSymbols.outerPackArray[root].entryIndex,
      length: ModuleSymbols.outerPackArray[root].length,
      catch: FALSE, 
      needsFixup: ModuleSymbols.outerPackArray[root].needsFixup];
    CopyNestedBodies[root];
    END;
    
  CopyNestedBodies: PROC [root: PackageSymbols.OPIndex] =
    BEGIN
    i: PackageSymbols.IPIndex _ 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, 
	hti: Symbols.HTNull];
      CopyOneBody[
	  ep: ModuleSymbols.innerPackArray[i].entryIndex, 
	  length: ModuleSymbols.innerPackArray[i].length,
	  catch: FALSE,
	  needsFixup: ModuleSymbols.innerPackArray[i].needsFixup];
      IF ModuleSymbols.innerPackArray[i].lastSon THEN EXIT;
      i _ i+1;
      ENDLOOP;
    END;

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

  CodeByteOffset: PROC [pos: PieceTable.Position] RETURNS [CARDINAL] =
    BEGIN
    new: LONG CARDINAL = pos - codeBasePosition;
    IF new > LAST[CARDINAL] THEN SIGNAL PackError[SegmentTooBig];
    RETURN [Inline.LowHalf[new]];
    END;

  CodeOffset: PROC [pos: PieceTable.Position] RETURNS [WordIndex] = INLINE
    BEGIN
    RETURN [CodeByteOffset[pos]/2];
    END;
    
  ProcessEnables: PROC [mod: SeenModuleHandle] =
    BEGIN
    ep: PieceTable.Place;
      cLength: CARDINAL;
      alsoNested: BOOL _ TRUE;
      et: CatchFormat.EnableHandle;
      buffer: RECORD [SELECT OVERLAID * FROM
        ei => [item: CatchFormat.EnableItem],
	aa => [a: ARRAY [0..SIZE[CatchFormat.EnableItem]) OF CARDINAL],
	ENDCASE];
	
    cur _ mod;
    cur.thisSeg _ FALSE;
    ep _ cur.enablePlace;
    IF ep.pi = PieceTable.NullPiece THEN RETURN;
    SetupCurrentOffsets[];
    PieceTable.SetVPos[ep.pos, @ep];
	
      WHILE alsoNested DO
        cLength _ PieceTable.GetWord[];
	alsoNested _ FALSE;
	THROUGH [0..cLength) DO -- assumes SIZE[EnableItem] = 3
	  temp: CARDINAL;
	  FixupCodeByteOffset[];
	  [] _ PieceTable.GetWord[];
	  temp _ PieceTable.GetWord[];
	  alsoNested _ alsoNested OR (temp MOD 2 # 0);
	  ENDLOOP;
	-- ****** Now sort the damned things *****
	IF cLength = 0 THEN EXIT;
	PieceTable.Move[-cLength*SIZE[CatchFormat.EnableItem]*2];
	et _ z.NEW[CatchFormat.EnableTableBody[cLength]];
	FOR i: CARDINAL IN [0..cLength) DO 
	  FOR j: CARDINAL IN [0..SIZE[CatchFormat.EnableItem]) DO
	    buffer.a[j] _ PieceTable.GetWord[];
	    ENDLOOP;
	  et[i] _ buffer.item;
	  ENDLOOP;
	SortEnables[et];
	PieceTable.Delete[-cLength*SIZE[CatchFormat.EnableItem]*2];
	FOR i: CARDINAL IN [0..cLength) DO 
	  buffer.item _ et[i];
	  FOR j: CARDINAL IN [0..SIZE[CatchFormat.EnableItem]) DO
	    PieceTable.PutWord[buffer.a[j]];
	    ENDLOOP;
	  ENDLOOP;
	z.FREE[@et];
	ENDLOOP;
    END;
    
  SortEnables: PROC [et: CatchFormat.EnableHandle] =
    BEGIN
    n: CARDINAL = et.count;
    i: CARDINAL;
    temp: CatchFormat.EnableItem;
    SiftUp: PROC [l, u: CARDINAL] =
      BEGIN
      s: CARDINAL;
      key: CatchFormat.EnableItem _ et[l-1];
      DO
        s _ l*2;
        IF s > u THEN EXIT;
        IF s < u AND et[s+1-1].start > et[s-1].start THEN s _ s+1;
        IF key.start > et[s-1].start THEN EXIT;
        et[l-1] _ et[s-1];
        l _ s;
        ENDLOOP;
      et[l-1] _ key;
      END;
    FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
    FOR i DECREASING IN [2..n] DO
      SiftUp[1, i];
      temp _ et[1-1];
      et[1-1] _ et[i-1];
      et[i-1] _ temp;
      ENDLOOP;
    END;

  CopyOneBody: PROC [ep: EntryIndex, length: CARDINAL, catch, needsFixup: BOOL] =
    BEGIN
    eviOffset: POINTER;
    codeLength: CARDINAL _ length;
    vicinity: PieceTable.Place;
    
    -- copy code into output file
    procPosition _ IF catch THEN PieceTable.AppendWord[] ELSE PieceTable.Append[];
    procOffset _ CodeByteOffset[procPosition];
    vicinity _ PieceTable.GetPlace[];
    -- fix up entry vector for module
    eviOffset _  @(LOOPHOLE[1, POINTER TO PrincOps.CSegPrefix].entry[ep]) - 1;   
    PieceTable.SetVPos[
      codeBasePosition + 2*LOOPHOLE[eviOffset, CARDINAL], @evPlace]; 
    oldProcOffset _ PieceTable.GetWord[];
    PieceTable.Delete[-2];
    IF catch AND length = 0 THEN procOffset _ 0;
    PieceTable.PutWord[procOffset];
    PieceTable.SetVPos[procPosition, @vicinity];
    IF catch AND length = 0 THEN RETURN;
    PieceTable.CopyFromFile[
      file: oldCodeFile,
      position: oldProcOffset + oldCodeBasePosition,
      length: length];
    NoteNewPC[ep: ep, new: [procOffset]];
      
    IF catch THEN
      BEGIN
      cLength: CARDINAL;
      delta: CARDINAL = procOffset - oldProcOffset;
	
      -- update entry vector, etc.
      PieceTable.SetVPos[procPosition, @vicinity];
      -- we are at the catch entry vector
      cLength _ PieceTable.GetWord[];
      THROUGH [0..cLength) DO
        cOffset: CARDINAL = PieceTable.GetWord[];
	PieceTable.Delete[-2];
	PieceTable.PutWord[cOffset + delta]; 
	ENDLOOP;
      -- wait to do enables until we are sure of no pending fixups
      cLength _ PieceTable.GetWord[];
      IF cLength # 0 THEN cur.enablePlace _ PieceTable.GetPlace[];
      END;
   
    -- now get ready to look for multiword constants
    
    IF needsFixup THEN {
      FixLoads[
        lc: ModuleSymbols.loadCodeOffsetTable,
        start: [oldProcOffset],
        bytes: length,
        FixProc: FixupCodeOffset];
      FixLoads[
        lc: ModuleSymbols.loadCodeByteOffsetTable,
        start: [oldProcOffset],
        bytes: length,
        FixProc: FixupCodeByteOffset];
      FixJumpImmediates[
        jc: ModuleSymbols.jumpIndirectTable,
        start: [oldProcOffset],
        bytes: length]};
    
    END;

  CreateNewSegment: PROC [segNode: CodePackProcs.TreeIndex] RETURNS [BOOL] =
    BEGIN
    endPosition: PieceTable.Position;
    base, pages: CARDINAL;
    desc: String.SubStringDescriptor;
    CodePackProcs.SubStringForSegmentNode[@desc, segNode];
    IF gd.printMap THEN
      BEGIN
      WriteString["\nSegment: "L];  WriteSubString[@desc];
      WriteChar['\n];
      WriteChar['\n];
      END;
    currentCodeSegment _ table.Words[BcdDefs.sgtype, SIZE[BcdDefs.SGRecord]];
    currentSpaceIndex _ table.Words[BcdDefs.sptype, SIZE[BcdDefs.SPRecord]];
    spb[currentSpaceIndex] _ [
      name: BcdUtilDefs.EnterName[@desc], 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, Environment.bytesPerPage];
    pages _ PagesForWords[(CARDINAL[endPosition - segmentPosition]+1)/2];
    sgb[currentCodeSegment] _ [
      class: code,
      file: BcdDefs.FTSelf,
      base: base,
      pages: pages,
      extraPages: 0];
    FOR i: CARDINAL IN [0..nMods) DO
      mod: SeenModuleHandle = seenModules[i];
      IF mod # NIL AND mod.thisSeg THEN ProcessEnables[mod];
      ENDLOOP;
    RETURN[FALSE];
    END;

  CreateFramePack: PROC [fpNode: CodePackProcs.TreeIndex] RETURNS [BOOL] =
    BEGIN
    fpi: BcdDefs.FPIndex = table.Words[BcdDefs.fptype, SIZE[BcdDefs.FPRecord]];
    desc: String.SubStringDescriptor;
    name: BcdDefs.NameRecord;
    totalWordsWCodeLinks, totalWordsWFrameLinks, inLastPage: CARDINAL _ 0;

    AddModToPack: PROC [mti: BcdDefs.MTIndex] RETURNS [BOOL] = {
      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 {
	mth: BcdOps.MTHandle = @mtb[mti];
	linkArea: CARDINAL =
	  (IF mth.links # BcdDefs.LFNull  
	     THEN lfb[mth.links].length*SIZE[BcdDefs.Link]
	     ELSE 0);
	-- print frame size and offset assuming codelinks
	IF (mth.linkLoc = code AND mth.code.linkspace) THEN 
	  offset _ ((totalWordsWCodeLinks+3)/4)*4
	ELSE  -- links before frame	 
	  offset _ ((totalWordsWCodeLinks + linkArea+3)/4)*4;  
	WriteNumber[mth.framesize, Decimal6];
	WriteNumber[offset, Octal7];  WriteChar['B];
	totalWordsWCodeLinks _ offset + mth.framesize;
	-- now, assuming framelinks only
	offset _ ((totalWordsWFrameLinks + linkArea+3)/4)*4;
	WriteNumber[mth.framesize, Decimal6];
	WriteNumber[offset, Octal7];  WriteChar['B];
	totalWordsWFrameLinks _ (offset + mth.framesize);
	WriteString["    "L];
	[] _ WriteName[mth.name];
	WriteChar['\n]};
      RETURN[FALSE]};

    FramePackModules.SubStringForFramePackNode[@desc, fpNode];
    fpb[fpi].name _ name _ BcdUtilDefs.EnterName[@desc];
    IF gd.printMap THEN {
      WriteString["\nFrame Pack: "L];
      [] _ WriteName[name];
      WriteString["\nLoad description\n"L];
      WriteString["w/ codelinks       framelinks only\n"L];
      WriteString["Length  offset     length  offset   Module\n"L]};
    fpb[fpi].length _ 0;
    FramePackModules.EnumerateModules[fpNode, AddModToPack];
    IF gd.printMap THEN {
      inLastPage _ totalWordsWCodeLinks MOD Environment.wordsPerPage;
      WriteNumber[Environment.wordsPerPage - inLastPage, Decimal6];
      WriteString["        "L];
      inLastPage _ totalWordsWFrameLinks MOD Environment.wordsPerPage;
      WriteNumber[Environment.wordsPerPage - inLastPage, Decimal6];
      WriteString["            unused\n"L];
      WriteNumber[PagesForWords[totalWordsWCodeLinks], Decimal6];
      WriteString["        "L];
      WriteNumber[PagesForWords[totalWordsWFrameLinks], Decimal6];
      WriteString["            frame pack pages\n\n"L]};
    RETURN[FALSE];
    END;

  StartModule: PROC [mti: BcdDefs.MTIndex] =
    BEGIN
    mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
    currentModule _ mti;
    cur _ seenModules[mNum];
    cstb _ ModuleSymbols.constArray;
    firstBody _ TRUE;
    END;
    

  CopyEV: PROC [mti: BcdDefs.MTIndex] =
    BEGIN
    mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
      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, Environment.wordsPerPage] + LONG[cd.offset]);
      IF mth.linkLoc = code THEN
	BEGIN
	pos: LONG CARDINAL _ PieceTable.AppendWord[];
	lfi: BcdDefs.LFIndex = mth.links;
        fLength: CARDINAL = lfb[lfi].length;
	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: epEv, length: evWords*2, hti: Symbols.HTNull];
      PieceTable.CopyFromFile[
	file: oldCodeFile, 
	position: oldCodeBasePosition,
        length: evWords*2];
      evPlace _ PieceTable.GetPlace[];
      -- update seenModules array entry
      IF LENGTH[cstb] = 0 THEN newConstants _ NIL
      ELSE
        BEGIN
	SetBlock: PROC [p: LONG POINTER, v: UNSPECIFIED, n: CARDINAL] = INLINE {
	    p^ _ v;  Inline.LongCOPY[from: p, to: (p+1), nwords: (n-1)]};
        newConstants _ z.NEW[WordIndexSeqBody[LENGTH[cstb]]];
        SetBlock[
          p: newConstants,
          v: NullWordIndex,
          n: LENGTH[cstb] * SIZE[WordIndex]];
        END;
      cur _ z.NEW[SeenModuleRecord[nEntries] _ [
	newOffset: codeBaseOffset,
	newPiece: evPlace.pi,
	oldCodeFile: oldCodeFile,
	oldCodePosition: oldCodeBasePosition,
	newConstants: newConstants]];
      PieceTable.SetVPos[codeBasePosition + SIZE[PrincOps.PrefixHeader]*2];
      FOR ep: NAT IN [0..nEntries) DO
        cur[ep] _ [oldPC: PieceTable.GetWord[], bytes: ];
	ENDLOOP;
      FOR i: NAT IN [0..LENGTH[ModuleSymbols.outerPackArray]) DO
        ep: EntryIndex;
	bytes: CARDINAL;
	[entryIndex: ep, length: bytes] _ ModuleSymbols.outerPackArray[i];
	cur[ep].bytes _ bytes;
	ENDLOOP;
      FOR i: NAT IN [0..LENGTH[ModuleSymbols.innerPackArray]) DO
        ep: EntryIndex;
	bytes: CARDINAL;
	[entryIndex: ep, length: bytes] _ ModuleSymbols.innerPackArray[i];
	cur[ep].bytes _ bytes;
	ENDLOOP;
      seenModules[mNum] _ cur;
      -- update module table in bcd
      cd.offset _ codeBaseOffset;
      cd.sgi _ currentCodeSegment;
      cd.length  _ 0;
      BEGIN -- look for all prototypes of this name
      desc: String.SubStringDescriptor _ [
	base: @ssb.string,
	offset: name,
	length: ssb.size[name]];
      cTreeNode: SourceBcd.CTreeIndex _ SourceBcd.LookupSS[@desc, prototype];
      WHILE cTreeNode # SourceBcd.nullCTreeIndex DO
        index: SourceBcd.BcdTableLoc = cTreeNode.Index;
        WITH ctr: index SELECT FROM
	  module =>
	    BEGIN
	    pmth: BcdOps.MTHandle = @mtb[ctr.mti];
	    IF pmth.file = file THEN pmth.code _ cd;
	    END;
          ENDCASE;
	cTreeNode _ cTreeNode.Prev[$prototype];
	ENDLOOP;
      END;
    END;

  evPlace: PieceTable.Place;

  CopyFakeModule: PROC [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, Environment.wordsPerPage] + LONG[cd.offset]);
    codeBasePosition _ PieceTable.AppendQuadWord[];
    codeBaseOffset _ SegmentOffset[codeBasePosition];
    IF gd.printMap THEN 
      DisplayNumbers[ep: epEv, length: cd.length, hti: Symbols.HTNull];
    PieceTable.CopyFromFile[
      file: oldCodeFile, 
      position: oldCodeBasePosition,
      length: cd.length];
    IF (codeBaseOffset + cd.length) > LAST[CARDINAL] THEN PackError[SegmentTooBig];
    -- update module table in bcd
    cd.offset _ codeBaseOffset;
    cd.sgi _ currentCodeSegment;
    cd.length  _ 0;
    BEGIN -- look for all prototypes of this name
    desc: String.SubStringDescriptor _ [
      base: @ssb.string,
      offset: name,
      length: ssb.size[name]];
    cTreeNode: SourceBcd.CTreeIndex _ SourceBcd.LookupSS[@desc, prototype];
    WHILE cTreeNode # SourceBcd.nullCTreeIndex DO
      index: SourceBcd.BcdTableLoc = cTreeNode.Index;
      WITH ctr: index SELECT FROM
        module =>
          BEGIN
          pmth: BcdOps.MTHandle = @mtb[ctr.mti];
          IF pmth.file = file THEN pmth.code _ cd;
          END;
        ENDCASE;
      cTreeNode _ cTreeNode.Prev[$prototype];
      ENDLOOP;
    END;
    END;

  DiscardAllInPack: PROC [cpNode: CodePackProcs.TreeIndex] =
    BEGIN
    CodePackProcs.EnumerateModules[cpNode, DiscardThisModule];
    END;

  DiscardThisModule: PROC [mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
      RETURNS [BOOL] =
    BEGIN
    StartModule[mti];
    SetupCurrentOffsets[]; -- you can't discard the EV, it should be already out
    CodePackProcs.EnumerateProcs[module, DiscardModuleProc];
    newConstants _ NIL;
    RETURN[FALSE]
    END;

  DiscardModuleProc: PROC [root: PackageSymbols.OPIndex] RETURNS [stop: BOOL] =
    BEGIN 
    SELECT root FROM
      PackageSymbols.OPEntry => ERROR PackError[EVNotPlaced];
      PackageSymbols.OPCatch => 
        DiscardThisProc[LENGTH[ModuleSymbols.outerPackArray]-1];
      ENDCASE => DiscardThisProc[root];
    RETURN[FALSE];
    END;
    
  DiscardThisProc: PROC [root: PackageSymbols.OPIndex] =
    BEGIN -- copy procedure (and any nested below unless main body)
    DiscardOneBody[ModuleSymbols.outerPackArray[root].entryIndex];
    DiscardNested[root];
    END;
    
  DiscardNested: PROC [root: PackageSymbols.OPIndex] =
    BEGIN
    i: PackageSymbols.IPIndex _  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;
    END;

  DiscardOneBody: PROC [ep: EntryIndex] =
    BEGIN
    eviOffset: POINTER;
    -- fix up entry vector for module (works for catch stuff, too)
    eviOffset _ @(LOOPHOLE[1, POINTER TO PrincOps.CSegPrefix].entry[ep]) - 1;   
    PieceTable.SetVPos[codeBasePosition + 2*LOOPHOLE[eviOffset, CARDINAL]]; 
    PieceTable.Delete[2];
    PieceTable.PutWord[0];
    cur.discarded _ TRUE; -- something is discarded from this module
    END;

  CreateCodePack: PROC [cpNode: CodePackProcs.TreeIndex] RETURNS [BOOL] =
    BEGIN
    saveIndex: CARDINAL = gd.textIndex;
    offset, pages: CARDINAL;
    spii: Table.Base RELATIVE POINTER [0..Table.Limit) TO BcdDefs.SpaceID;
    name: BcdDefs.NameRecord;
    nameCopy: STRING _ [80];
    desc: String.SubStringDescriptor;
    endPosition: PieceTable.Position;
    discard: BOOL = CodePackProcs.IsDiscardCodePack[cpNode];

    gd.textIndex _ tb[LOOPHOLE[cpNode, Tree.Index]].info;
    CodePackProcs.SubStringForCodePackNode[@desc, cpNode];
    String.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['\n];
      PrintHeader[];
      END;
    currentCodePackHti _ CodePackProcs.HtiForCodePackNode[cpNode];
    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, Environment.bytesPerPage];
    pages _ PagesForWords[(CARDINAL[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;
    gd.textIndex _ saveIndex;
    RETURN[FALSE]
    END;

  FinishCodePack: PROC =
    BEGIN
    endPosition: PieceTable.Position = PieceTable.Append[];
    totalBytes: CARDINAL _ Inline.LowHalf[endPosition - codePackPosition];
    pages: CARDINAL =
      (totalBytes + Environment.bytesPerPage-1)/Environment.bytesPerPage;
    gap: CARDINAL;
    delta: CARDINAL =
      CARDINAL[Inline.LowHalf[endPosition]] MOD Environment.bytesPerPage;
    IF gd.printMap THEN {
      IF lastProcEnd # 0 AND endPosition > lastProcEnd THEN 
        NoteData[
	  offset: SegmentOffset[lastProcEnd],
	  length: Inline.LowHalf[endPosition-lastProcEnd]];
      WriteString["------------\n"L];
      IF delta # 0 THEN { 
        gap _ Environment.bytesPerPage - delta;
        WriteNumber[gap, Octal5];
        IF gap > 7 THEN WriteChar['B] ELSE WriteChar[' ];
        WriteString["  unused bytes (last page has "L];
	WriteOctal[delta]; IF delta > 7 THEN WriteChar['B]; 
	WriteString[" bytes)\n"L]};
      WriteString["Code pack pages: "L];
      WriteDecimal[pages];
      WriteChar['\n]; WriteChar['\n]};
    IF pages = 0 THEN Error.EmptyCodePack[class: error, cpId: currentCodePackHti];
    firstCodePack _ FALSE;
    END;

  CopyModuleToPack: PROC [mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
      RETURNS [stop: BOOL] = {
    BEGIN
    currentModule _ mti;
    IF mtb[mti].tableCompiled THEN 
      CopyFakeModule[mti 
        ! FileTable.UnknownFile --[fti]-- => { 
	    Error.ErrorFile[error, "was needed for code but could not be found"L, fti];
	    GOTO CodeFileNotFound}]
    ELSE { 
      IF mtb[mti].residentFrame THEN currentCodePackResident _ TRUE;
      StartModule[mti 
        ! FileTable.UnknownFile --[fti]-- => {
	    Error.ErrorFile[error, "was needed for code but could not be found"L, fti];
	    newConstants _ NIL;  
	    GOTO CodeFileNotFound}];
      CodePackProcs.EnumerateProcs[module, CopyModuleBodies];
      newConstants _ NIL};
    EXITS
      CodeFileNotFound => NULL;
    END;
    RETURN[FALSE]};

  ComputeCodePlacement: PUBLIC PROC =
    BEGIN ENABLE UNWIND => 
      CleanupCodePlacementComputation[ ! PackError => RESUME];
    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 {
      WriteString["\nFile "L];  WriteString[gd.mapFileName];
      WriteString[" created by Packager from "L];  WriteString[gd.packName]; 
      WriteString[" on "L];  WriteTime[Time.Current[]];  WriteChar['\n]};
    CodePackProcs.EnumerateSegments[CreateNewSegment];
    FramePackModules.EnumerateFramePacks[CreateFramePack];
    IF gd.printMap AND gd.mapStream # NIL THEN {
      gd.mapStream.Delete[];  gd.mapStream _ NIL};
    END;
    
  CleanupCodePlacementComputation: PROC = {
    IF gd.printMap AND gd.mapStream # NIL THEN {
      gd.mapStream.Delete[];  gd.mapStream _ NIL};
    PieceTable.Finalize[];  Finalize[]};

  WriteBcdToFile: PUBLIC PROC =
    BEGIN
    limitSgi: BcdDefs.SGIndex;
    bcdPages, bcdPos, size: CARDINAL;
    desc: String.SubStringDescriptor;
    byte: CARDINAL;
    newHeader: LONG POINTER TO BcdDefs.BCD;
    -- open output stream as a byte stream
    IF gd.errors THEN RETURN;
    outStream _ FileStream.Create[gd.outputBcdFile.GetFC];
    -- compute size of new bcd
    bcdPos _ SIZE[BcdDefs.BCD];
    newHeader _ z.NEW[BcdDefs.BCD _ 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:  FileStream.GetLeaderProperties[outStream].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.lfOffset _ bcdPos; 
    bcdPos _ bcdPos + LOOPHOLE[newHeader.lfLimit, 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;

    bcdPages _ PagesForWords[bcdPos];
    newHeader.nPages _ bcdPages;
    limitSgi _ LOOPHOLE[table.Top[BcdDefs.sgtype]];
    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
    [] _ PutBlock[
      outStream,
      newHeader, 
      SIZE[BcdDefs.BCD]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.sstype].base, 
      LOOPHOLE[newHeader.ssLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.cttype].base, 
      LOOPHOLE[newHeader.ctLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.mttype].base, 
      LOOPHOLE[newHeader.mtLimit]];
    [] _ PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.lfOffset, 
      LOOPHOLE[newHeader.lfLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.imptype].base, 
      LOOPHOLE[newHeader.impLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.exptype].base, 
      LOOPHOLE[newHeader.expLimit]];
    [] _ PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.evOffset, 
      LOOPHOLE[newHeader.evLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.sgtype].base, 
      LOOPHOLE[newHeader.sgLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.fttype].base, 
      LOOPHOLE[newHeader.ftLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.sptype].base, 
      LOOPHOLE[newHeader.spLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.nttype].base, 
      LOOPHOLE[newHeader.ntLimit]];
    [] _ PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.typOffset, 
      LOOPHOLE[newHeader.typLimit]];
    [] _ PutBlock[
      outStream,
      SourceBcd.bcdHeader + SourceBcd.bcdHeader.tmOffset, 
      LOOPHOLE[newHeader.tmLimit]];
    [] _ PutBlock[
      outStream,
      table.Bounds[BcdDefs.fptype].base, 
      LOOPHOLE[newHeader.fpLimit]];
    z.FREE[@newHeader];
    -- fill out to a page boundary
    byte _ Inline.LongDivMod[
      num: FileStream.GetIndex[outStream],
      den: Environment.bytesPerPage].remainder;
    IF byte # 0 THEN
      THROUGH (byte..Environment.bytesPerPage] DO 
        outStream.PutByte[0];
        ENDLOOP;
    -- throw out allocator space and source bcd
    END;
    
  PutBlock: PROC [stream: Stream.Handle, p: LONG POINTER, n: CARDINAL] = {
    stream.PutBlock[[LOOPHOLE[p], 0, n*Environment.bytesPerWord]]};
    
  WriteCodeToBcdFile: PUBLIC PROC =
    BEGIN ENABLE UNWIND => {
      PieceTable.Finalize[]; Finalize[]};
    -- close piece table
    IF ~gd.errors THEN PieceTable.Store[outStream]
    ELSE PieceTable.Finalize[];
    outStream.Delete[];  outStream _ NIL;
    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

  PrintHeader: PROC =
    BEGIN
    -- should print bcd version in file
    WriteString["Bytes   EVI  Offset    IPC   Module"L];
    THROUGH [("Module"L).length..modCols] DO WriteChar[' ] ENDLOOP;
    WriteString["Procedure\n\n"L];
    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>\n"L];
    END;
    
  epEv: INTEGER = -1;
  epCatch: INTEGER = -2;
  epLinks: INTEGER = -3;

  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 lastProcEnd # 0 AND pos > lastProcEnd THEN
      NoteData[
	offset: SegmentOffset[lastProcEnd],
	length: Inline.LowHalf[pos-lastProcEnd]];
    lastProcEnd _ pos + length;
    WriteNumber[length, Octal5];
    IF length > 7 THEN WriteChar['B] ELSE WriteChar[' ];
    SELECT ep FROM
      epEv =>    WriteString["   EV"L];
      epCatch => WriteString["  Cat"L];
      epLinks => WriteString[" LNKS"L];
      ENDCASE => WriteNumber[ep, Decimal5];
    offset _ Inline.LowHalf[pos - segmentPosition];
    WriteNumber[offset, Octal7];
    WriteChar['B];
    IF ep = epEv OR ep = epLinks THEN
      WriteString["        "L]
    ELSE
      BEGIN
      offset _ CodeByteOffset[pos];
      WriteNumber[offset, Octal7];
      WriteChar['B];
      END;
    WriteString["  "L];
    cols _ WriteName[mtb[currentModule].name];
    IF ep >= 0 THEN
      BEGIN
      THROUGH [cols..modCols) DO WriteChar[' ] ENDLOOP;
      WriteChar[' ];
      IF ep = 0 THEN WriteString["MAIN"L]
      ELSE IF hti = Symbols.HTNull THEN
        WriteString[" <nested>"L]
      ELSE [] _ WriteProcName[hti]
      END;
    WriteChar['\n];
    END;

  WriteName: PROC [name: BcdDefs.NameRecord] RETURNS [length: CARDINAL] =
    BEGIN
    desc: String.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: String.SubStringDescriptor;
    IF hti = Symbols.HTNull THEN RETURN[0];
    SymbolOps.SubStringForHash[@desc, hti];
    WriteSubString[@desc];
    RETURN [desc.length];
    END;

  END.