-- file PGSControl.mesa
-- last modified by Satterthwaite, January 10, 1983 4:17 pm

DIRECTORY
  CommandUtil: TYPE USING [
    PairList, CopyString, FreeString, KeyValue, ListLength, SetExtension],
  Inline: TYPE USING [BITOR, DIVMOD],
  Environment: TYPE USING [bytesPerWord],
  File: TYPE USING [
    Capability, nullCapability, Permissions, delete, grow, read, shrink, write,
    LimitPermissions],
  FileStream: TYPE USING [
    FileByteIndex, Create, EndOf, GetIndex, GetLeaderProperties, SetIndex],
  OSMiscOps: TYPE USING [
    FileError, FindFile, GenerateUniqueId--, ImageId--, RenameFile],
  P1: TYPE USING [InstallParseTable, Parse],
  PGSConDefs: TYPE USING [
    FixupBcdHeader, Format, LALRGen, OutModule, PrintGrammar,
    TabGen, WriteBcdHeader, zone],
  PGSOps: TYPE USING [PGSPhase],
  PGSParseData: TYPE,
  PGSTypes: TYPE USING [
    Aliases, LongDes, LongPointer, Options, ProdInfo, RhsChar, SymTab, SymInfo, TokenInfo],
  Runtime USING [GetTableBase],
--Segments: TYPE USING [ModifyFile],
  Spaces: TYPE USING [FreeWords, Words],
  Stream: TYPE USING [Handle, Delete, GetChar, GetWord, PutBlock, PutChar, PutWord],
  Strings: TYPE USING [
    String, SubStringDescriptor,
    AppendChar, AppendString, EqualSubStrings, EquivalentSubStrings],
  Time: TYPE USING [Packed, Append, Current, Unpack],
  TimeStamp: TYPE USING [Stamp];

PGSControl: PROGRAM
    IMPORTS
      CommandUtil, File, FileStream, Inline, OSMiscOps, P1,
      PGSConDefs, PGSParseData, Runtime, --Segments,-- Spaces, Stream, Strings, Time
    EXPORTS PGSConDefs, PGSOps = {

  eofMark: PUBLIC CARDINAL;
  totalTokens, numProd, numRules, nextAlias: PUBLIC CARDINAL;
  warningsLogged: PUBLIC BOOL;
  flags: PUBLIC ARRAY PGSTypes.Options OF BOOL;
  symTab: PUBLIC PGSTypes.SymTab;
  symInfo: PUBLIC PGSTypes.SymInfo;
  aliases: PUBLIC PGSTypes.Aliases;
  tokenInfo: PUBLIC PGSTypes.TokenInfo;
  prodInfo: PUBLIC PGSTypes.ProdInfo;
  rhsChar: PUBLIC PGSTypes.RhsChar;

  sLim, tEntries, ntEntries: PUBLIC CARDINAL;

  bitstrSize: PUBLIC CARDINAL;

  PGSFail: PUBLIC ERROR = CODE;

  outStream: Stream.Handle;

  outeol: PUBLIC PROC [n: INTEGER] = {
    THROUGH [1..n] DO outStream.PutChar['\n] ENDLOOP};

  outchar: PUBLIC PROC [c: CHAR, n: INTEGER] = {
    THROUGH [1..n] DO outStream.PutChar[c] ENDLOOP};

  outstring: PUBLIC PROC [string: Strings.String] = {
    FOR i: CARDINAL IN [0..string.length) DO outStream.PutChar[string[i]] ENDLOOP};

  outtab: PUBLIC PROC = {outStream.PutChar['\t]};

  outnum: PUBLIC PROC [val: INTEGER, cols: NAT, signChar: CHAR_'-] = {
    i: CARDINAL;
    power, digits: CARDINAL _ 1;
    num: CARDINAL _ ABS[val];
    sign: CARDINAL = IF val<0 THEN 1 ELSE 0;
    WHILE (i_power*10)<=num DO power _ i; digits _ digits+1 ENDLOOP;
    outchar[' , INTEGER[cols-digits-sign]];
    IF sign#0 THEN outStream.PutChar[signChar];
    UNTIL power < 1 DO
      [i,num] _ Inline.DIVMOD[num,power]; outStream.PutChar[VAL['0.ORD+i]];
      power _ power/10;
      ENDLOOP};

  startTime: Time.Packed;

  outtime: PUBLIC PROC = {
    time: STRING = [20];
    Time.Append[time, Time.Unpack[startTime]];
    time.length _ time.length-3;
    outstring[time]};

-- storage allocation for PGSscan, PGSlalr, PGStab

  LongDes: TYPE = PGSTypes.LongDes;
  LongPointer: TYPE = PGSTypes.LongPointer;

  MakeArray: PUBLIC PROC [length, width: CARDINAL] RETURNS [LongDes] = {
    n: CARDINAL = length*width;
    new: LongPointer = Spaces.Words[n];
    FOR i: CARDINAL IN [0..n) DO (new+i)^ _ 0 ENDLOOP;
    RETURN [DESCRIPTOR[new, length]]};

  Expand: PUBLIC PROC [des: LongDes, width, ext: CARDINAL] RETURNS [LongDes] = {
    new, old: LongPointer;
    i: CARDINAL;
    new _ Spaces.Words[(des.LENGTH+ext)*width];
    old _ des.BASE;
    FOR i IN [0..des.LENGTH*width) DO (new+i)^ _ (old+i)^ ENDLOOP;
    FOR i IN [des.LENGTH*width..(des.LENGTH+ext)*width) DO (new+i)^ _ 0 ENDLOOP;
    IF old # NIL THEN Spaces.FreeWords[old];
    RETURN [DESCRIPTOR[new, des.LENGTH+ext]]};

  FreeArray: PUBLIC PROC [des: LongDes] = {
    base: LongPointer _ des.BASE;
    IF base # NIL THEN Spaces.FreeWords[base]};


  orCount: PUBLIC CARDINAL;

  OrBits: PUBLIC PROC [source, sink: LongPointer] = {
    FOR i: CARDINAL IN [0..bitstrSize) DO 
      (sink+i)^ _ Inline.BITOR[(sink+i)^,(source+i)^] ENDLOOP;
    orCount _ orCount+1};


-- streams and files

  writeAccess: File.Permissions = File.write+File.grow+File.shrink+File.delete;
  
  sourcestr, outstr, errstr: Stream.Handle _ NIL;
  inputFile, tempFile: File.Capability;

  sourceName: PUBLIC Strings.String _ NIL;
  sourceVersion: PUBLIC TimeStamp.Stamp;
  objectName: Strings.String _ NIL;
  objectVersion: PUBLIC TimeStamp.Stamp;
  defsName: Strings.String _ NIL;
  gfName: Strings.String _ NIL;

  CreateTime: PROC [s: Stream.Handle] RETURNS [time: Time.Packed] = {
    RETURN [FileStream.GetLeaderProperties[s].create]};

  DefaultFileName: PROC [name, defaultExtension: Strings.String] = {
    FOR i: CARDINAL IN [0..name.length) DO IF name[i] = '. THEN RETURN ENDLOOP;
    Strings.AppendString[name, defaultExtension]};

  getstream: PROC [dotstring: Strings.String] RETURNS [Stream.Handle] = {
    fileName: STRING _ [40];
    fileName.length _ 0;
    Strings.AppendString[fileName, rootName]; Strings.AppendString[fileName, dotstring];
    RETURN [FileStream.Create[OSMiscOps.FindFile[fileName, write]]]};

  geterrstream: PROC RETURNS [Stream.Handle] = {
    IF errstr = NIL THEN { 
      savestr: Stream.Handle = outStream;
      outStream _ errstr _ getstream[".errlog"L];
      outstring["Mesa PGS of "L];  outtime[];
      outstring[" -- "L]; outstring[rootName]; outstring[".errlog\n\n"L];
      outStream _ savestr};
    RETURN [errstr]};

  closeerrstream: PROC = {
    IF errstr # NIL THEN {Stream.Delete[errstr]; errstr _ NIL}};

  seterrstream: PUBLIC PROC = {
    outStream _ geterrstream[]};

  setoutstream: PUBLIC PROC [dotstring: Strings.String] = {
    outStream _ outstr _ getstream[dotstring]};
 
  resetoutstream: PUBLIC PROC = {outStream _ outstr};

  closeoutstream: PUBLIC PROC = {
    IF outstr # NIL THEN {Stream.Delete[outstr]; outstr _ NIL}};

  cleanupstreams: PUBLIC PROC = {NULL};   -- used for checkout


  openwordstream: PUBLIC PROC [scratch: BOOL] = {
    tempFile _ OSMiscOps.FindFile[objectName, both];
    outstr _ FileStream.Create[tempFile.LimitPermissions[writeAccess]]};

  closewordstream: PUBLIC PROC = {
    closeoutstream[]; tempFile _ File.nullCapability};


 -- message logging
 
  Logger: PROC [proc: PROC [log: Stream.Handle]] = {
    seterrstream[]; proc[outStream]; resetoutstream[]};
 

 -- I/O operations
 
  StreamIndex: TYPE = FileStream.FileByteIndex;
  sourceOrigin: StreamIndex;

  inchar: PUBLIC PROC RETURNS [c: CHAR, end: BOOL] = {
    IF (end _ FileStream.EndOf[sourcestr]) THEN c _ '\000
    ELSE c _ sourcestr.GetChar[];
    RETURN};
    
  getindex: PUBLIC PROC RETURNS [CARDINAL] = {
    RETURN [FileStream.GetIndex[sourcestr]-sourceOrigin]};
    
  setindex: PUBLIC PROC [index: CARDINAL] = {
    FileStream.SetIndex[sourcestr, sourceOrigin+index]};
  
  inword: PUBLIC PROC RETURNS [CARDINAL] = {RETURN[outstr.GetWord[]]};

  outword: PUBLIC PROC [n: CARDINAL] = {outstr.PutWord[n]};

  outblock: PUBLIC PROC [address: LongPointer, words: CARDINAL] = {
    outstr.PutBlock[[address, 0, words*Environment.bytesPerWord]]};


-- processing options

  rootName: Strings.String _ NIL;

  SetRoot: PROC [s: Strings.String] = {
    root: STRING _ [40];
    FOR i: CARDINAL IN [0..s.length) DO
      IF s[i] = '. THEN EXIT;
      Strings.AppendChar[root, s[i]]
      ENDLOOP;
    rootName _ CommandUtil.CopyString[root]};

  SetFileName: PROC [fileName, default, extension: Strings.String]
      RETURNS [Strings.String] = {
    root: Strings.String = IF fileName = NIL
      THEN CommandUtil.CopyString[default, 2+extension.length]
      ELSE fileName;
    RETURN [CommandUtil.SetExtension[root, extension]]};

  TestExtension: PROC [fileName, extension: Strings.String] RETURNS [BOOL] = {
    t: STRING _ [40];
    i: CARDINAL _ 0;
    ext: Strings.SubStringDescriptor _ [extension, 0, extension.length];
    d: Strings.SubStringDescriptor;
    UNTIL i >= fileName.length OR fileName[i] = '. DO i _ i+1 ENDLOOP;
    i _ i+1;
    UNTIL i >= fileName.length OR fileName[i] = '. DO
      Strings.AppendChar[t, fileName[i]]; i _ i+1 ENDLOOP;
    d _ [t, 0, t.length];
    RETURN [Strings.EquivalentSubStrings[@d, @ext]]};

  KeyVal: PROC [list: CommandUtil.PairList, key: Strings.String, delete: BOOL _ TRUE]
      RETURNS [Strings.String] = {
    s: Strings.SubStringDescriptor _ [base: key, offset: 0, length: key.length];
    RETURN [CommandUtil.KeyValue[@s, list, delete]]};

  pgsVersion: PUBLIC TimeStamp.Stamp _ [net: 'c.ORD, host: 'p.ORD, time: 000F0003h];

-- * * * * * * HERE IT BEGINS * * * * * *

  NoSource: PUBLIC ERROR = CODE;
  LockedSource: PUBLIC ERROR = CODE;
  BadSemantics: PUBLIC ERROR = CODE;

  Generate: PUBLIC PROC [
	source: Strings.String,
	args, results: CommandUtil.PairList,
	switches: Strings.String,
	startPhase: PROC [PGSOps.PGSPhase] RETURNS [BOOL],
	princOps: BOOL]
      RETURNS [success, warnings: BOOL] = {
    alto: BOOL _ ~princOps;
    long: BOOL_ princOps;
    printGrammar: BOOL _ TRUE;
    bcd: BOOL _ FALSE;
    scratchExists: BOOL _ FALSE;
    typeId: STRING = [40];
    tableId: STRING = [40];
    exportId: STRING = [40];
    sourceName _ CommandUtil.CopyString[source, 2+("mesa"L).length];
    objectName _ gfName _ NIL;
    -- collect output specifications
      BEGIN
      nR: CARDINAL _ CommandUtil.ListLength[results];
      IF (defsName _ KeyVal[results, "defs"L]) # NIL THEN nR _ nR - 1;
      SELECT TRUE FROM
	(objectName _ KeyVal[results, "bcd"L]) # NIL => {bcd _ TRUE; nR _ nR - 1};
	(objectName _ KeyVal[results, "binary"L]) # NIL => {bcd _ FALSE; nR _ nR - 1};
	ENDCASE;
      IF (gfName _ KeyVal[results, "grammar"L]) # NIL THEN nR _ nR - 1;
      IF nR # 0 THEN GO TO badSemantics;
      END;
    SetRoot[IF objectName # NIL THEN objectName ELSE sourceName];
    IF switches # NIL THEN {
      sense: BOOL _ TRUE;
      FOR i: CARDINAL IN [0 .. switches.length) DO
	SELECT switches[i] FROM
	  '-, '~ => sense _ ~sense;
	  'a, 'A => {alto _ sense; sense _ TRUE};
	  'l, 'L => {long _ sense; sense _ TRUE};
	  'g, 'G => {printGrammar _ sense; sense _ TRUE};
	  ENDCASE;
	ENDLOOP};

    startTime _ Time.Current[];
    warningsLogged _ warnings _ FALSE;
    sourceName _ CommandUtil.SetExtension[sourceName, "mesa"L];
    IF sourceName[sourceName.length-1] = '. THEN sourceName.length _ sourceName.length-1;

    IF TestExtension[sourceName, "mesa"L] THEN {
      t: STRING _ [40];        -- String vs. STRING resolution
      copyName: Strings.String;
      sourceFile: File.Capability;
      [] _ startPhase[$format];
      Strings.AppendString[t, sourceName];
--    IF ~Segments.ModifyFile[t] THEN GO TO lockedSource;
      sourceFile _ OSMiscOps.FindFile[sourceName, read
			! OSMiscOps.FileError => {GO TO noSource}];
      copyName _ CommandUtil.CopyString[sourceName, 1]; Strings.AppendChar[copyName, '$];
      OSMiscOps.RenameFile[newName: copyName, oldName: sourceName];
      copyName _ CommandUtil.FreeString[copyName];
      sourcestr _ FileStream.Create[sourceFile.LimitPermissions[File.read]];
      tempFile _ OSMiscOps.FindFile[sourceName, both];
      outstr _ FileStream.Create[tempFile.LimitPermissions[writeAccess]];
      outStream _ outstr;
      tableId.length _ typeId.length _ exportId.length _ 0;
      PGSConDefs.Format[tableId, typeId, exportId ! PGSFail => {GOTO formatFailed}];
        -- input from sourceName$ (errstr), modified input to sourceName (outstr),
        -- sets up data for PrintGrammar
      sourceVersion _ [0, 0, CreateTime[outstr]];
      closeoutstream[];  Stream.Delete[sourcestr]; sourcestr _ NIL;
      tempFile _ sourceFile _ File.nullCapability;

     -- output grammar to summary file (or scratch)
      gfName _ IF printGrammar
        THEN SetFileName[gfName, IF tableId.length # 0 THEN tableId ELSE rootName, "grammar"L]
	ELSE CommandUtil.CopyString["pgs.scratch$"L];
      inputFile _ OSMiscOps.FindFile[gfName, both];
      gfName _ CommandUtil.FreeString[gfName];
      outstr _ FileStream.Create[inputFile.LimitPermissions[writeAccess]];
      outStream _ outstr;
      PGSConDefs.PrintGrammar[];
      closeoutstream[];
      IF ~printGrammar THEN scratchExists _ TRUE;

     -- connect pgs.scratch to input stream and fix sourceNames
      sourcestr _ FileStream.Create[inputFile.LimitPermissions[File.read]];
     -- derive missing type id (compatibility feature)
      IF typeId.length = 0 AND defsName # NIL THEN
	FOR i: CARDINAL IN [0..defsName.length) DO
	  IF defsName[i] = '. THEN EXIT;
	  Strings.AppendChar[typeId, defsName[i]];
	  ENDLOOP;
      IF objectName = NIL THEN {
	bcd _ TRUE;
	IF tableId.length # 0 THEN
	  objectName _ CommandUtil.CopyString[tableId, 2+("bcd"L).length]
	ELSE {
	  objectName _ CommandUtil.CopyString[rootName, ("PGSTable"L).length];
	  Strings.AppendString[objectName, "PGSTable"L]}}
      EXITS
	formatFailed => {
	  closeoutstream[];  closeerrstream[];
	  seterrstream[];
	  outstring["\nDirectives incorrect or out of sequence\n"L];
	  tempFile _ File.nullCapability;
	  GO TO fail}}
    ELSE {
      sourcestr _ FileStream.Create[
		    OSMiscOps.FindFile[sourceName, read
			! OSMiscOps.FileError => {GO TO noSource}]];
      sourceVersion _ [0, 0, CreateTime[sourcestr]];
      IF objectName = NIL THEN
	objectName _ CommandUtil.CopyString[rootName, 2+("binary"L).length];
    -- derive type name
      Strings.AppendString[typeId, rootName];
      Strings.AppendString[typeId, "PGSTableType"L]};

    IF defsName = NIL THEN {
      IF typeId.length # 0 THEN
	defsName _ CommandUtil.CopyString[typeId, 2+("mesa"L).length]
      ELSE {
	defsName _ CommandUtil.CopyString[rootName, ("PGSTableType"L).length];
	Strings.AppendString[defsName,"PGSTableType"L]}};
    defsName _ CommandUtil.SetExtension[defsName, "mesa"L];
    objectName _ CommandUtil.SetExtension[objectName,
       IF bcd THEN "bcd"L ELSE "binary"L];
    outstr _ errstr _ NIL;
    sourceOrigin _ FileStream.GetIndex[sourcestr];

-- load table and call first pass here

    [] _ startPhase[$lalr];
    objectVersion _ OSMiscOps.GenerateUniqueId[];
    success _ P1.Parse[sourcestr, PGSConDefs.zone, Logger].nErrors = 0;

    Stream.Delete[sourcestr];  closeoutstream[];
    IF scratchExists THEN inputFile _ File.nullCapability;

  -- now if no errors generate the tables then package them on request

    IF success AND (flags[lists] OR flags[printLALR] OR flags[printLR]) THEN {
      success _ PGSConDefs.LALRGen[ ! PGSFail => {success _ FALSE; CONTINUE}];
      IF success AND flags[lists] THEN {

	InitBcd: PROC = {
	  self: Strings.SubStringDescriptor _ ["SELF"L, 0, ("SELF"L).length];
	  export: Strings.SubStringDescriptor _ [exportId, 0, exportId.length];
	  PGSConDefs.WriteBcdHeader[
	    outstr,
	    tableId,
	    objectName,
	    IF Strings.EqualSubStrings[@export,@self] THEN NIL ELSE exportId,
	    KeyVal[args, exportId, FALSE],
	    alto]};

        closeoutstream[];    -- flush output from LALRGen
        outstr _ FileStream.Create[tempFile.LimitPermissions[File.read]];  -- for reinput
        success _ IF exportId.length # 0
		THEN PGSConDefs.TabGen[prefix:InitBcd, suffix:PGSConDefs.FixupBcdHeader]
		ELSE PGSConDefs.TabGen[NIL, NIL];
        IF ~success THEN closewordstream[]
        ELSE {
	  closeoutstream[]; -- flush tabgen output
	  outstr _ FileStream.Create[OSMiscOps.FindFile[defsName, write]];
	  outStream _ outstr;
	  PGSConDefs.OutModule[typeId, defsName, long];
	  closeoutstream[]}}};
    closeerrstream[];
    warnings _ warningsLogged;
    rootName _ CommandUtil.FreeString[rootName];
    sourceName _ CommandUtil.FreeString[sourceName];
    EXITS
      badSemantics => ERROR BadSemantics;
      noSource => ERROR NoSource;
--    lockedSource => ERROR LockedSource;
      fail => {
	rootName _ CommandUtil.FreeString[rootName];
	sourceName _ CommandUtil.FreeString[sourceName];
	closeerrstream[]; success _ FALSE}};

 -- start code
 
  P1.InstallParseTable[Runtime.GetTableBase[LOOPHOLE[PGSParseData]]];
  
  }.