-- file OutCode.mesa
-- last modified by Sweet, July 29, 1982 3:54 pm
-- last modified by Satterthwaite, January 11, 1983 4:59 pm

DIRECTORY
  Alloc: TYPE USING [Notifier],
  CatchFormat: TYPE USING [EnableItem],
  Code: TYPE USING [codeptr, enableList],
  CodeDefs: TYPE USING [
    Base, BYTE, CCIndex, CCItem, CCNull, codeType, EINull, 
    EnableIndex, LabelCCIndex, NULLfileindex, TableCodeBytes],
  ComData: TYPE USING [
    catchBytes, catchIndex, codeByteOffsetList, codeOffsetList, 
    codeSeg, fgTable, globalFrameSize, jumpIndirectList,
    linkCount, mtRoot, nBodies, nSigCodes, 
    stopping, switches, zone],
  CompilerUtil: TYPE USING [AcquireStream, NextFilePage, ReleaseStream],
  Environment: TYPE USING [bytesPerPage, wordsPerPage],
  FileStream: TYPE USING [FileByteIndex, GetIndex, SetIndex],
  Fixup: TYPE USING [JIHandle, JIRec, PCHandle, PCRec],
  FOpCodes: TYPE USING [qBLTC, qLCO, qGA, qLA],
  Literals: TYPE USING [Base, MSTIndex, STIndex, stType],
  LiteralOps: TYPE USING [EnumerateLocalStrings, EnumerateMasterStrings],
  Log: TYPE USING [ErrorTree],
  Mopcodes: TYPE USING [zJIB, zJIW, zLIW],
  OSMiscOps: TYPE USING [FreePages, FreeWords, Pages, Words],
  P5: TYPE USING [C1W, P5Error],
  P5U: TYPE USING [
    FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, RecordConstant,
    WordsForString],
  PrincOps: TYPE USING [
    AVHeapSize, BytePC, CSegPrefix, EntryVectorItem, EPRange, GlobalOverhead,
    MaxFrameSize],
  Stack: TYPE USING [Dump],
  Stream: TYPE USING [Block, Handle, PutBlock, PutByte, PutWord],
  Symbols: TYPE USING [Base, BodyInfo, bodyType, CBTIndex, RootBti],
  SymbolSegment: TYPE USING [FGTEntry, ObjectStep, SourceStep, Stride];

OutCode: PROGRAM
    IMPORTS MPtr: ComData, CPtr: Code, CompilerUtil, FileStream, LiteralOps, Log,
      OSMiscOps, P5, P5U, Stack, Stream 
    EXPORTS CodeDefs, P5 =
  BEGIN
  OPEN CodeDefs;

  -- imported definitions

  Address: TYPE = CARDINAL;
  PageSize: CARDINAL = Environment.wordsPerPage;

  BodyInfo: TYPE = Symbols.BodyInfo;
  CBTIndex: TYPE = Symbols.CBTIndex;
  FGTEntry: TYPE = SymbolSegment.FGTEntry;

  STIndex: TYPE = Literals.STIndex;
  MSTIndex: TYPE = Literals.MSTIndex;


  cb: CodeDefs.Base;		-- code base (local copy)
  bb: Symbols.Base;
  stb: Literals.Base;

  OutCodeNotify: PUBLIC Alloc.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    cb _ base[codeType];
    bb _ base[Symbols.bodyType];
    stb _ base[Literals.stType];
    END;

  FileSequenceError: SIGNAL = CODE;

  ByteBlock: PROC [base: LONG POINTER, nw: CARDINAL] RETURNS [Stream.Block] = INLINE {
    RETURN [[LOOPHOLE[base], 0, 2*nw]]};
    
  StreamIndex: TYPE = FileStream.FileByteIndex;

  fgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry;
  fgti: INTEGER;
  fgtPages: CARDINAL;
  
  LabelPcInfo: TYPE = RECORD [label: LabelCCIndex, pc: Address];
  LabelPcSeq: TYPE = RECORD [
    count: NAT, 
    data: SEQUENCE max: [0 .. NAT.LAST/LabelPcInfo.SIZE) OF LabelPcInfo];
  LabelPcList: TYPE = LONG POINTER TO LabelPcSeq;
  labelPcList: LabelPcList _ NIL;
  
  SetLabelPc: PROC [label: LabelCCIndex, pc: Address] =
    BEGIN
    count: NAT _ IF labelPcList = NIL THEN 0 ELSE labelPcList.count;
    FOR i: NAT IN [0..count) DO
      IF labelPcList[i].label = label THEN {labelPcList[i].pc _ pc; RETURN};
      ENDLOOP;
    IF labelPcList = NIL OR count = labelPcList.max THEN {
      new: LabelPcList _ MPtr.zone.NEW[LabelPcSeq[count+20] _ 
        [count: count, data:]];
      FOR j: NAT IN [0..count) DO new[j] _ labelPcList[j] ENDLOOP;
      IF labelPcList # NIL THEN MPtr.zone.FREE[@labelPcList];
      labelPcList _ new};
    labelPcList[count] _ [label: label, pc: pc];
    labelPcList.count _ count+1;
    END;
    
  GetLabelPc: PROC [label: LabelCCIndex] RETURNS [Address] =
    BEGIN
    IF labelPcList = NIL THEN ERROR;
    FOR i: NAT IN [0..labelPcList.count) DO
      IF labelPcList[i].label = label THEN RETURN [labelPcList[i].pc];
      ENDLOOP;
    ERROR;
    END;

  objectStream: Stream.Handle _ NIL;
  codeBase: StreamIndex;
  entryVector: LONG DESCRIPTOR FOR ARRAY OF PrincOps.EntryVectorItem;
  
  catchEntry: LONG DESCRIPTOR FOR ARRAY OF PrincOps.BytePC;

  codeByteIndex: CARDINAL;

  lastObject, lastSource: CARDINAL;

  StartCodeFile: PUBLIC PROC =
    BEGIN -- called to set up bodytable and init binary file header
    OPEN MPtr, PrincOps;
    nGfi: CARDINAL = (MAX[nBodies, nSigCodes] + (PrincOps.EPRange-1))/PrincOps.EPRange;
    IF ~(nGfi IN [1..4]) THEN P5.P5Error[833];
    IF linkCount > 377B THEN P5.P5Error[834];
    objectStream _ CompilerUtil.AcquireStream[object];
    codeSeg.base _ CompilerUtil.NextFilePage[];
    fgti _ -1; fgtPages _ 1;
    IF mtRoot.code.offset # 0 THEN
      BEGIN
      objectStream.PutWord[mtRoot.code.offset];
      THROUGH (1..mtRoot.code.offset] DO objectStream.PutWord[0] ENDLOOP;
      END;
    codeBase _ FileStream.GetIndex[objectStream];
    codeByteIndex _ (CSegPrefix.SIZE+nBodies*EntryVectorItem.SIZE+1)*2;
    FileStream.SetIndex[objectStream, codeBase + codeByteIndex];
    fgt _ DESCRIPTOR[OSMiscOps.Pages[fgtPages], (fgtPages*PageSize)/FGTEntry.SIZE];
    entryVector _ DESCRIPTOR[
      OSMiscOps.Words[nBodies*EntryVectorItem.SIZE], 
      nBodies];
    catchEntry _ DESCRIPTOR [
      OSMiscOps.Words[MPtr.catchIndex*PrincOps.BytePC.SIZE], MPtr.catchIndex];
    firstCatch _ lastCatch _ CCNull;
    END;

  MoveToCodeWord: PUBLIC PROC RETURNS [CARDINAL] = 
    BEGIN
    IF codeByteIndex MOD 2 = 1 THEN {
      objectStream.PutByte[377B]; codeByteIndex _ codeByteIndex+1};
    RETURN [codeByteIndex/2]
    END;


  WriteCodeWord: PUBLIC PROC [w: WORD] =
    BEGIN
    IF codeByteIndex MOD 2 = 1 THEN P5.P5Error[835];
    objectStream.PutWord[w];
    codeByteIndex _ codeByteIndex+2;
    END;


  WriteCodeByte: PROC [b: BYTE] = {
    objectStream.PutByte[b]; codeByteIndex _ codeByteIndex+1};


  NewFgtEntry: PROC [source, object: CARDINAL] =
    BEGIN -- enters new value into fgt

    AddEntry: PROC [e: SymbolSegment.FGTEntry] =
      BEGIN
      IF (fgti _ fgti+1) >= fgt.LENGTH THEN
        BEGIN
        oldfgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry _ fgt;  
        fgtPages _ fgtPages+1;
        fgt _ DESCRIPTOR[
            OSMiscOps.Pages[fgtPages],
            (fgtPages*PageSize)/FGTEntry.SIZE];
        FOR i: CARDINAL IN [0..oldfgt.LENGTH) DO fgt[i] _ oldfgt[i] ENDLOOP;
        OSMiscOps.FreePages[oldfgt.BASE];
        END;
      fgt[fgti] _ e;
      END;

    t: CARDINAL;
    dSource: CARDINAL _ source - lastSource;
    dObject: CARDINAL _ object - lastObject;
    WHILE dSource > SymbolSegment.SourceStep DO
      t _ MIN[dSource, SymbolSegment.Stride];
      AddEntry[[step[which: source, delta: t]]];
      dSource _ dSource - t;
      ENDLOOP;
    WHILE dObject > SymbolSegment.ObjectStep DO
      t _ MIN[dObject, SymbolSegment.Stride];
      AddEntry[[step[which: object, delta: t]]];
      dObject _ dObject - t;
      ENDLOOP;
    AddEntry[[normal[deltaObject: dObject, deltaSource: dSource]]];
    lastSource _ source; lastObject _ object;
    END;


  OutJumpTables: PUBLIC PROC [start: CCIndex] RETURNS [bodyStart: Address] =
    BEGIN -- outputs binary bytes starting at start
    c, cj: CCIndex;
    offset: CARDINAL;
    byteTable: BOOL;
    bodyStart _ codeByteIndex;
    offset _ bodyStart;
    FOR c _ start, cb[c].flink UNTIL c = CCNull DO
      WITH  cc:cb[c] SELECT FROM
	code => offset _ offset + cc.isize;
	other => WITH cc SELECT FROM
	  table =>
	    BEGIN
	    offset _ offset + TableCodeBytes;
	    taboffset _ MoveToCodeWord[];
	    byteTable _ btab _ ByteableJumps[flink];
	    FOR cj _ flink, cb[cj].flink DO
	      WITH cb[cj] SELECT FROM
		jump =>
		  IF jtype = JumpC THEN
		    BEGIN
		    -- jBytes is surprisingly correct for both forward
		    --   and backward jumps.
		    jBytes: INTEGER _ cb[destlabel].pc - pc+1;
		    jBytes _ jBytes+2;
		    IF byteTable THEN WriteCodeByte[jBytes]
		    ELSE WriteCodeWord[jBytes];
		    END
		  ELSE EXIT;
		ENDCASE => EXIT;
	      ENDLOOP;
	    IF byteTable THEN [] _ MoveToCodeWord[];
	    bodyStart _ codeByteIndex;
	    END;
	  ENDCASE;
	ENDCASE;
      ENDLOOP;
    END;


  OutChunks: PUBLIC PROC [start: CCIndex] =
    BEGIN -- outputs binary bytes for body bti starting at start
    c, nextC: CCIndex;
    offset, nw: CARDINAL;
    bodyStart: Address _ codeByteIndex;
    labelToKeep: BOOL;
    offset _ bodyStart;
    FOR c _ start, nextC UNTIL c = CCNull DO
      labelToKeep _ FALSE;
      WITH cc:cb[c] SELECT FROM
	code =>
	  BEGIN
	  IF ~cc.realinst THEN ERROR;
	  SELECT cc.isize FROM
	    0 => IF cc.realinst THEN ERROR;
	    1 =>
	      BEGIN
	      WriteCodeByte[cc.inst];
	      END;
	    2 =>
	      BEGIN
	      WriteCodeByte[cc.inst];
	      WriteCodeByte[cc.parameters[1]];
	      END;
	    3 => 
	      BEGIN
	      IF cc.inst = Mopcodes.zLIW AND cc.lco THEN {
		new: Fixup.PCHandle = MPtr.zone.NEW [Fixup.PCRec _ [
		  pc: [offset], next: ]];
		IF MPtr.codeOffsetList = NIL THEN new.next _ new
		ELSE {
		  new.next _ MPtr.codeOffsetList.next;
		  MPtr.codeOffsetList.next _ new};
		MPtr.codeOffsetList _ new;
		fixupThisProc _ TRUE}; 
	      WriteCodeByte[cc.inst];
	      WriteCodeByte[cc.parameters[1]]; WriteCodeByte[cc.parameters[2]];
	      END;
	    ENDCASE =>	-- only from MACHINE CODE inlines
	      BEGIN
	      WriteCodeByte[cc.inst];
	      FOR i: CARDINAL IN [1..cc.isize) DO WriteCodeByte[cc.parameters[i]] ENDLOOP;
	      END;
	  offset _ offset+cc.isize;
	  END;
	label => IF cc.offsetLoaded THEN 
	  {SetLabelPc[label: LOOPHOLE[c], pc: offset]; labelToKeep _ TRUE};
	jump => IF cc.jtype = JumpLIO THEN
	  BEGIN
	  val: RECORD [SELECT OVERLAID * FROM
	    card => [c: CARDINAL],
	    pair => [b1, b2: [0..256)],
	    ENDCASE];
	  new: Fixup.PCHandle = MPtr.zone.NEW [Fixup.PCRec _ [
	    pc: [offset], next: ]];
	  IF MPtr.codeByteOffsetList = NIL THEN new.next _ new 
	  ELSE {
	    new.next _ MPtr.codeByteOffsetList.next;
	    MPtr.codeByteOffsetList.next _ new};
	  MPtr.codeByteOffsetList _ new;
	  val.c _ GetLabelPc[cc.destlabel];
	  WriteCodeByte[Mopcodes.zLIW];
	  WriteCodeByte[val.b1];
	  WriteCodeByte[val.b2];
	  offset _ offset + 3;
	  fixupThisProc _ TRUE;
	  END;
	other => WITH cc SELECT FROM
	  table =>
	    BEGIN
	    new: Fixup.JIHandle = MPtr.zone.NEW [Fixup.JIRec _ [
	      pc: [offset], tableSize: tableSize, next: ]];
	    IF MPtr.jumpIndirectList = NIL THEN new.next _ new
	    ELSE {
	      new.next _ MPtr.jumpIndirectList.next;
	      MPtr.jumpIndirectList.next _ new};
	    MPtr.jumpIndirectList _ new;
	    CPtr.codeptr _ c;
	    P5.C1W[IF btab THEN Mopcodes.zJIB ELSE Mopcodes.zJIW, taboffset];
	    fixupThisProc _ TRUE;
	    END;
	  markbody =>
	    IF start THEN
	      BEGIN -- immediately prior chunk was source unless catch
	      WITH br: bb[index] SELECT FROM
		Other => br.relOffset _ offset - bodyStart;
		Callable => WITH brc: br SELECT FROM
		  Catch => {
		    catchEntry[brc.index] _ [offset];
		    lastSource _ brc.sourceIndex;
		    lastObject _ bodyStart _ offset;
		    NewFgtEntry[lastSource, lastObject]}; -- a [0,0] for this body
		  ENDCASE => ERROR;
		ENDCASE => ERROR;
	      bb[index].info _ BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
	      END
	    ELSE
	      BEGIN
	      WITH bi: bb[index].info SELECT FROM
		External =>
		  BEGIN
		  bi.indexLength _ fgti-bi.startIndex+1;
		  WITH br: bb[index] SELECT FROM
		    Other => bi.bytes _ offset - br.relOffset - bodyStart;
		    Callable => WITH brc: br SELECT FROM
		      Catch => bi.bytes _ offset - catchEntry[brc.index];
		      ENDCASE => ERROR;
		    ENDCASE => ERROR;
		  END;
		ENDCASE;
	      END;
	  markCatch =>
	    IF start THEN cb[index].startPC _ offset
	    ELSE cb[index].bytes _ offset - cb[index].startPC;
	  source => IF index # NULLfileindex THEN
	    BEGIN
	    IF index > lastSource OR
	     (index = lastSource AND offset # lastObject) THEN 
	     NewFgtEntry[index, offset];
	    END;
	  ENDCASE;
	ENDCASE;
      nextC _ cb[c].flink;
      IF ~labelToKeep THEN {
        nw _ WITH cc: cb[c] SELECT FROM
	  code => MAX[cc.isize, 1]-1 + CCItem.code.SIZE,
	  label => CCItem.label.SIZE,
	  jump => CCItem.jump.SIZE,
	  other => CCItem.other.SIZE,
	  ENDCASE => ERROR;
        P5U.FreeChunk[c, nw]};
      ENDLOOP;
    END;


  fixupThisProc: BOOL;
  
  OutBinary: PUBLIC PROC [bti: CBTIndex, start: CCIndex] =
    BEGIN -- outputs binary bytes for body bti starting at start
    e, fs: CARDINAL;
    bodyStart: Address;
    fixupThisProc _ FALSE;
    bodyStart _ OutJumpTables[start];
    RemoveCatchCode[start];
    e _ bb[bti].entryIndex;
    lastSource _ bb[bti].sourceIndex;
    lastObject _ bodyStart;
    WITH bi: bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	fs _ P5U.ComputeFrameSize[bi.frameSize];
	IF bb[bti].resident THEN fs _ fs+PrincOps.AVHeapSize;
	END;
      ENDCASE => P5.P5Error[836];
    NewFgtEntry[source: lastSource, object: lastObject]; -- put out [0,0]
    entryVector[e].pc _ [bodyStart];
    bb[bti].info _ BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
    WriteCodeByte[fs];
    OutChunks[start]; 
    WITH bb[bti].info SELECT FROM
      External => {
	indexLength _ fgti - startIndex+1; 
	bytes _ codeByteIndex - bodyStart};
      ENDCASE;
--  bb[bti].hints.needsFixup _ fixupThisProc;
    END;



  RemoveCatchCode: PROC [start: CCIndex] =
    BEGIN
    c: CCIndex;
    FOR c _ start, cb[c].flink UNTIL c = CCNull DO
      WITH cc:cb[c] SELECT FROM
	other => WITH cc SELECT FROM
	  markbody =>
	    IF start THEN
	      BEGIN
	      WITH br: bb[index] SELECT FROM
		Other => NULL;
		Callable => WITH brc: br SELECT FROM
		  Catch => {DelinkCatch[c]; RETURN};
		  ENDCASE;
		ENDCASE;
	      END;
	  ENDCASE;
	ENDCASE;
      ENDLOOP;
    END;
    
  firstCatch, lastCatch: CCIndex;
  
  DelinkCatch: PROC [c: CCIndex] =
    BEGIN
    prev: CCIndex = cb[c].blink;
    IF firstCatch = CCNull THEN firstCatch _ c
    ELSE cb[lastCatch].flink _ c; 
    cb[c].blink _ lastCatch;
    cb[prev].flink _ CCNull;
    lastCatch _ c;
    WHILE cb[lastCatch].flink # CCNull DO 
      lastCatch _ cb[lastCatch].flink;
      ENDLOOP;
    END;

  ByteableJumps: PROC [j: CCIndex] RETURNS [BOOL] =
    BEGIN
    DO
    WITH cb[j] SELECT FROM
      jump =>
	IF jtype = JumpC THEN
	  BEGIN
	  jBytes: INTEGER = cb[destlabel].pc - pc + 3;
	  IF ~forward OR jBytes > BYTE.LAST THEN RETURN [FALSE];
	  j _ cb[j].flink;
	  END
	ELSE RETURN [TRUE];
      ENDCASE => RETURN [TRUE]
    ENDLOOP
    END;


  WriteCodeString: PROC [s: LONG POINTER, nw: CARDINAL] =
    BEGIN
    objectStream.PutBlock[ByteBlock[s, nw]];
    END;

  ProcessGlobalStrings: PUBLIC PROC [framestart: CARDINAL]
      RETURNS [nextnewframe: CARDINAL] =
    BEGIN
    firstNewCode, nextNewCode: CARDINAL _ MoveToCodeWord[];
    stSize, litSize: CARDINAL;
    
    DoString: PROC [msti: MSTIndex] =
      BEGIN
      nw: CARDINAL;
      IF stb[msti].info = 0 THEN {stb[msti].local _ TRUE; RETURN};
      nw _ P5U.WordsForString[stb[msti].string.length];
      stb[msti].info _ nextnewframe; 
      nextnewframe _ nextnewframe+nw;
      IF nextnewframe > PrincOps.MaxFrameSize THEN
	Log.ErrorTree[addressOverflow, [literal[[string[msti]]]]];
      stb[msti].codeIndex _ nextNewCode;
      nextNewCode _ nextNewCode + nw;
      WriteCodeString[@stb[msti].string, nw];
      codeByteIndex _ codeByteIndex + 2*nw;
      END; -- of doglobal

    nextnewframe _ framestart;
    LiteralOps.EnumerateMasterStrings[DoString];
    litSize _ nextNewCode - firstNewCode;  stSize _ nextnewframe - framestart;
    IF litSize > 0 THEN 
      BEGIN
      P5U.RecordConstant[firstNewCode, litSize];
      IF stSize > 0 THEN BLTStrings[firstNewCode, stSize, framestart, FALSE];
      END;
    END;


  ProcessLocalStrings: PUBLIC PROC [framestart: CARDINAL, first: STIndex]
      RETURNS [nextnewframe: CARDINAL] =
    BEGIN
    nStrings: CARDINAL _ 0;

    CountStrings: PROC [msti: MSTIndex] =
      BEGIN
      IF stb[msti].local AND stb[msti].codeIndex # 0 THEN nStrings _ nStrings+1;
      END;

    firstNewCode, nextNewCode: CARDINAL;
    firstCode: BOOL _ TRUE;
    stSize, i, nw: CARDINAL;
    curSize: CARDINAL _ 0;
    StringInfo: TYPE = RECORD [offset: CARDINAL, sti: MSTIndex];
    star: LONG DESCRIPTOR FOR ARRAY OF StringInfo;

    InsertStrings: PROC [msti: MSTIndex] =
      BEGIN
      IF stb[msti].local THEN
	BEGIN 
	co: CARDINAL = stb[msti].codeIndex; 
	IF co # 0 THEN
	  BEGIN
	  FOR i _ curSize, i-1 WHILE i>0 AND co < star[i-1].offset DO
	    star[i] _ star[i-1];
	    ENDLOOP; 
	  star[i] _ [co, msti]; 
	  curSize _ curSize+1;
	  END
	ELSE
	  BEGIN
	  nw: CARDINAL = P5U.WordsForString[stb[msti].string.length];
	  stb[msti].info _ nextnewframe; 
	  nextnewframe _ nextnewframe+nw;
	  IF nextnewframe > PrincOps.MaxFrameSize THEN
	    Log.ErrorTree[addressOverflow, [literal[[string[msti]]]]];
	  IF firstCode THEN {
	    firstCode _ FALSE; firstNewCode _ nextNewCode _ MoveToCodeWord[]};
	  stb[msti].codeIndex _ nextNewCode;
	  nextNewCode _ nextNewCode + nw;
	  WriteCodeString[@stb[msti].string, nw];
	  codeByteIndex _ codeByteIndex + nw*2;
	  END;
	END;
      END; -- of InsertStrings

    nextnewframe _ framestart;
    LiteralOps.EnumerateLocalStrings[first, CountStrings];
    IF nStrings # 0 THEN 
      star _ DESCRIPTOR[OSMiscOps.Words[nStrings*StringInfo.SIZE], nStrings];
    LiteralOps.EnumerateLocalStrings[first, InsertStrings];
    stSize _ nextnewframe - framestart;
    IF stSize > 0 THEN 
      BEGIN
      BLTStrings[firstNewCode, stSize, framestart, TRUE];
      P5U.RecordConstant[firstNewCode, stSize];
      END;
    i _ 0;
    WHILE i < nStrings DO
      framestart _ nextnewframe;
      nextNewCode _ firstNewCode _ star[i].offset;
      WHILE i < nStrings AND star[i].offset = nextNewCode DO
	nw _ P5U.WordsForString[stb[star[i].sti].string.length];
	nextNewCode _ nextNewCode + nw;
	stb[star[i].sti].info _ nextnewframe;
	nextnewframe _ nextnewframe+nw;
	IF nextnewframe > PrincOps.MaxFrameSize THEN
	  Log.ErrorTree[addressOverflow, [literal[[string[star[i].sti]]]]];
	i _ i+1;
	ENDLOOP;
      stSize _ nextnewframe - framestart;
      BLTStrings[firstNewCode, stSize, framestart, TRUE];
      ENDLOOP;
    IF nStrings # 0 THEN OSMiscOps.FreeWords[star.BASE];
    END;

  BLTStrings: PROC [coffset, length, foffset: CARDINAL, local: BOOL] =
    BEGIN OPEN FOpCodes;
    Stack.Dump[]; -- though I don't see how it could be non-empty now
    P5U.Out1[qLCO, coffset];
    P5U.PushLitVal[length];
    P5U.Out1[IF local THEN qLA ELSE qGA, foffset];
    P5U.Out0[qBLTC];
    END;
    
  OutputCatchBodies: PROC =
    BEGIN
    IF firstCatch # CCNull THEN OutChunks[firstCatch];
    MPtr.catchBytes _ codeByteIndex - 2*catchOffset; -- count CEV, etc
    END;
    
  OutputCatchTables: PROC =
    BEGIN
    maxLevel: CARDINAL = CPtr.enableList.LENGTH-1;
    OutEnableLevel: PROC [i: CARDINAL] =
      BEGIN
      n: CARDINAL _ 0;
      ei: EnableIndex;
      ee: CatchFormat.EnableItem;
      lei: EnableIndex = CPtr.enableList[i];
      lnei: EnableIndex;
      FOR ei _ lei, cb[ei].next UNTIL ei = EINull DO 
        n _ n+1;
	ENDLOOP;
      WriteCodeWord[n];
      FOR ei _ lei, cb[ei].next UNTIL ei = EINull DO 
        ee _ [
	  start: [cb[ei].startPC], length: cb[ei].bytes,
	  index: bb[cb[ei].bti].index, alsoNested: FALSE];
	IF i < maxLevel AND (lnei _ CPtr.enableList[i+1]) # EINull THEN
	  BEGIN -- look for nexted catch phrases
	  FOR nei: EnableIndex _ lnei, cb[nei].next UNTIL nei = EINull DO
	    ns: CARDINAL = cb[nei].startPC;
	    IF ns >= ee.start THEN {
	      IF ns < ee.start + ee.length THEN ee.alsoNested _ TRUE;
	      EXIT};
	    ENDLOOP;
	  END;
	[] _ objectStream.PutBlock[ByteBlock[@ee, CatchFormat.EnableItem.SIZE]];
	ENDLOOP;
      END;
    
    SortEnableLists[];
    WriteCodeWord[catchEntry.LENGTH];
    IF catchEntry.LENGTH # 0 THEN
      [] _ objectStream.PutBlock[
	    ByteBlock[catchEntry.BASE, catchEntry.LENGTH*PrincOps.BytePC.SIZE]];
    IF CPtr.enableList[0] = EINull THEN WriteCodeWord[0];
    FOR l: CARDINAL IN [0..maxLevel] WHILE CPtr.enableList[l] # EINull DO
      OutEnableLevel[l];
      ENDLOOP;
    END;
  
  SortEnableLists: PROC = {
    FOR l: CARDINAL IN [0..CPtr.enableList.LENGTH) WHILE CPtr.enableList[l] # EINull DO
      new: EnableIndex _ EINull;
      next: EnableIndex;
      -- do simple insertion sort of each list
      FOR ei: EnableIndex _ CPtr.enableList[l], next UNTIL ei = EINull DO
        next _ cb[ei].next;
        IF new = EINull OR cb[ei].startPC < cb[new].startPC THEN {cb[ei].next _ new; new _ ei}
        ELSE {
          prevEi: EnableIndex _ new;
          WHILE cb[prevEi].next # EINull AND cb[cb[prevEi].next].startPC < cb[ei].startPC DO
            prevEi _ cb[prevEi].next;
            ENDLOOP;
          cb[ei].next _ cb[prevEi].next;
          cb[prevEi].next _ ei};
        CPtr.enableList[l] _ new;
        ENDLOOP;
      ENDLOOP};
    
    
  catchOffset: CARDINAL;

  EndCodeFile: PUBLIC PROC RETURNS [nbytes: CARDINAL] =
    BEGIN OPEN PrincOps;
    maxLevel: CARDINAL = CPtr.enableList.LENGTH-1;
    saveindex, catchIndex: StreamIndex;
    noCatch: BOOL = (catchEntry.LENGTH = 0);
    ctSize: CARDINAL _ 1 + catchEntry.LENGTH*PrincOps.BytePC.SIZE + 1;
    prefix: CSegPrefix;
    nGfi: CARDINAL = (MAX[MPtr.nBodies, MPtr.nSigCodes] + (EPRange-1))/EPRange;
    fs: CARDINAL;
    IF nGfi NOT IN [1..4] THEN P5.P5Error[833];
    IF noCatch THEN {catchOffset _ 0; MPtr.catchBytes _ 0}
    ELSE {
      lei: EnableIndex;
      catchOffset _ MoveToCodeWord[];
      catchIndex _ FileStream.GetIndex[objectStream];
      FOR l: CARDINAL IN [0..maxLevel] WHILE (lei _ CPtr.enableList[l]) # EINull DO
        IF l # 0 THEN ctSize _ ctSize + 1;
        FOR ei: EnableIndex _ lei, cb[ei].next WHILE ei # EINull DO 
          ctSize _ ctSize + CatchFormat.EnableItem.SIZE;
	  ENDLOOP;
        ENDLOOP;
      codeByteIndex _ codeByteIndex + ctSize*2; -- make room for catch entry, enables
      FileStream.SetIndex[objectStream, codeBase + codeByteIndex];
      OutputCatchBodies[]};
    MPtr.mtRoot.code.length _ codeByteIndex;
    [] _ MoveToCodeWord[];
    saveindex _ FileStream.GetIndex[objectStream];
    IF ~noCatch THEN {
      FileStream.SetIndex[objectStream, catchIndex]; codeByteIndex _ catchOffset*2;
      OutputCatchTables[]};
    MPtr.fgTable _ DESCRIPTOR[fgt.BASE, fgti+1];
    MPtr.codeSeg.pages _ 
      (2*MPtr.mtRoot.code.offset + MPtr.mtRoot.code.length + (Environment.bytesPerPage-1))/
         Environment.bytesPerPage;
    FileStream.SetIndex[objectStream, codeBase];
    fs _ P5U.ComputeFrameSize[MPtr.globalFrameSize];
    IF bb[Symbols.RootBti].resident THEN fs _ fs+PrincOps.AVHeapSize;
    prefix _ [
      header: [
	globalFsi: fs,
	nEntries: MPtr.nBodies,
	info: [
	  available: 0, 
	  stops: MPtr.stopping, ngfi: nGfi, nlinks: MPtr.linkCount]],
      entry: NULL];
    [] _ objectStream.PutBlock[ByteBlock[@prefix, CSegPrefix.SIZE]];
    [] _ objectStream.PutBlock[
	ByteBlock[entryVector.BASE, entryVector.LENGTH*PrincOps.EntryVectorItem.SIZE]];
    objectStream.PutWord[catchOffset*2];
    OSMiscOps.FreeWords[entryVector.BASE];
    OSMiscOps.FreeWords[catchEntry.BASE];
    MPtr.mtRoot.framesize _ MPtr.globalFrameSize + PrincOps.GlobalOverhead.SIZE;
    MPtr.mtRoot.crossJumped _ MPtr.switches['j];
    FileStream.SetIndex[objectStream, saveindex];
    CompilerUtil.ReleaseStream[object];  objectStream _ NIL;
    IF labelPcList # NIL THEN {
      FOR i: NAT IN [0..labelPcList.count) DO
        P5U.FreeChunk[labelPcList[i].label, CCItem.label.SIZE];
        ENDLOOP;
      MPtr.zone.FREE[@labelPcList]};
    IF MPtr.codeOffsetList # NIL THEN {
      p: Fixup.PCHandle = MPtr.codeOffsetList.next;
      MPtr.codeOffsetList.next _ NIL; MPtr.codeOffsetList _ p};
    IF MPtr.codeByteOffsetList # NIL THEN {
      p: Fixup.PCHandle = MPtr.codeByteOffsetList.next;
      MPtr.codeByteOffsetList.next _ NIL; MPtr.codeByteOffsetList _ p};
    IF MPtr.jumpIndirectList # NIL THEN {
      j: Fixup.JIHandle = MPtr.jumpIndirectList.next;
      MPtr.jumpIndirectList.next _ NIL; MPtr.jumpIndirectList _ j};
    RETURN [MPtr.mtRoot.code.length]
    END;

  END.