-- file PGSBcd.mesa
-- last modified by Satterthwaite, November 2, 1982 11:19 am

DIRECTORY
  BcdDefs: TYPE,
  BcdOps: TYPE USING [EXPHandle, NameString],
  Environment: TYPE USING [bytesPerPage, bytesPerWord],
  FileSegment: TYPE USING [Pages],
  FileStream: TYPE USING [FileByteIndex, GetIndex, SetIndex],
  PGSConDefs: TYPE USING [
    objectVersion, outeol, outstring, pgsVersion, resetoutstream, seterrstream,
    sourceName, sourceVersion, warningsLogged, WriteSymbols],
  Spaces: TYPE USING [Node, Free, FreeString, PagesForWords, String],
  Stream: TYPE USING [Handle, PutByte, PutBlock],
  Strings: TYPE USING [String, AppendChar, AppendString],
  TableCommand: TYPE USING [FindInterface, FindItem, BadInterface];

PGSBcd: PROGRAM
    IMPORTS FileStream, PGSConDefs, Spaces, Stream, Strings, TableCommand
    EXPORTS PGSConDefs = {

  StreamIndex: TYPE = FileStream.FileByteIndex;
  bytesPerWord: CARDINAL = Environment.bytesPerWord;
  
 -- BCD construction

  bcdHeader: BcdDefs.BCD;
  module: BcdDefs.MTRecord.direct;
  export: BcdOps.EXPHandle;
  defsFile: BcdDefs.FTRecord;
  codeSeg, symbolSeg: BcdDefs.SGRecord;
  ssb: BcdOps.NameString ← NIL;

  out: Stream.Handle;
  moduleIndex, segIndex: StreamIndex;	-- for fixup
  moduleId: STRING ← [40];

  InitializePackedString: PROC = {
    ssb ← LOOPHOLE[Spaces.String[60]];
    ssb.string.length ← 1; ssb.size[1] ← 0};

  AddName: PROC [n: Strings.String] RETURNS [name: BcdDefs.NameRecord] = {
    IF n = NIL THEN name ← BcdDefs.NullName
    ELSE {
      Strings.AppendChar[@ssb.string, LOOPHOLE[n.length]];
      name ← BcdDefs.NameRecord[ssb.string.length];
      Strings.AppendString[@ssb.string, n]};
    RETURN};

  FillInModule: PROC [name: BcdDefs.NameRecord, altoCode: BOOL] = {
    OPEN BcdDefs;
    module ← MTRecord[
      name: name, namedInstance: FALSE, initial: FALSE,
      file: FTSelf, linkLoc: frame, config: CTNull,
      code: [
	sgi: SGIndex.FIRST, linkspace: FALSE, packed: FALSE,
	offset: 0, length: 0],
      sseg: SGIndex.FIRST+SGRecord.SIZE,
      frameRefs: FALSE, frameType: 0, framesize: 4,
      tableCompiled: TRUE, altoCode: altoCode, long: FALSE,
      residentFrame: FALSE, crossJumped: FALSE, packageable: TRUE,
      gfi: 1, variables: EVNull, ngfi: 1,
      boundsChecks: FALSE, nilChecks: FALSE,
      extension: direct[length: 0, frag: ]];
    codeSeg ← [class: code, file: FTSelf, base: 2, pages: 0, extraPages: 0];
    symbolSeg ← [class: symbols, file: FTNull, base: 0, pages: 0, extraPages: 0]};

  FillInExport: PROC [name: BcdDefs.NameRecord, size, entry: CARDINAL] = {
    export ← Spaces.Node[BcdDefs.EXPRecord.SIZE+size];
    export↑ ← BcdDefs.EXPRecord[
      name: name, size: size, port: interface,
      namedInstance: FALSE, typeExported: FALSE,
      file: BcdDefs.FTIndex.FIRST, links:];
    FOR i: CARDINAL IN [0..size) DO export.links[i] ← BcdDefs.NullLink ENDLOOP;
    export.links[entry] ← BcdDefs.Link[variable[vgfi:1, var:0, vtag:var]]};

  FillInHeader: PROC = {
    OPEN h: bcdHeader;
    -- clear all fields
    LOOPHOLE[bcdHeader, ARRAY [0..BcdDefs.BCD.SIZE) OF CARDINAL] ← ALL[0];
    h.versionIdent ← BcdDefs.VersionID;
    h.version ← PGSConDefs.objectVersion;
    h.creator ← PGSConDefs.pgsVersion;
    h.sourceVersion ← PGSConDefs.sourceVersion;
    h.source ← IF PGSConDefs.sourceName = NIL
		THEN BcdDefs.NullName ELSE AddName[PGSConDefs.sourceName];
    h.nPages ← 1;
    h.nConfigs ← 0;  h.nModules ← 1;
    h.nImports ← 0;  h.nExports ← IF export = NIL THEN 0 ELSE 1;
    h.definitions ← h.repackaged ← h.typeExported ← FALSE;
    h.tableCompiled ← TRUE;
    h.versions ← FALSE;
    h.extended ← TRUE;
    h.spare1 ← TRUE;	-- large eval stack
    h.spare2 ← FALSE;
    h.firstdummy ← 2;  h.nDummies ← 0;
    h.ctOffset ← h.impOffset ← h.ntOffset ← BcdDefs.BCD.SIZE;
    h.ssOffset ← BcdDefs.BCD.SIZE;
    h.ssLimit ← StringBody[ssb.string.length].SIZE;	-- all strings must be entered by now
    h.mtOffset ← h.ssOffset + LOOPHOLE[h.ssLimit, CARDINAL];
    h.mtLimit ← BcdDefs.MTIndex.FIRST + BcdDefs.MTRecord.direct.SIZE;
    h.sgOffset ← h.mtOffset + LOOPHOLE[h.mtLimit, CARDINAL];
    h.sgLimit ← BcdDefs.SGIndex.FIRST + 2*BcdDefs.SGRecord.SIZE;
    IF export # NIL THEN {
      h.ftOffset ← h.sgOffset + LOOPHOLE[h.sgLimit, CARDINAL];
      h.ftLimit ← BcdDefs.FTIndex.FIRST + BcdDefs.FTRecord.SIZE;
      h.expOffset ← h.ftOffset + LOOPHOLE[h.ftLimit, CARDINAL];
      h.expLimit ← BcdDefs.EXPIndex.FIRST + BcdDefs.EXPRecord.SIZE+export.size};
    h.rtPages ← [0, 0]};

  WriteBcd: PROC [out: Stream.Handle] = {
    out.PutBlock[[@bcdHeader, 0, BcdDefs.BCD.SIZE*bytesPerWord]];
    out.PutBlock[[ssb, 0, StringBody[ssb.string.length].SIZE*bytesPerWord]];
    Spaces.FreeString[LOOPHOLE[ssb]];  ssb ← NIL;
    moduleIndex ← FileStream.GetIndex[out];
    out.PutBlock[[@module, 0, BcdDefs.MTRecord.direct.SIZE*bytesPerWord]];
    segIndex ← FileStream.GetIndex[out];
    out.PutBlock[[@codeSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
    out.PutBlock[[@symbolSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
    IF export # NIL THEN {
      out.PutBlock[[@defsFile, 0, BcdDefs.FTRecord.SIZE*bytesPerWord]];
      out.PutBlock[[export, 0, (BcdDefs.EXPRecord.SIZE+export.size)*bytesPerWord]];
      Spaces.Free[export]}};


 -- overall control

  WriteBcdHeader: PUBLIC PROC [
      outStream: Stream.Handle,
      tableId, binaryId: Strings.String,	-- file being written
      interfaceId, fileId: Strings.String,	-- interface being exported
      altoCode: BOOL ← TRUE] = {
    symbols: FileSegment.Pages;
    out ← outStream;  moduleId.length ← 0;
    IF tableId # NIL THEN Strings.AppendString[moduleId, tableId]
    ELSE
      FOR i: CARDINAL IN [0 .. binaryId.length) DO
	IF binaryId[i] = '. THEN EXIT;
	Strings.AppendChar[moduleId, binaryId[i]];
	ENDLOOP;
    InitializePackedString[];
    FillInModule[AddName[moduleId], altoCode];
    -- fill in interface info
    IF interfaceId = NIL THEN export ← NIL
    ELSE {
      dName: BcdDefs.NameRecord = AddName[interfaceId];
      size, entry: CARDINAL;
      [defsFile.version, symbols] ←
	TableCommand.FindInterface[interfaceId, fileId
	 ! TableCommand.BadInterface => {
	    OPEN PGSConDefs;
	    seterrstream[];  outeol[1]; 
	    outstring[id]; outstring[" cannot be opened"L];
	    GO TO fail}];
      defsFile.name ← IF fileId = NIL THEN dName ELSE AddName[fileId];
      [size, entry] ← TableCommand.FindItem[symbols, moduleId
	 ! TableCommand.BadInterface => {
	    OPEN PGSConDefs;
	    seterrstream[];  outeol[1]; 
	    outstring[moduleId]; outstring[" not found"L];
	    GO TO fail}];
      FillInExport[dName, size, entry];
      EXITS
	fail => {
	  OPEN PGSConDefs;
	  outstring[" -- SELF used"L];
	  outeol[2]; resetoutstream[]; warningsLogged ← TRUE;
	  export ← NIL}};
    FillInHeader[]; -- Do this after all strings entered
    WriteBcd[out];
    FileStream.SetIndex[out, Environment.bytesPerPage]};

  FixupBcdHeader: PUBLIC PROC = {
    bytesPerPage: CARDINAL = Environment.bytesPerPage;
    endIndex: StreamIndex ← FileStream.GetIndex[out];
    nBytes: CARDINAL = endIndex - bytesPerPage;
--  IF export # NIL THEN RETURN;	** from ModuleMaker ??
    module.code.length ← nBytes;
    codeSeg.pages ← Spaces.PagesForWords[(nBytes + (bytesPerWord-1))/bytesPerWord];
    IF bcdHeader.nExports = 0 THEN {
      startIndex: StreamIndex;
      symbolBytes: CARDINAL;
      UNTIL (startIndex ← FileStream.GetIndex[out]) MOD bytesPerPage = 0 DO
	out.PutByte[0] ENDLOOP;
      symbolSeg ← [
          class: symbols, file: BcdDefs.FTSelf,
          base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0];
      PGSConDefs.WriteSymbols[out, moduleId];
      endIndex ← FileStream.GetIndex[out];
      symbolBytes ← endIndex-startIndex;
      symbolSeg.pages ←
	Spaces.PagesForWords[(symbolBytes + (bytesPerWord-1))/bytesPerWord]};
    FileStream.SetIndex[out, moduleIndex];
    out.PutBlock[[@module, 0, BcdDefs.MTRecord.direct.SIZE*bytesPerWord]];
    FileStream.SetIndex[out, segIndex];
    out.PutBlock[[@codeSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
    out.PutBlock[[@symbolSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
    FileStream.SetIndex[out, endIndex]};

  }.