-- file OutCode.mesa
-- last modified by Sweet, July 24, 1980  11:04 AM
-- last modified by Satterthwaite, January 10, 1983 10:52 am

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [bodyFileIndex, codeptr],
  CodeDefs: TYPE USING [
    Base, Byte, CCIndex, CCItem, CCNull, codeType, LabelCCIndex, NULLfileindex],
  ComData: TYPE USING [
    codeSeg, fgTable, globalFrameSize, linkCount, mtRoot,
    nBodies, nSigCodes, stopping],
  CompilerUtil: TYPE USING [AcquireStream, NextFilePage, ReleaseStream],
  Environment: TYPE USING [wordsPerPage],
  FileStream: TYPE USING [FileByteIndex, GetIndex, SetIndex],
  FOpCodes: TYPE USING [qBLTC, qLCO, qGADRB, qLADRB],
  Inline: TYPE USING [BITOR, BITSHIFT],
  Literals: TYPE USING [Base, MSTIndex, STIndex, stType],
  LiteralOps: TYPE USING [EnumerateLocalStrings, EnumerateMasterStrings],
  Log: TYPE USING [ErrorTree],
  Mopcodes: TYPE USING [zJIB, zJIW],
  OSMiscOps: TYPE USING [FreePages, FreeWords, Pages, Words],
  P5: TYPE USING [C1W, P5Error],
  P5U: TYPE USING [
    FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, RecordConstant,
    WordsForSei, WordsForString],
  PrincOps: TYPE USING [
    AllocationVectorSize, CSegPrefix, EPRange, EntryVectorItem, InstWord,
    MaxFrameSize, MaxNLinks],
  Stack: TYPE USING [Dump],
  Stream: TYPE USING [Handle, PutBlock, PutWord],
  Symbols: TYPE USING [Base, BodyInfo, bodyType, CBTIndex, RootBti],
  SymbolOps: TYPE USING [TransferTypes],
  SymbolSegment: TYPE USING [FGTEntry, ObjectStep, SourceStep, Stride],
  Table: TYPE USING [IPointer];

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

  -- imported definitions

  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;

  StreamIndex: TYPE = FileStream.FileByteIndex;

  fgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry;
  fgti: INTEGER;
  fgtPages: CARDINAL;

  objectStream: Stream.Handle ← NIL;
  codeBase, entryBase: StreamIndex;
  entryVector: LONG DESCRIPTOR FOR ARRAY OF PrincOps.EntryVectorItem;

  parity: {even, odd};
  codeIndex: CARDINAL;
  buffer: PrincOps.InstWord;

  lastObject, lastSource: CARDINAL;

  StartCodeFile: PUBLIC PROC =
    BEGIN -- called to set up bodytable and init binary file header
    OPEN MPtr, PrincOps;
    prefix: CSegPrefix;
    nGfi: CARDINAL = (MAX[nBodies, nSigCodes] + (PrincOps.EPRange-1))/PrincOps.EPRange;
    IF ~(nGfi IN [1..4]) THEN P5.P5Error[833];
    IF linkCount > PrincOps.MaxNLinks THEN P5.P5Error[834];
    objectStream ← CompilerUtil.AcquireStream[object];
    prefix ← [header: [
	swapinfo: 0,
	info: [stops: MPtr.stopping, fill: 0, altoCode: FALSE,
	  ngfi: nGfi, nlinks: linkCount]],
	entry: ];
    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];
    objectStream.PutBlock[[@prefix, 0, 2*CSegPrefix.SIZE]];
    entryBase ← FileStream.GetIndex[objectStream];
    codeIndex ← CSegPrefix.SIZE+nBodies*EntryVectorItem.SIZE;
    parity ← even;
    FileStream.SetIndex[objectStream, codeBase + 2*codeIndex];
    fgt ← DESCRIPTOR[OSMiscOps.Pages[fgtPages], (fgtPages*PageSize)/FGTEntry.SIZE];
    entryVector ← DESCRIPTOR[OSMiscOps.Words[nBodies*EntryVectorItem.SIZE], nBodies];
    END;

  MoveToCodeWord: PUBLIC PROC RETURNS [CARDINAL] = 
    BEGIN
    IF parity = odd THEN
      BEGIN
      buffer.oddbyte ← 377B;
      objectStream.PutWord[LOOPHOLE[buffer, WORD]];
      parity ← even; codeIndex ← codeIndex+1;
      END;
    RETURN [codeIndex]
    END;


  WriteCodeWord: PUBLIC PROC [w: WORD] =
    BEGIN
    IF parity # even THEN P5.P5Error[835];
    objectStream.PutWord[w];
    codeIndex ← codeIndex+1;
    END;


  WriteCodeByte: PROC [b: Byte] = 
    BEGIN
    IF parity = odd THEN
      BEGIN
      buffer.oddbyte ← b;
      objectStream.PutWord[LOOPHOLE[buffer, WORD]];
      parity ← even; codeIndex ← codeIndex+1;
      END
    ELSE {buffer.evenbyte ← b; parity ← odd};
    END;


  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;


  OutBinary: PUBLIC PROC [bti: CBTIndex, start: LabelCCIndex] =
    BEGIN -- outputs binary bytes for body bti starting at start
    c, cj, nextC: CCIndex;
    offset, e, fs, nw: CARDINAL;
    byteTable, even: BOOL;
    leftByte: WORD;
    bodyStart: CARDINAL ← MoveToCodeWord[];
    offset ← bodyStart * 2;
    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
	    OPEN Inline;
	    offset ← offset + tablecodebytes;
	    taboffset ← bodyStart;
	    byteTable ← btab ← ByteableJumps[flink];
	    even ← TRUE;
	    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 + 3;
		    IF byteTable THEN
		      BEGIN
		      IF even THEN leftByte ← BITSHIFT[jBytes, 8]
		      ELSE WriteCodeWord[BITOR[leftByte, jBytes]];
		      even ← ~even;
		      END
		    ELSE WriteCodeWord[jBytes];
		    END
		  ELSE EXIT;
		ENDCASE => EXIT;
	      ENDLOOP;
	    IF byteTable AND ~even THEN WriteCodeWord[BITOR[leftByte,377B]];
	    bodyStart ← codeIndex;
	    END;
	  ENDCASE;
	  ENDCASE;
      ENDLOOP;
    e ← bb[bti].entryIndex;
    lastSource ← bb[bti].sourceIndex;
    WITH bi: bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	IF bti = Symbols.RootBti THEN
	  {WriteCodeWord[MPtr.globalFrameSize]; bodyStart ← bodyStart+1};
	fs ← P5U.ComputeFrameSize[bi.frameSize];
	IF bb[bti].resident THEN fs ← fs+PrincOps.AllocationVectorSize;
	offset ← lastObject ← bodyStart*2;
	entryVector[e].info.framesize ← fs;
	END;
      ENDCASE => P5.P5Error[836];
    NewFgtEntry[source: lastSource, object: lastObject]; -- put out [0,0]
    entryVector[e].info.nparams ←
      P5U.WordsForSei[SymbolOps.TransferTypes[bb[bti].ioType].typeIn];
    entryVector[e].info.defaults ← FALSE;
    entryVector[e].initialpc ← [bodyStart];	-- currently a WordPC
    bb[bti].info ← BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
    FOR c ← start, nextC UNTIL c = CCNull DO
      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
	      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;
	other => WITH cc SELECT FROM
	  table =>
	    BEGIN
	    CPtr.codeptr ← c;
	    P5.C1W[IF btab THEN Mopcodes.zJIB ELSE Mopcodes.zJIW, taboffset];
	    END;
	  markbody =>
	    IF start THEN
	      BEGIN -- immediately prior chunk was source
	      bb[index].info ← BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
	      WITH br: bb[index] SELECT FROM
		Other => br.relOffset ← offset - bodyStart*2;
		ENDCASE => ERROR;
	      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*2;
		    ENDCASE => ERROR;
		  END;
		ENDCASE;
	      END;
	  absSource => IF index # NULLfileindex THEN
	    BEGIN
	    IF index > lastSource OR
	     (index = lastSource AND offset # lastObject) THEN NewFgtEntry[index, offset];
	    END;
	  relSource =>
	    BEGIN
	    index: CARDINAL = CPtr.bodyFileIndex + relIndex;
	    IF index > lastSource OR
	     (index = lastSource AND offset # lastObject) THEN NewFgtEntry[index, offset];
	    END;
	  ENDCASE;
	ENDCASE;
      nextC ← cb[c].flink;
      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 => WITH cc SELECT FROM
		  absSource => CCItem.other.absSource.SIZE,
		  relSource => CCItem.other.relSource.SIZE,
		  ENDCASE => CCItem.other.SIZE,		-- NB: see CCellAllocate
	ENDCASE => ERROR;
      P5U.FreeChunk[c, nw];
      WITH bb[bti].info SELECT FROM
	External => {indexLength ← fgti-startIndex+1; bytes ← offset - (bodyStart*2)};
	ENDCASE;
      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: Table.IPointer, nw: CARDINAL] =
    BEGIN
    objectStream.PutBlock[[s, 0, 2*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];
      codeIndex ← codeIndex+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
        BEGIN
	BLTStrings[firstNewCode, stSize, framestart, FALSE];
	END;
      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 ← MoveToCodeWord[];
    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]]]]];
	  stb[msti].codeIndex ← nextNewCode;
	  nextNewCode ← nextNewCode + nw;
	  WriteCodeString[@stb[msti].string, nw];
	  codeIndex ← codeIndex+nw;
	  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 qLADRB ELSE qGADRB, foffset];
    P5U.Out0[qBLTC];
    END;

  EndCodeFile: PUBLIC PROC RETURNS [nbytes: CARDINAL] =
    BEGIN
    saveindex: StreamIndex;
    [] ← MoveToCodeWord[];
    MPtr.fgTable ← DESCRIPTOR[fgt.BASE, fgti+1];
    MPtr.codeSeg.pages ← ((codeIndex + MPtr.mtRoot.code.offset)+(PageSize-1))/PageSize;
    saveindex ← FileStream.GetIndex[objectStream];
    FileStream.SetIndex[objectStream, entryBase];
    objectStream.PutBlock[[
	entryVector.BASE,
	0, 2*entryVector.LENGTH*PrincOps.EntryVectorItem.SIZE]];
    OSMiscOps.FreeWords[entryVector.BASE];
    MPtr.mtRoot.framesize ← MPtr.globalFrameSize;
    MPtr.mtRoot.code.length ← codeIndex*2;
    FileStream.SetIndex[objectStream, saveindex];
    CompilerUtil.ReleaseStream[object];  objectStream ← NIL;
    RETURN [codeIndex*2]
    END;

  END.