-- file OutCode.mesa
-- last modified by Sandman, Jan 18, 1980 7:04 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [Address, BYTE, PageSize],
  Code: FROM "code" USING [CodePassInconsistency, codeptr, dStar],
  CodeDefs: FROM "codedefs" USING [CCIndex, CCItem, CCNull, NULLfileindex],
  ComData: FROM "comdata" USING [
    codeSeg, fgTable, linkCount, mainBody, mtRoot, nBodies, nSigCodes, 
    objectFrameSize, objectStream, stopping, switches],
  CompilerUtil: FROM "compilerutil" USING [nextFilePage],
  ControlDefs: FROM "controldefs" USING [
    AllocationVectorSize, CSegPrefix, EntryVectorItem, EPRange, 
    InstWord],
  FOpCodes: FROM "fopcodes" USING [qBLTC, qGADRB, qLADRB, qNOOP],
  InlineDefs: FROM "inlinedefs" USING [BITOR, BITSHIFT],
  Literals: FROM "literals" USING [MSTIndex, STIndex, stType],
  LiteralOps: FROM "literalops" USING [
    EnumerateLocalStrings, EnumerateMasterStrings],
  Mopcodes: FROM "mopcodes" USING [zJIB, zJIW, zNOOP],
  P5: FROM "p5" USING [C1W, P5Error],
  P5U: FROM "p5u" USING [
    FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, WordsForSei],
  PrincOps: FROM "PrincOps" USING [InstWord],
  Stack: FROM "stack" USING [Dump],
  StreamDefs: FROM "streamdefs" USING [
    GetIndex, SetIndex, StreamIndex, WriteBlock],
  StringDefs: FROM "stringdefs" USING [WordsForString],
  Symbols: FROM "symbols" USING [
    BodyInfo, bodyType, BTIndex, CBTIndex, CSEIndex, CTXIndex, HTIndex, 
    ISEIndex, RecordSEIndex, SEIndex, SERecord, seType],
  SymbolOps: FROM "symbolops" USING [UnderType],
  SymbolSegment: FROM "symbolsegment" USING [ByteIndex, FGTEntry],
  SystemDefs: FROM "systemdefs" USING [
    AllocateHeapNode, AllocatePages, AllocateSegment, FreeHeapNode, 
    FreePages, FreeSegment],
  Table: FROM "table" USING [Base, Limit, Notifier],
  Tree: FROM "tree" USING [treeType];

OutCode: PROGRAM
    IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, CompilerUtil, InlineDefs, LiteralOps, P5, P5U, Stack, StreamDefs, StringDefs, 
    SymbolOps, SystemDefs 
    EXPORTS CodeDefs, P5
    SHARES Literals =
  BEGIN
  OPEN CodeDefs;


  -- imported definitions

  Address: TYPE = AltoDefs.Address;
  BYTE: TYPE = AltoDefs.BYTE;
  PageSize: INTEGER = AltoDefs.PageSize;

  MyInstWord: TYPE = RECORD [SELECT COMPUTED BOOLEAN FROM
    FALSE => [w: ControlDefs.InstWord],
    TRUE => [w: PrincOps.InstWord],
    ENDCASE];

  BodyInfo: TYPE = Symbols.BodyInfo;
  BTIndex: TYPE = Symbols.BTIndex;
  CBTIndex: TYPE = Symbols.CBTIndex;
  ByteIndex: TYPE = SymbolSegment.ByteIndex;
  CSEIndex: TYPE = Symbols.CSEIndex;
  CTXIndex: TYPE = Symbols.CTXIndex;
  FGTEntry: TYPE = SymbolSegment.FGTEntry;
  HTIndex: TYPE = Symbols.HTIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;
  SEIndex: TYPE = Symbols.SEIndex;
  SERecord: TYPE = Symbols.SERecord;

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


  cb: Table.Base;		-- code base (local copy)
  seb: Table.Base;
  bb: Table.Base;
  stb: Table.Base;

  OutCodeNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    cb _ base[Tree.treeType];
    seb _ base[Symbols.seType];  bb _ base[Symbols.bodyType];
    stb _ base[Literals.stType];
    RETURN
    END;

  FileSequenceError: SIGNAL = CODE;

  fgt: DESCRIPTOR FOR ARRAY OF FGTEntry;
  fgti: INTEGER;
  fgtPages: CARDINAL;
  codeBase, entryBase: StreamDefs.StreamIndex;
  entryVector: DESCRIPTOR FOR ARRAY OF ControlDefs.EntryVectorItem;

  parity: {even, odd};
  codeIndex: CARDINAL;
  buffer: MyInstWord;
  dStarSwitch: BOOLEAN;


  StartCodeFile: PUBLIC PROCEDURE =
    BEGIN -- called to set up bodytable and init binary file header
    OPEN MPtr, ControlDefs, SystemDefs, StreamDefs;
    prefix: CSegPrefix;
    ngfi: CARDINAL = (MAX[nBodies, nSigCodes] + (EPRange-1))/EPRange;
    IF ngfi ~IN [1..4] THEN P5.P5Error[833];
    -- should be 256 (fix ControlDefs)
    IF linkCount > 377B THEN P5.P5Error[834];
    dStarSwitch _ CPtr.dStar;
    prefix _ [header:[
	swapinfo: 0,
	info: [stops: MPtr.stopping, fill: 0, altoCode: ~dStarSwitch,
	  ngfi: ngfi, nlinks: linkCount]],
	entry: ];
    codeSeg.base _ CompilerUtil.nextFilePage[];
    fgti _ -1; fgtPages _ 1;
    codeBase _ GetIndex[objectStream];
    [] _ WriteBlock[objectStream, @prefix, SIZE[CSegPrefix]];
    entryBase _ GetIndex[objectStream];
    codeIndex _ SIZE[CSegPrefix]+nBodies*SIZE[EntryVectorItem];
    parity _ even;
    SetIndex[objectStream, StreamIndex[page: codeBase.page, byte: 2*codeIndex]];
    fgt _ DESCRIPTOR[AllocatePages[fgtPages], (fgtPages*PageSize)/SIZE[FGTEntry]];
    entryVector _ DESCRIPTOR[AllocateSegment[nBodies*SIZE[EntryVectorItem]], nBodies];
    RETURN
    END;

  MoveToCodeWord: PUBLIC PROCEDURE RETURNS [CARDINAL] = 
    BEGIN
    IF parity = odd THEN
      BEGIN
      WITH buffer SELECT dStarSwitch FROM
	FALSE => w.oddbyte _ 377B;
	TRUE => w.oddbyte _ 377B;
	ENDCASE; 
      MPtr.objectStream.put[MPtr.objectStream, buffer];
      parity _ even; codeIndex _ codeIndex+1;
      END;
    RETURN [codeIndex]
    END;


  WriteCodeWord: PUBLIC PROCEDURE [w: WORD] =
    BEGIN
    IF parity # even THEN P5.P5Error[835];
    MPtr.objectStream.put[MPtr.objectStream, w];
    codeIndex _ codeIndex+1;
    RETURN
    END;


  WriteCodeByte: PROCEDURE [b: BYTE] = 
    BEGIN
    IF parity = odd THEN
      BEGIN
      WITH buffer SELECT dStarSwitch FROM
	FALSE => w.oddbyte _ b;
	TRUE => w.oddbyte _ b;
	ENDCASE; 
      MPtr.objectStream.put[MPtr.objectStream, buffer];
      parity _ even; codeIndex _ codeIndex+1;
      END
    ELSE 
      BEGIN
      WITH buffer SELECT dStarSwitch FROM
	FALSE => w.evenbyte _ b;
	TRUE => w.evenbyte _ b;
	ENDCASE; 
      parity _ odd; END;
    RETURN
    END;


  NewFgtEntry: PROCEDURE [fi, ci: ByteIndex] =
    BEGIN -- enters new value into fgt
    i: INTEGER;
    oldfgt: DESCRIPTOR FOR ARRAY OF FGTEntry;

    IF (fgti _ fgti+1) >= LENGTH[fgt] THEN
      BEGIN
      OPEN SystemDefs;
      oldfgt _ fgt;  fgtPages _ fgtPages+1;
      fgt _ DESCRIPTOR[
	    AllocatePages[fgtPages],
	    (fgtPages*PageSize)/SIZE[FGTEntry]];
      FOR i IN [0..LENGTH[oldfgt]) DO fgt[i] _ oldfgt[i] ENDLOOP;
      FreePages[BASE[oldfgt]];
      END;
    fgt[fgti] _ FGTEntry[fIndex: fi, cIndex: ci];
    RETURN
    END;


  OutBinary: PUBLIC PROCEDURE [bti: CBTIndex, start: CCIndex] =
    BEGIN -- outputs binary bytes for body bti starting at start
    cfi: ByteIndex;
    c, cj, nextc: CCIndex;
    bodystart: Address;
    offset, e, fs, nw: CARDINAL;
    bytetable, even: BOOLEAN;
    leftbyte: WORD;
    bodysei: Table.Base RELATIVE POINTER [0..Table.Limit) TO transfer cons SERecord;
    sei: RecordSEIndex;

    bodystart _ 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 InlineDefs;
	    offset _ offset + tablecodebytes + pad;
	    taboffset _ bodystart;
	    bytetable _ btab _ dStarSwitch AND 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+1;
		    IF dStarSwitch THEN jbytes _ jbytes+2;
		    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;
    WITH bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	IF bti = MPtr.mainBody THEN
	  BEGIN
	  WriteCodeWord[MPtr.objectFrameSize];
	  bodystart _ bodystart+1;
	  END;
	fs _ P5U.ComputeFrameSize[frameSize];
	IF bb[bti].resident THEN fs _ fs+ControlDefs.AllocationVectorSize;
	offset _ bodystart*2;
	entryVector[e].info.framesize _ fs;
	NewFgtEntry[cfi _ sourceIndex, offset];
	END;
      ENDCASE => P5.P5Error[836];
    bodysei _ LOOPHOLE[SymbolOps.UnderType[bb[bti].ioType]];
    sei _ seb[bodysei].inRecord;
    entryVector[e].info.nparams _ P5U.WordsForSei[sei];
    entryVector[e].info.defaults _ FALSE;
    entryVector[e].initialpc _ [bodystart];
    bb[bti].info _
	BodyInfo[External[origin: offset, bytes: , startIndex: fgti, indexLength: ]];
    FOR c _ start, nextc UNTIL c = CCNull DO
      WITH cc:cb[c] SELECT FROM
	code =>
	  BEGIN
	  IF cc.sourcefileindex # NULLfileindex THEN
	    BEGIN
	    IF cfi < cc.sourcefileindex THEN
	      NewFgtEntry[cfi _ cc.sourcefileindex, offset];
	    IF cfi > cc.sourcefileindex THEN
	      BEGIN SIGNAL FileSequenceError; cfi _ cc.sourcefileindex; END;
	    END;
	  IF ~cc.realinst AND cc.inst # FOpCodes.qNOOP THEN ERROR;
	  SELECT cc.isize FROM
	    0 => IF cc.realinst OR cc.inst#FOpCodes.qNOOP 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;
	      IF dStarSwitch THEN
		BEGIN
		WriteCodeByte[cc.parameters[1]];
		WriteCodeByte[cc.parameters[2]];
		END
	      ELSE
		BEGIN
		WriteCodeByte[cc.parameters[2]];
		WriteCodeByte[cc.parameters[1]];
		END;
	      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;
	  startbody =>
	    BEGIN
	    WITH bb[index].info SELECT FROM
	      Internal =>
		NewFgtEntry[cfi _ sourceIndex, offset];
	      ENDCASE => P5.P5Error[838];
	    bb[index].info _ BodyInfo[External[origin: offset, bytes: ,
		startIndex: fgti, indexLength: ]];
	    END;
	  endbody =>
	    BEGIN
	    WITH bb[index].info SELECT FROM
	      External =>
		BEGIN
		indexLength _ fgti-startIndex+1;
		bytes _ offset - origin;
		END;
	      ENDCASE;
	    END;
	  ENDCASE;
	ENDCASE;
      nextc _ cb[c].flink;
      WITH cb[c] SELECT FROM
	code => nw _ MAX[isize, 1]-1+SIZE[code CCItem];
	label => nw _ SIZE[label CCItem];
	jump => nw _ SIZE[jump CCItem];
	other => nw _ SIZE[other CCItem];
	ENDCASE;
      P5U.FreeChunk[c, nw];
      WITH bb[bti].info SELECT FROM
	External =>
	  BEGIN
	  indexLength _ fgti-startIndex+1;
	  bytes _ offset - (bodystart*2);
	  END;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;


  ByteableJumps: PROCEDURE [j: CCIndex] RETURNS [BOOLEAN] =
    BEGIN -- called only when dStarSwitch = TRUE
    DO
    WITH cb[j] SELECT FROM
      jump =>
	IF jtype = JumpC THEN
	  BEGIN
	  jbytes: INTEGER _ cb[destlabel].pc - pc + 3;
	  IF ~forward THEN
	    RETURN[FALSE];
	  IF jbytes > LAST[BYTE] THEN RETURN[FALSE];
	  j _ cb[j].flink;
	  END
	ELSE RETURN[TRUE];
      ENDCASE => RETURN[TRUE]
    ENDLOOP
    END;


  ProcessGlobalStrings: PUBLIC PROCEDURE [framestart: CARDINAL] RETURNS [nextnewframe: CARDINAL] =
    BEGIN
    firstnewcode, nextnewcode: CARDINAL _ MoveToCodeWord[];
    stsize: CARDINAL;
    
    dostring: PROCEDURE [msti: MSTIndex] =
      BEGIN
      nw: CARDINAL;
      IF stb[msti].info = 0 THEN
	BEGIN stb[msti].local _ TRUE; RETURN END;
      nw _ StringDefs.WordsForString[stb[msti].string.length];
      stb[msti].info _ nextnewframe; 
      nextnewframe _ nextnewframe+nw;
      stb[msti].codeIndex _ nextnewcode;
      nextnewcode _ nextnewcode + nw;
      [] _ StreamDefs.WriteBlock[MPtr.objectStream, @stb[msti].string, nw];
      codeIndex _ codeIndex+nw;
      END; -- of dostring

    nextnewframe _ framestart;
    LiteralOps.EnumerateMasterStrings[dostring];
    stsize _ nextnewframe - framestart;
    IF stsize > 0 THEN BLTStrings[firstnewcode, stsize, framestart, FALSE];
    END;


  ProcessLocalStrings: PUBLIC PROCEDURE [framestart: CARDINAL, first: STIndex] RETURNS [nextnewframe: CARDINAL] =
    BEGIN
    nstrings: CARDINAL _ 0;
    countstrings: PROCEDURE [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: DESCRIPTOR FOR ARRAY OF StringInfo;
    insertstrings: PROCEDURE [msti: MSTIndex] =
      BEGIN
      i, co, nw: CARDINAL;
      IF stb[msti].local THEN
	BEGIN 
	co _ 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 _ StringDefs.WordsForString[stb[msti].string.length];
	  stb[msti].info _ nextnewframe; 
	  nextnewframe _ nextnewframe+nw;
	  stb[msti].codeIndex _ nextnewcode;
	  nextnewcode _ nextnewcode + nw;
	  [] _ StreamDefs.WriteBlock[MPtr.objectStream, @stb[msti].string, nw];
	  codeIndex _ codeIndex+nw;
	  END;
	END;
      END; -- of insertstrings

    nextnewframe _ framestart;
    LiteralOps.EnumerateLocalStrings[first, countstrings];
    IF nstrings # 0 THEN 
      star _ DESCRIPTOR[
	SystemDefs.AllocateHeapNode[nstrings*SIZE[StringInfo]], 
	nstrings];
    LiteralOps.EnumerateLocalStrings[first, insertstrings];
    stsize _ nextnewframe - framestart;
    IF stsize > 0 THEN BLTStrings[firstnewcode, stsize, framestart, TRUE];
    i _ 0;
    WHILE i < nstrings DO
      framestart _ nextnewframe;
      nextnewcode _ firstnewcode _ star[i].offset;
      WHILE i < nstrings AND star[i].offset = nextnewcode DO
	nw _ StringDefs.WordsForString[stb[star[i].sti].string.length];
	nextnewcode _ nextnewcode + nw;
	stb[star[i].sti].info _ nextnewframe;
	nextnewframe _ nextnewframe+nw;
	i _ i+1;
	ENDLOOP;
      stsize _ nextnewframe - framestart;
      BLTStrings[firstnewcode, stsize, framestart, TRUE];
      ENDLOOP;
    IF nstrings # 0 THEN SystemDefs.FreeHeapNode[BASE[star]];
    END;

  BLTStrings: PROCEDURE [coffset, length, foffset: CARDINAL, local: BOOLEAN] =
    BEGIN OPEN FOpCodes;
    Stack.Dump[];
    P5U.PushLitVal[coffset];
    P5U.PushLitVal[length];
    P5U.Out1[IF local THEN qLADRB ELSE qGADRB, foffset];
    P5U.Out0[qBLTC];
    END;


  EndCodeFile: PUBLIC PROCEDURE RETURNS [nbytes: CARDINAL] =
    BEGIN
    OPEN SystemDefs, StreamDefs;
    saveindex: StreamIndex;
    [] _ MoveToCodeWord[];
    MPtr.fgTable _ DESCRIPTOR[BASE[fgt], fgti+1];
    MPtr.codeSeg.pages _ (codeIndex+(PageSize-1))/PageSize;
    saveindex _ GetIndex[MPtr.objectStream];
    SetIndex[MPtr.objectStream, entryBase];
    [] _ WriteBlock[MPtr.objectStream,
	BASE[entryVector],
	LENGTH[entryVector]*SIZE[ControlDefs.EntryVectorItem]];
    FreeSegment[BASE[entryVector]];
    MPtr.mtRoot.framesize _ MPtr.objectFrameSize;
    MPtr.mtRoot.code.length _ codeIndex*2;
    MPtr.mtRoot.crossJumped _ MPtr.switches['j];
    SetIndex[MPtr.objectStream, saveindex];
    RETURN [codeIndex*2]
    END;

END...