-- file PGSControl.mesa
-- last modified by Satterthwaite, June 23, 1982 10:22 am

DIRECTORY
  CharIO: TYPE USING [GetChar, PutChar, PutString],
  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],
  PGS1: TYPE USING [Parse],
  PGSConDefs: TYPE USING [
    ControlZ,
    AcquireTable, bitstrsize, cpw, pageSize,
    FixupBcdHeader, Format, LALRGen, OutModule, PrintGrammar,
    ReleaseTable, TabGen, WriteBcdHeader],
  PGSOps: TYPE USING [PGSPhase],
  PGSParseData: TYPE,
  PGSTypes: TYPE USING [
    Aliases, LongDes, LongPointer, Options, ProdInfo, RhsChar, SymTab, SymInfo, TokenInfo],
  Segments: TYPE USING [ModifyFile],
  Spaces: TYPE USING [FreeWords, Words],
  Stream: TYPE USING [Handle, Delete, GetWord, PutBlock, PutWord],
  Strings: TYPE USING [
    String, SubStringDescriptor,
    AppendChar, AppendString, EqualSubStrings, EquivalentSubStrings],
  Time: TYPE USING [Packed, Append, Current, Unpack],
  TimeStamp: TYPE USING [Stamp];

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

  eofile, 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: CARDINAL] = {
    THROUGH [1..n] DO CharIO.PutChar[outStream,'\n] ENDLOOP};

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

  outstring: PUBLIC PROC [string: Strings.String] = {CharIO.PutString[outStream,string]};

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

  outnum: PUBLIC PROC [val: INTEGER, cols: CARDINAL, 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 CharIO.PutChar[outStream,signChar];
    UNTIL power < 1 DO
      [i,num] ← Inline.DIVMOD[num,power]; CharIO.PutChar[outStream,i+'0];
      power ← power/10;
      ENDLOOP};

  startTime: Time.Packed;

  outtime: PUBLIC PROC = {
    time: STRING = [20];
    Time.Append[time, Time.Unpack[startTime]];
    time.length ← time.length-3;
    CharIO.PutString[outStream,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[(LENGTH[des]+ext)*width];
    old ← BASE[des];
    FOR i IN [0..LENGTH[des]*width) DO (new+i)↑ ← (old+i)↑ ENDLOOP;
    FOR i IN [LENGTH[des]*width..(LENGTH[des]+ext)*width) DO (new+i)↑ ← 0 ENDLOOP;
    IF old # NIL THEN Spaces.FreeWords[old];
    RETURN [DESCRIPTOR[new, LENGTH[des]+ext]]};

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


  orCount: PUBLIC CARDINAL;

  OrBits: PUBLIC PROC [source, sink: LongPointer] = {
    FOR i: CARDINAL IN [0..PGSConDefs.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]]]};

  seterrstream: PUBLIC PROC = {
    IF errstr =  NIL THEN { 
      outStream ← errstr ← getstream[".errlog"L];
      outstring["Mesa PGS of "L];  outtime[];
      outstring[" -- "L]; outstring[rootName]; outstring[".errlog"L];
      outeol[2]}
    ELSE outStream ← errstr};

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

  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]]};

  inword: PUBLIC PROC RETURNS [CARDINAL] = {RETURN[outstr.GetWord[]]};

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

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

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


  inchar: PUBLIC PROC RETURNS [c: CHAR, end: BOOL] = {
    IF (end ← FileStream.EndOf[sourcestr]) THEN c ← '\000
    ELSE c ← CharIO.GetChar[sourcestr];
    RETURN};
    
  LocateIndex: PUBLIC PROC [index: CARDINAL] RETURNS [base: CARDINAL] = {
    OPEN PGSConDefs;
    page: CARDINAL;
    page ← index/(pageSize*cpw);
    base ← page*(pageSize*cpw);
    FileStream.SetIndex[sourcestr, sourceOrigin+index]};

  StreamIndex: TYPE = FileStream.FileByteIndex;
  
  PrintTextLine: PROC [origin: StreamIndex] RETURNS [start: StreamIndex] = {
    lineIndex: StreamIndex;
    char: CHAR;
    n: [1..100];
    start ← lineIndex ← origin;
    FOR n IN [1..100] UNTIL lineIndex = 0 DO
      lineIndex ← lineIndex - 1;
      FileStream.SetIndex[sourcestr, lineIndex];
      IF CharIO.GetChar[sourcestr] = '\n THEN EXIT;
      start ← lineIndex;
      ENDLOOP;
    FileStream.SetIndex[sourcestr, start];
    FOR n IN [1..100] UNTIL FileStream.EndOf[sourcestr] DO
      char ← CharIO.GetChar[sourcestr];
      SELECT char FROM
	'\n, PGSConDefs.ControlZ => EXIT;
	ENDCASE => outchar[char,1];
      ENDLOOP;
    outeol[1];  RETURN};

  sourceOrigin: StreamIndex;

  ErrorContext: PUBLIC PROC [message: STRING, tokenIndex: CARDINAL] = {
    saveIndex: StreamIndex = FileStream.GetIndex[sourcestr];
    origin: StreamIndex = sourceOrigin + tokenIndex;
    char: CHAR;
    seterrstream[];
    FileStream.SetIndex[sourcestr, PrintTextLine[origin]];
    UNTIL FileStream.GetIndex[sourcestr] = origin OR FileStream.EndOf[sourcestr] DO
      char ← CharIO.GetChar[sourcestr];
      outchar[IF char = '\n THEN '\n ELSE ' ,1];
      ENDLOOP;
    outstring["↑ ["L]; outnum[tokenIndex,1];
    outchar['],1];  outeol[1];  outstring[message];
    FileStream.SetIndex[sourcestr, saveIndex]};

-- 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-0c, host: 'c-0c, time: 7*200000b+11];

-- * * * * * * 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;
    tableBase: LONG POINTER ← NIL;
    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[];
	  outeol[1]; outstring["Directives incorrect or out of sequence"L]; outeol[1];
	  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[];
    tableBase ← PGSConDefs.AcquireTable[];
    success ← PGS1.Parse[tableBase].nErrors = 0;
    PGSConDefs.ReleaseTable[];  tableBase ← NIL;

    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}};

  }.