-- file ObjectOut.Mesa
-- last modified by Satterthwaite, October 8, 1979  3:39 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [CharsPerWord, PageSize],
  BcdDefs: FROM "bcddefs" USING [VersionStamp, SGRecord, FTNull],
  ComData: FROM "comdata"
    USING [
      compilerVersion, codeSeg, defBodyLimit, definitionsOnly, fgTable,
      fixupLoc, importCtx, mainCtx, moduleCtx, mtRoot, MTRootSize, netNumber,
      objectBytes, objectFile, objectFrameSize, objectVersion, sourceVersion,
      symSeg],
  CompilerUtil: FROM "compilerutil",
  LiteralOps: FROM "literalops" USING [CopyLiteral, ForgetEntries],
  OsStaticDefs: FROM "osstaticdefs" USING [OsStatics],
  SegmentDefs: FROM "segmentdefs"
    USING [FileHandle, Append, DefaultVersion, Write, NewFile, SetFileAccess],
  StreamDefs: FROM "streamdefs"
    USING [
      StreamHandle, StreamIndex,
      CreateWordStream, GetIndex, NormalizeIndex, SetIndex, WriteBlock],
  StringDefs: FROM "stringdefs" USING [WordsForString],
  Symbols: FROM "symbols" USING [lL],
  SymbolSegment: FROM "symbolsegment"
    USING [
      ltType, htType, ssType, seType, ctxType, mdType, bodyType, extType,
      FGHeader, FGTEntry, ExtRecord, ExtIndex, STHeader, WordOffset,
      VersionID],
  SymbolOps: FROM "symbolops" USING [HashBlock],
  SystemDefs: FROM "systemdefs" USING [FreeSegment],
  Table: FROM "table"
    USING [Base, Notifier, Selector, AddNotify, DropNotify, Bounds],
  TimeDefs: FROM "timedefs" USING [CurrentDayTime],
  Tree: FROM "tree" USING [Index, Link, Map, Node, Null, NullIndex, treeType],
  TreeOps: FROM "treeops" USING [FreeTree, NodeSize, UpdateTree];

ObjectOut: PROGRAM
    IMPORTS
      LiteralOps, SegmentDefs, StreamDefs, StringDefs, SymbolOps, SystemDefs,
      Table, TimeDefs, TreeOps,
      dataPtr: ComData
    EXPORTS CompilerUtil =
  BEGIN

  stream: StreamDefs.StreamHandle;

  PageSize: CARDINAL = AltoDefs.PageSize;
  BytesPerWord: CARDINAL = AltoDefs.CharsPerWord;
  BytesPerPage: CARDINAL = PageSize*BytesPerWord;

  nextFilePage: PUBLIC PROCEDURE RETURNS [CARDINAL] =
    BEGIN  OPEN StreamDefs;
    fill: ARRAY [0..8) OF WORD ← [0, 0, 0, 0, 0, 0, 0, 0];
    m, n, r: INTEGER;
    r ← GetIndex[stream].byte/BytesPerWord;
    IF r # 0 THEN
      FOR n ← PageSize-r, n-m WHILE n > 0
	DO
	m ← MIN[n, LENGTH[fill]];
	[] ← WriteBlock[stream, BASE[fill], m];
	ENDLOOP;
    RETURN [GetIndex[stream].page + 1]
    END;

  WriteObjectWords: PROCEDURE [addr: POINTER, n: CARDINAL] =
    BEGIN
    [] ← StreamDefs.WriteBlock[stream, addr, n];
    RETURN
    END;

  RewriteObjectWords: PROCEDURE [index: StreamDefs.StreamIndex, addr: POINTER, n: CARDINAL] =
    BEGIN  OPEN StreamDefs;
    saveIndex: StreamIndex = GetIndex[stream];
    SetIndex[stream, index];
    [] ← WriteBlock[stream, addr, n];
    SetIndex[stream, saveIndex];
    RETURN
    END;


  -- bcd i/o

  bcdOffset: CARDINAL;
  bcdIndex: StreamDefs.StreamIndex;
  
  BCDIndex: PROCEDURE [offset: CARDINAL] RETURNS [StreamDefs.StreamIndex] =
    BEGIN  OPEN StreamDefs;
    byteOffset: CARDINAL = offset*BytesPerWord;
    RETURN [NormalizeIndex[StreamIndex[
	page: bcdIndex.page + byteOffset/BytesPerPage,
	byte: bcdIndex.byte + byteOffset MOD BytesPerPage]]]
    END;

  StartBCD: PUBLIC PROCEDURE =
    BEGIN
    [] ← nextFilePage[];
    bcdIndex ← StreamDefs.GetIndex[stream];
    bcdOffset ← 0;
    RETURN
    END;

  ReadBCDOffset: PUBLIC PROCEDURE RETURNS [CARDINAL] =
    BEGIN
    RETURN [bcdOffset];
    END;

  ReadBCDIndex: PUBLIC PROCEDURE RETURNS [StreamDefs.StreamIndex] =
    BEGIN
    RETURN [BCDIndex[bcdOffset]];
    END;

  AppendBCDWord: PUBLIC PROCEDURE [word: UNSPECIFIED] =
    BEGIN
    stream.put[stream, word];
    bcdOffset ← bcdOffset + 1;  RETURN
    END;

  AppendBCDWords: PUBLIC PROCEDURE [addr: POINTER, n: CARDINAL] =
    BEGIN
    WriteObjectWords[addr, n];
    bcdOffset ← bcdOffset + n;
    RETURN
    END;

  AppendBCDString: PUBLIC PROCEDURE [s: STRING] =
    BEGIN
    header: StringBody ← [length:s.length, maxlength:s.length, text:];
    AppendBCDWords[@header, SIZE[StringBody]];
    AppendBCDWords[@s.text, StringDefs.WordsForString[s.length] - SIZE[StringBody]];
    RETURN
    END;

  UpdateBCDWords: PUBLIC PROCEDURE [offset: CARDINAL, addr: POINTER, n: CARDINAL] =
    BEGIN
    RewriteObjectWords[BCDIndex[offset], addr, n];
    RETURN
    END;

  EndBCD: PUBLIC PROCEDURE =
    BEGIN
    [] ← nextFilePage[];
    RETURN
    END;

  -- symbol table i/o 

  SetObjectStamp: PUBLIC PROCEDURE =
    BEGIN
    dataPtr.objectVersion ← BcdDefs.VersionStamp[
	net: dataPtr.netNumber,
	host: OsStaticDefs.OsStatics.SerialNumber,
	time: LOOPHOLE[TimeDefs.CurrentDayTime[]]];
    RETURN
    END;


  StartObjectFile: PUBLIC PROCEDURE [file: SegmentDefs.FileHandle] RETURNS [StreamDefs.StreamHandle] =
    BEGIN  OPEN SegmentDefs;
    IF file # NIL
      THEN  SetFileAccess[file, Write+Append]
      ELSE  file ← NewFile[dataPtr.objectFile, Write+Append, DefaultVersion];
    stream ← StreamDefs.CreateWordStream[file, Write+Append];
    RETURN [stream]
    END;


  PageCount: PROCEDURE [words: CARDINAL] RETURNS [CARDINAL] =
    BEGIN
    RETURN [(words+(PageSize-1))/PageSize]
    END;

  SetFgt: PROCEDURE [d: SymbolSegment.WordOffset, sourceFile: STRING]
      RETURNS [fgBase, fgPages: CARDINAL] =
    BEGIN
    np: CARDINAL = PageCount[d];
    dataPtr.symSeg.pages ← np;
    IF dataPtr.definitionsOnly
      THEN
	BEGIN  fgBase ← 0;
	dataPtr.symSeg.extraPages ← fgPages ← 0;
	dataPtr.codeSeg.file ← BcdDefs.FTNull;
	dataPtr.codeSeg.base ← dataPtr.codeSeg.pages ← 0;
	dataPtr.objectBytes ← dataPtr.objectFrameSize ← 0;
	dataPtr.mtRoot.framesize ← 0;
	END
      ELSE 
	BEGIN  
	fgBase ← np;
	dataPtr.symSeg.extraPages ← fgPages ← PageCount[
	    (StringDefs.WordsForString[sourceFile.length]-SIZE[StringBody]) +
	    LENGTH[dataPtr.fgTable]*SIZE[SymbolSegment.FGTEntry] +
	    SIZE[SymbolSegment.FGHeader]];
	END;
    dataPtr.codeSeg.class ← code;  dataPtr.codeSeg.extraPages ← 0;
    RETURN
    END;


  WriteSubTable: PROCEDURE [table: Table.Selector] =
    BEGIN  OPEN Table;
    base: Table.Base;
    size: CARDINAL;
    [base, size] ← Table.Bounds[table];
    WriteObjectWords[LOOPHOLE[base], size];
    RETURN
    END;


  litBias: CARDINAL;

  WriteExtension: PROCEDURE RETURNS [size: CARDINAL] =
    BEGIN
    OPEN SymbolSegment;
    tb, ltb: Table.Base;
    treeLoc: Tree.Index;

    OutputNotify: Table.Notifier =
      BEGIN
      tb ← base[Tree.treeType];  ltb ← base[ltType];
      seb ← base[seType];   ctxb ← base[ctxType];
      extb ← base[extType];  RETURN
      END;

    OutputLiteral: PROCEDURE [t: literal Tree.Link] RETURNS [Tree.Link] =
      BEGIN  OPEN LiteralOps;
      WITH t.info SELECT FROM
	word => index ← CopyLiteral[[baseP:@ltb, index:index]]-litBias;
	ENDCASE => ERROR;
      RETURN [t]
      END;

    SetEmpty: Tree.Map =  BEGIN  RETURN [Tree.Null]  END;

    OutputTree: Tree.Map =
      BEGIN
      s: Tree.Link;
      node: Tree.Index;
      nw: CARDINAL;
      WITH link: t SELECT FROM
	literal =>  v ← OutputLiteral[link];
	subtree =>
	  IF (s ← TreeOps.UpdateTree[link, OutputTree]) = Tree.Null
	    THEN  v ← Tree.Null
	    ELSE
	      WITH s SELECT FROM
		subtree =>
		  BEGIN  node ← index;
		  nw ← TreeOps.NodeSize[@tb, node];
		  WriteObjectWords[@tb[node], nw];
		  [] ← TreeOps.FreeTree[TreeOps.UpdateTree[s, SetEmpty]];
		  v ← [subtree[index: treeLoc]];  treeLoc ← treeLoc + nw;
		  END;
		ENDCASE =>  v ← s;
	ENDCASE => v ← link;
      RETURN
      END;

    extb: Table.Base;
    exti, extLimit: ExtIndex;
    seb, ctxb: Table.Base;
    Table.AddNotify[OutputNotify];
    WriteObjectWords[@tb[Tree.NullIndex], SIZE[Tree.Node]];
    treeLoc ← FIRST[Tree.Index] + SIZE[Tree.Node];
    [extb, LOOPHOLE[extLimit, CARDINAL]] ← Table.Bounds[extType];
    FOR exti ← FIRST[ExtIndex], exti + SIZE[ExtRecord] UNTIL exti = extLimit
      DO
      extb[exti].tree ←
	IF dataPtr.definitionsOnly 
	  OR (extb[exti].type = value
	       AND ctxb[seb[extb[exti].sei].idCtx].level < Symbols.lL)
		  THEN OutputTree[extb[exti].tree]
		  ELSE Tree.Null;
      ENDLOOP;
    Table.DropNotify[OutputNotify];
    RETURN [LOOPHOLE[treeLoc]]
    END;


  TableOut: PUBLIC PROCEDURE [sourceFile: STRING] =
    BEGIN
    OPEN Table, SymbolSegment;
    header: STHeader;
    fixupLoc: StreamDefs.StreamIndex;
    d: WordOffset;
    nw: CARDINAL;
    fgHeader: FGHeader;
    dataPtr.symSeg.class ← symbols;
    dataPtr.symSeg.base ← nextFilePage[];
      BEGIN
      OPEN header;
      versionIdent ← SymbolSegment.VersionID;
      version ← dataPtr.objectVersion;
      sourceVersion ← dataPtr.sourceVersion;
      creator ← dataPtr.compilerVersion;
      definitionsFile ← dataPtr.definitionsOnly;
      directoryCtx ← dataPtr.moduleCtx;
      importCtx ← dataPtr.importCtx;
      outerCtx ← dataPtr.mainCtx;
      d ← SIZE[STHeader];
      hvBlock.offset ← d;
	d ← d + (hvBlock.size ← SymbolOps.HashBlock[].length);
      htBlock.offset ← d;  d ← d + (htBlock.size ← Table.Bounds[htType].size);
      ssBlock.offset ← d;  d ← d + (ssBlock.size ← Table.Bounds[ssType].size);
      seBlock.offset ← d;  d ← d + (seBlock.size ← Table.Bounds[seType].size);
      ctxBlock.offset ← d;
	d ← d + (ctxBlock.size ← Table.Bounds[ctxType].size);  
      mdBlock.offset ← d;  d ← d + (mdBlock.size ← Table.Bounds[mdType].size);
      bodyBlock.offset ← d;  d ← d + Table.Bounds[bodyType].size;
      bodyBlock.size ← dataPtr.defBodyLimit;
      END;
    IF Table.Bounds[extType].size # 0
      THEN  fixupLoc ← StreamDefs.GetIndex[stream]
      ELSE
	BEGIN
	header.treeBlock ← header.litBlock ← header.sLitBlock ←
	  header.extBlock ← [d, 0];
	header.constBlock ← [0, 0];
	[header.fgRelPgBase, header.fgPgCount] ← SetFgt[d, sourceFile];
	END;
    WriteObjectWords[@header, SIZE[STHeader]];
    WriteObjectWords[SymbolOps.HashBlock[].base, header.hvBlock.size];
    WriteSubTable[htType];
    WriteSubTable[ssType];
    WriteSubTable[seType];
    WriteSubTable[ctxType];
    WriteSubTable[mdType];
    WriteSubTable[bodyType];
    IF Table.Bounds[extType].size # 0
      THEN
	BEGIN
	litBias ← LiteralOps.ForgetEntries[];
	header.treeBlock.offset ← d;
	header.treeBlock.size ← WriteExtension[];
	d ← d + header.treeBlock.size;
	header.litBlock.offset ← d;
	nw ← Table.Bounds[ltType].size - litBias;
	WriteObjectWords[LOOPHOLE[Table.Bounds[ltType].base+litBias], nw];
	d ← d + (header.litBlock.size ← nw);
	header.extBlock.offset ← d;
	header.sLitBlock ← [d, 0];
	WriteSubTable[extType];
	d ← d + (header.extBlock.size ← Table.Bounds[extType].size);
	header.constBlock ← [0, 0];
	[header.fgRelPgBase, header.fgPgCount] ← SetFgt[d, sourceFile];
	RewriteObjectWords[fixupLoc, @header, SIZE[STHeader]];
	END;
    IF ~dataPtr.definitionsOnly
      THEN
	BEGIN
	OPEN fg: fgHeader;
	[] ← nextFilePage[];
	nw ← StringDefs.WordsForString[sourceFile.length]-SIZE[StringBody];
	fg.offset ← SIZE[FGHeader] + nw;
	fg.length ← LENGTH[dataPtr.fgTable];
	fg.sourceFile ← StringBody[
			length: sourceFile.length,
			maxlength: sourceFile.length,
			text: -- written separately -- ];
	WriteObjectWords[@fg, SIZE[FGHeader]];
	WriteObjectWords[@sourceFile.text, nw];
	WriteObjectWords[BASE[dataPtr.fgTable], LENGTH[dataPtr.fgTable]*SIZE[FGTEntry]];
	SystemDefs.FreeSegment[BASE[dataPtr.fgTable]];
	END;
    RETURN
    END;

  EndObjectFile: PUBLIC PROCEDURE [success: BOOLEAN] =
    BEGIN  OPEN StreamDefs;
    saveIndex: StreamIndex = GetIndex[stream];
    zero: CARDINAL ← 0;
    IF ~success
      THEN
	BEGIN  -- invalidate bcd
	SetIndex[stream, [0, 0]];  [] ← WriteBlock[stream, @zero, 1];
	END;
    SetIndex[stream, dataPtr.fixupLoc];
    [] ← WriteBlock[stream, @dataPtr.codeSeg, SIZE[BcdDefs.SGRecord]];
    [] ← WriteBlock[stream, @dataPtr.symSeg, SIZE[BcdDefs.SGRecord]];
    [] ← WriteBlock[stream, @dataPtr.mtRoot, dataPtr.MTRootSize];
    SetIndex[stream, saveIndex];
    END;

  END.