-- file PGSBcd.Mesa
-- last modified by Satterthwaite, August 26, 1980  1:21 PM

DIRECTORY
  AltoDefs: TYPE USING [BytesPerPage, BytesPerWord],
  BcdDefs: TYPE ,
  MiscDefs: TYPE USING [GetNetworkNumber, Zero],
  OsStaticDefs: TYPE USING [OsStatics],
  PGScondefs: TYPE USING [
    objectVersion, outeol, outstring, pgsVersion,
    resetoutstream, seterrstream, sourceVersion, warningslogged,
    WriteSymbols],
  SegmentDefs: TYPE USING [FileSegmentHandle],
  StreamDefs: TYPE USING [StreamHandle, StreamIndex, GetIndex, SetIndex, WriteBlock],
  StringDefs: TYPE USING [AppendChar, AppendString, WordsForString],
  SystemDefs: TYPE USING [AllocateHeapNode, FreeHeapNode, PagesForWords],
  TableCommand: TYPE USING [FindInterface, FindItem, BadInterface],
  TimeDefs: TYPE USING [CurrentDayTime];

PGSBcd: PROGRAM
    IMPORTS
      MiscDefs, PGScondefs, StreamDefs, StringDefs, SystemDefs,
      TableCommand, TimeDefs
    EXPORTS PGScondefs =
  BEGIN

 -- BCD construction

  bcdHeader: BcdDefs.BCD;
  module: BcdDefs.MTRecord;
  export: POINTER TO BcdDefs.EXPRecord;
  defsFile: BcdDefs.FTRecord;
  codeSeg, symbolSeg: BcdDefs.SGRecord;
  ssbString: STRING ← [60];
  ssb: POINTER TO BcdDefs.PackedString ← LOOPHOLE[ssbString];
  dName: BcdDefs.NameRecord;

  out: StreamDefs.StreamHandle;
  moduleIndex, segIndex: StreamDefs.StreamIndex;	-- for fixup
  
  InitializePackedString: PROC = {ssb.string.length ← 1; ssb.size[1] ← 0};

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

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

  FillInExport: PROC [name: BcdDefs.NameRecord, size, entry: CARDINAL] = {
    export ← SystemDefs.AllocateHeapNode[SIZE[BcdDefs.EXPRecord]+size];
    MiscDefs.Zero[export, SIZE[BcdDefs.EXPRecord]+size];	-- clear all fields
    export↑ ← BcdDefs.EXPRecord[
      name: name, size: size, port: interface,
      namedInstance: FALSE, typeExported: FALSE,
      file: FIRST[BcdDefs.FTIndex], links:];
    export.links[entry] ← BcdDefs.Link[variable[vgfi:1, var:0, vtag:var]]};

  FillInHeader: PROC = {
    OPEN bcdHeader;
    MiscDefs.Zero[@bcdHeader, SIZE[BcdDefs.BCD]];	-- clear all fields
    versionIdent ← BcdDefs.VersionID;
    version ← PGScondefs.objectVersion;
    sourceVersion ← PGScondefs.sourceVersion;
    creator ← PGScondefs.pgsVersion;
    nPages ← 1;
    nConfigs ← 0;  nModules ← 1;
    nImports ← 0;  nExports ← IF export = NIL THEN 0 ELSE 1;
    definitions ← repackaged ← typeExported ← FALSE;  tableCompiled ← TRUE;
    versions ← extended ← FALSE;
    firstdummy ← 2;  nDummies ← 0;
    ctOffset ← impOffset ← ntOffset ← SIZE[BcdDefs.BCD];
    ssOffset ← SIZE[BcdDefs.BCD];
    ssLimit ← StringDefs.WordsForString[ssb.string.length];
    mtOffset ← ssOffset + LOOPHOLE[ssLimit, CARDINAL];
    mtLimit ← LOOPHOLE[SIZE[BcdDefs.MTRecord]];
    sgOffset ← mtOffset + LOOPHOLE[mtLimit, CARDINAL];
    sgLimit ← LOOPHOLE[2*SIZE[BcdDefs.SGRecord]];
    IF export # NIL
      THEN {
	ftOffset ← sgOffset + LOOPHOLE[sgLimit, CARDINAL];
	ftLimit ← LOOPHOLE[SIZE[BcdDefs.FTRecord]];
	expOffset ← ftOffset + LOOPHOLE[ftLimit, CARDINAL];
	expLimit ← LOOPHOLE[SIZE[BcdDefs.EXPRecord]+export.size]};
    source ← BcdDefs.NullName};

  WriteBcd: PROC [out: StreamDefs.StreamHandle] = {
    OPEN StreamDefs;
    [] ← WriteBlock[out, @bcdHeader, SIZE[BcdDefs.BCD]];
    [] ← WriteBlock[out, ssb, StringDefs.WordsForString[ssb.string.length]];
    moduleIndex ← StreamDefs.GetIndex[out];
    [] ← WriteBlock[out, @module, SIZE[BcdDefs.MTRecord]];
    segIndex ← StreamDefs.GetIndex[out];
    [] ← WriteBlock[out, @codeSeg, SIZE[BcdDefs.SGRecord]];
    [] ← WriteBlock[out, @symbolSeg, SIZE[BcdDefs.SGRecord]];
    IF export # NIL
      THEN {
	[] ← WriteBlock[out, @defsFile, SIZE[BcdDefs.FTRecord]];
	[] ← WriteBlock[out, export, SIZE[BcdDefs.EXPRecord]+export.size];
	SystemDefs.FreeHeapNode[export]}};


 -- overall control

  moduleId: STRING ← [40];

  WriteBcdHeader: PUBLIC PROC [
      outStream: StreamDefs.StreamHandle,
      binaryId, interfaceId: STRING,
      altoCode: BOOLEAN ← TRUE] = {
    symbolSeg: SegmentDefs.FileSegmentHandle;
    out ← outStream;  moduleId.length ← 0;
    FOR i: CARDINAL IN [0 .. binaryId.length)
      DO
      IF binaryId[i] = '. THEN EXIT;
      StringDefs.AppendChar[moduleId, binaryId[i]];
      ENDLOOP;
    PGScondefs.objectVersion ← BcdDefs.VersionStamp[
	time: LOOPHOLE[TimeDefs.CurrentDayTime[]],
	net: MiscDefs.GetNetworkNumber[],
	host: OsStaticDefs.OsStatics.SerialNumber];
    InitializePackedString[];
    dName ← AddName[interfaceId];
    FillInModule[AddName[moduleId], 0, altoCode];
    -- fill in interface info
    IF interfaceId = NIL
      THEN export ← NIL
      ELSE {
	size, entry: CARDINAL;
	[defsFile.version, symbolSeg] ←
	  TableCommand.FindInterface[interfaceId
	   ! TableCommand.BadInterface => {
	      OPEN PGScondefs;
	      seterrstream[];  outeol[1]; 
	      outstring[id]; outstring[" cannot be opened -- SELF used"L];
	      outeol[2]; resetoutstream[];  warningslogged ← TRUE;
	      GO TO fail}];
	defsFile.name ← dName;
	[size, entry] ← TableCommand.FindItem[symbolSeg, moduleId];
	FillInExport[dName, size, entry];
	EXITS
	  fail => export ← NIL};
    FillInHeader[]; -- Do this after all strings entered
    WriteBcd[out];
    StreamDefs.SetIndex[out, [1, 0]]};

  FixupBcdHeader: PUBLIC PROC = {
    OPEN AltoDefs;
    endIndex: StreamDefs.StreamIndex ← StreamDefs.GetIndex[out];
    nBytes: CARDINAL = (endIndex.page-1)*BytesPerPage + endIndex.byte;
    module.code.length ← nBytes;
    codeSeg.pages ←
      SystemDefs.PagesForWords[(nBytes + (BytesPerWord-1))/BytesPerWord];
    IF bcdHeader.nExports = 0
      THEN {
	startIndex: StreamDefs.StreamIndex;
	symbolBytes: CARDINAL;
	UNTIL (startIndex ← StreamDefs.GetIndex[out]).byte = 0 DO out.put[out, 0] ENDLOOP;
	symbolSeg ← [
            class: symbols, file: BcdDefs.FTSelf,
            base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0];
	PGScondefs.WriteSymbols[out, moduleId];
	endIndex ← StreamDefs.GetIndex[out];
	symbolBytes ← (endIndex.page-startIndex.page)*BytesPerPage + endIndex.byte;
	symbolSeg.pages ←
	  SystemDefs.PagesForWords[(symbolBytes + (BytesPerWord-1))/BytesPerWord]};
    StreamDefs.SetIndex[out, moduleIndex];
    [] ← StreamDefs.WriteBlock[out, @module, SIZE[BcdDefs.MTRecord]];
    StreamDefs.SetIndex[out, segIndex];
    [] ← StreamDefs.WriteBlock[out, @codeSeg, SIZE[BcdDefs.SGRecord]];
    [] ← StreamDefs.WriteBlock[out, @symbolSeg, SIZE[BcdDefs.SGRecord]];
    StreamDefs.SetIndex[out, endIndex]};

  END.