-- 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.