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