-- file OutCode.mesa
-- last modified by Sweet, July 24, 1980  11:04 AM
-- last modified by Satterthwaite, June 10, 1982 12:02 pm

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [bodyFileIndex, CodePassInconsistency, 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, zNOOP],
  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*SIZE[CSegPrefix]]];
    entryBase _ FileStream.GetIndex[objectStream];
    codeIndex _ SIZE[CSegPrefix]+nBodies*SIZE[EntryVectorItem];
    parity _ even;
    FileStream.SetIndex[objectStream, codeBase + 2*codeIndex];
    fgt _ DESCRIPTOR[OSMiscOps.Pages[fgtPages], (fgtPages*PageSize)/SIZE[FGTEntry]];
    entryVector _ DESCRIPTOR[OSMiscOps.Words[nBodies*SIZE[EntryVectorItem]], 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) >= LENGTH[fgt] THEN
        BEGIN
        oldfgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry _ fgt;  
        fgtPages _ fgtPages+1;
        fgt _ DESCRIPTOR[
            OSMiscOps.Pages[fgtPages],
            (fgtPages*PageSize)/SIZE[FGTEntry]];
        FOR i: CARDINAL IN [0..LENGTH[oldfgt]) DO fgt[i] _ oldfgt[i] ENDLOOP;
        OSMiscOps.FreePages[BASE[oldfgt]];
        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: BOOLEAN;
    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 + cc.pad;
	other => WITH cc SELECT FROM
	  table =>
	    BEGIN
	    OPEN Inline;
	    offset _ offset + tablecodebytes + pad;
	    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];
	      IF cc.pad # 0 THEN [] _ MoveToCodeWord[];
	      END;
	    2 =>
	      BEGIN
	      IF cc.pad # 0 THEN 
		BEGIN
		IF parity = even THEN SIGNAL CPtr.CodePassInconsistency;
		WriteCodeByte[Mopcodes.zNOOP];
		END;
	      WriteCodeByte[cc.inst];
	      WriteCodeByte[cc.parameters[1]];
	      END;
	    3 =>
	      BEGIN
	      WriteCodeByte[cc.inst];
	      IF cc.pad # 0 THEN 
		BEGIN
		IF parity = even THEN SIGNAL CPtr.CodePassInconsistency;
		[] _ MoveToCodeWord[];
		END;
	      WriteCodeByte[cc.parameters[1]]; WriteCodeByte[cc.parameters[2]];
	      END;
	    ENDCASE => P5.P5Error[837];
	  offset _ offset+cc.isize+cc.pad;
	  END;
	other => WITH cc SELECT FROM
	  table =>
	    BEGIN
	    CPtr.codeptr _ c;
	    P5.C1W[IF btab THEN Mopcodes.zJIB ELSE Mopcodes.zJIW, taboffset];
	    cb[CPtr.codeptr].pad _ pad;
	    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+SIZE[code CCItem],
	label => SIZE[label CCItem],
	jump => SIZE[jump CCItem],
	other => WITH cc SELECT FROM
		  absSource => SIZE[absSource other CCItem],
		  relSource => SIZE[relSource other CCItem],
		  ENDCASE => SIZE[other CCItem],	-- 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 [BOOLEAN] =
    BEGIN
    DO
    WITH cb[j] SELECT FROM
      jump =>
	IF jtype = JumpC THEN
	  BEGIN
	  jBytes: INTEGER = cb[destlabel].pc - pc + 3;
	  IF ~forward OR jBytes > LAST[Byte] 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[info: [string[index: 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[info: [string[index: 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*SIZE[StringInfo]], 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[info: [string[index: star[i].sti]]]]];
	i _ i+1;
	ENDLOOP;
      stSize _ nextnewframe - framestart;
      BLTStrings[firstNewCode, stSize, framestart, TRUE];
      ENDLOOP;
    IF nStrings # 0 THEN OSMiscOps.FreeWords[BASE[star]];
    END;

  BLTStrings: PROC [coffset, length, foffset: CARDINAL, local: BOOLEAN] =
    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[BASE[fgt], fgti+1];
    MPtr.codeSeg.pages _ ((codeIndex + MPtr.mtRoot.code.offset)+(PageSize-1))/PageSize;
    saveindex _ FileStream.GetIndex[objectStream];
    FileStream.SetIndex[objectStream, entryBase];
    objectStream.PutBlock[[
	BASE[entryVector],
	0, 2*LENGTH[entryVector]*SIZE[PrincOps.EntryVectorItem]]];
    OSMiscOps.FreeWords[BASE[entryVector]];
    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.