-- file PGSControl.Mesa
-- last modified by Satterthwaite, August 29, 1980  1:49 PM

DIRECTORY
  AltoFileDefs: TYPE USING [CFA],
  BcdDefs: TYPE USING [VersionStamp],
  CharIO: TYPE USING [CR, TAB, PutChar, PutString],
  DisplayDefs: TYPE USING [DisplayOn, DisplayOff],
  ImageDefs: TYPE USING [ImageVersion, StopMesa],
  Inline: TYPE USING [BITOR, DIVMOD],
  KeyDefs: TYPE USING [Keys, KeyBits],
  MiscDefs: TYPE USING [CommandLineCFA, DestroyFakeModule],
  PGS1: TYPE USING [Parse],
  PGScondefs: TYPE,
  PGSParseData: TYPE,
  SegmentDefs: TYPE USING [
    Append, DefaultVersion, DestroyFile, FileHandle, FileNameError,
    FileSegmentAddress, FileSegmentHandle, GetFileTimes, InsertFile,
    LockFile, NewFile, OldFileOnly, Read, SwapIn, SwapOut, Unlock,
    UnlockFile, Write],
  StreamDefs: TYPE USING [
    CleanupDiskStream, CreateByteStream, CreateWordStream, GetIndex,
    JumpToFA, ModifyIndex, NewByteStream, NormalizeIndex, ReadBlock,
    SetIndex, StreamError, StreamHandle, StreamIndex, WriteBlock],
  StringDefs: TYPE USING [AppendChar, AppendString, EqualStrings, EquivalentStrings],
  SystemDefs: TYPE USING [
    AllocateHeapNode, AllocatePages, AllocateSegment, FreeHeapNode, FreePages,
    FreeSegment],
  TimeDefs: TYPE USING [AppendDayTime, CurrentDayTime, PackedTime, UnpackDT];

PGSControl: PROGRAM
    IMPORTS
      CharIO, DisplayDefs, ImageDefs, Inline, MiscDefs,
      PGS1, PGScondefs, PGSParseData,
      SegmentDefs, StreamDefs, StringDefs, SystemDefs, TimeDefs
    EXPORTS PGScondefs, PGS1 =
  BEGIN

  eofile, totaltokens, numprod, nextalias: PUBLIC CARDINAL;
  warningslogged: PUBLIC BOOLEAN;
  flags: PUBLIC ARRAY PGScondefs.Options OF BOOLEAN;
  symtab: PUBLIC PGScondefs.Symtab;
  syminfo: PUBLIC PGScondefs.Syminfo;
  aliases: PUBLIC PGScondefs.Aliases;
  tokeninfo: PUBLIC PGScondefs.Tokeninfo;
  prodinfo: PUBLIC PGScondefs.Prodinfo;
  rhschar: PUBLIC PGScondefs.Rhschar;

  slim, tentries, ntentries: PUBLIC CARDINAL;

  bitstrsize: PUBLIC CARDINAL;

  PGSfail: PUBLIC ERROR = CODE;

  outStream: StreamDefs.StreamHandle;

  outeol: PUBLIC PROC [n:CARDINAL] = {
    OPEN CharIO; THROUGH [1..n] DO PutChar[outStream,CR] ENDLOOP};

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

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

  outtab: PUBLIC PROC = {CharIO.PutChar[outStream,CharIO.TAB]};

  signchar: PUBLIC CHARACTER _ '-;

  outnum: PUBLIC PROC [val:INTEGER, cols:CARDINAL] = {
    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: TimeDefs.PackedTime;

  outtime: PUBLIC PROC = {
    OPEN TimeDefs;
    time: STRING = [20];
    AppendDayTime[time, UnpackDT[startTime]];
    time.length _ time.length-3;
    CharIO.PutString[outStream,time]};

-- storage allocation for PGSscan, PGSlalr, PGStab

  AllocateSegment: PUBLIC PROC [nwords:CARDINAL] RETURNS [POINTER] = {
    RETURN[SystemDefs.AllocateSegment[nwords]]};

  FreeSegment: PUBLIC PROC [base:POINTER] = {SystemDefs.FreeSegment[base]};

  AllocateHeapNode: PUBLIC PROC [nwords:CARDINAL] RETURNS [POINTER] = {
    RETURN[SystemDefs.AllocateHeapNode[nwords]]};

  FreeHeapNode: PUBLIC PROC [base:POINTER] = {SystemDefs.FreeHeapNode[base]};


  LongDes:TYPE = PGScondefs.LongDes;
  LongPointer:TYPE = PGScondefs.LongPointer;

  makearray: PUBLIC PROC [length, width:CARDINAL] RETURNS [LongDes] = {
    n: CARDINAL = length*width;
    new: LongPointer _ AllocateSegment[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 _ AllocateSegment[(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;
    FreeSegment[old];
    RETURN [DESCRIPTOR[new, LENGTH[des]+ext]]};


  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

  logstr, sourcestr, outstr, errstr: StreamDefs.StreamHandle;
  tempFile: SegmentDefs.FileHandle;

  sourceName: PUBLIC STRING _ [40];
  sourceVersion: PUBLIC BcdDefs.VersionStamp;
  objectVersion: PUBLIC BcdDefs.VersionStamp;

  rootname: STRING _ [40];
  extension: STRING _ [40];
  binfname: STRING _ [40];
  typename: STRING _ [40];
  modfname: STRING _ [40];
  intfname: STRING _ [40];
 
  CreateTime: PROC [s: StreamDefs.StreamHandle] RETURNS [time: LONG INTEGER] = {
    RETURN [WITH s: s SELECT FROM
      Disk => SegmentDefs.GetFileTimes[s.file].create,
      ENDCASE => 0]};

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

  getstream: PROC [dotstring: STRING] RETURNS [StreamDefs.StreamHandle] = {
    OPEN StringDefs, SegmentDefs;
    fileName: STRING _ [40];
    fileName.length _ 0;
    AppendString[fileName, rootname]; AppendString[fileName, dotstring];
    RETURN [StreamDefs.NewByteStream[fileName, Write+Append]]};

  seterrstream: PUBLIC PROC = {
    IF errstr =  NIL
      THEN { 
	outStream _ errstr _ getstream[".pgslog"L];
	outstring[herald]; outstring[" -- "L]; outstring[rootname]; outstring[".pgslog"L];
	outeol[2]}
      ELSE outStream _ errstr};

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

  cleanupstreams: PUBLIC PROC = {   -- used for checkout
    OPEN StreamDefs;
    IF outstr # NIL THEN CleanupDiskStream[outstr];
    IF errstr # NIL THEN CleanupDiskStream[errstr]};

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

  openwordstream: PUBLIC PROC [scratch: BOOLEAN] = {
    OPEN SegmentDefs;
    outstr _ StreamDefs.CreateWordStream[
      tempFile _ NewFile[binfname,Read+Write+Append,DefaultVersion],
      Write+Append];
    LockFile[tempFile];
    IF ~scratch AND intfname.length # 0
      THEN PGScondefs.WriteBcdHeader[
	outstr,
	binfname,
	IF StringDefs.EqualStrings[intfname,"SELF"L] THEN NIL ELSE intfname,
	alto]};

  closewordstream: PUBLIC PROC = {
    OPEN SegmentDefs;
    closeoutstream[]; UnlockFile[tempFile]; DestroyFile[tempFile]};

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

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

  outblock: PUBLIC PROC [address: POINTER, words: CARDINAL] = {
    [] _ StreamDefs.WriteBlock[outstr, address, words]};


  tB: POINTER TO PACKED ARRAY OF CHARACTER;
  preprocess:BOOLEAN;

  nextbuffer: PUBLIC PROC RETURNS [
      p: POINTER TO PACKED ARRAY OF CHARACTER, c: CARDINAL, last: BOOLEAN] = {
    OPEN PGScondefs;
    words: [0..TextWords];
    bytes: [0..cpw);
    i: CARDINAL;
    words _ StreamDefs.ReadBlock[sourcestr, tB, TextWords];
    bytes _ StreamDefs.GetIndex[sourcestr].byte MOD cpw;
    IF bytes # 0 THEN  words _ words-1;
    i _ words*cpw + bytes;
    IF preprocess
      THEN {
	[] _ StreamDefs.WriteBlock[errstr,tB,words];
	FOR j: CARDINAL IN [words*cpw..i) DO errstr.put[errstr,tB[j]] ENDLOOP};
    RETURN [tB, i, i<TextChars]};

  locateindex: PUBLIC PROC [index: CARDINAL] RETURNS [base: CARDINAL] = {
    OPEN PGScondefs;
    page: CARDINAL;
    page _ index/(pagesize*cpw);
    base _ page*(pagesize*cpw);
    StreamDefs.SetIndex[sourcestr, [page:sourceOrigin.page+page, byte:sourceOrigin.byte]]};

  StreamIndex:TYPE = StreamDefs.StreamIndex;
  
  PrintTextLine: PROC [origin: StreamIndex] RETURNS [start: StreamIndex] = {
    OPEN PGScondefs;
    lineIndex: StreamIndex;
    char: CHARACTER;
    n: [1..100];
    start _ lineIndex _ origin;
    FOR n IN [1..100] UNTIL lineIndex = [0, 0]
      DO lineIndex _ StreamDefs.ModifyIndex[lineIndex, -1];
      StreamDefs.SetIndex[sourcestr, lineIndex];
      IF sourcestr.get[sourcestr] = CR THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    StreamDefs.SetIndex[sourcestr, start];
    FOR n IN [1..100]
      DO char _ sourcestr.get[sourcestr ! StreamDefs.StreamError => EXIT];
      SELECT char FROM
	CR, ControlZ => EXIT;
	ENDCASE => outchar[char,1];
      ENDLOOP;
    outeol[1];  RETURN};

  sourceOrigin: StreamDefs.StreamIndex;

  ErrorContext: PUBLIC PROC [message: STRING, tokenIndex: CARDINAL] = {
    saveIndex: StreamIndex = StreamDefs.GetIndex[sourcestr];
    origin: StreamIndex = StreamDefs.NormalizeIndex[
	[page: sourceOrigin.page, byte: sourceOrigin.byte+tokenIndex]];
    char: CHARACTER;
    seterrstream[];
    StreamDefs.SetIndex[sourcestr, PrintTextLine[origin]];
    UNTIL StreamDefs.GetIndex[sourcestr] = origin
      DO
      char _ sourcestr.get[sourcestr ! StreamDefs.StreamError => EXIT];
      outchar[IF char = CharIO.TAB THEN CharIO.TAB ELSE ' ,1];
      ENDLOOP;
    outstring["^ ["L]; outnum[tokenIndex,1];
    outchar['],1];  outeol[1];  outstring[message];
    StreamDefs.SetIndex[sourcestr, saveIndex]};

  CursorBits: TYPE = ARRAY [0..16) OF WORD;
  Cursor: POINTER TO CursorBits = LOOPHOLE[431B];
  savedCursor: CursorBits;

  PGSCursor: CursorBits = 
   [177777b, 177777b, 0, 0,
    160606b, 111111b, 111010b, 111004b, 161302b, 101101b, 101111b, 100606b,
    0, 0, 177777b, 177777b];
 
  advise: PROC = {
    outstring["Errors or warnings logged"L];  outeol[1];
    IF pause THEN {
      BlankCursor: CursorBits = ALL[0];
      QueryCursor: CursorBits = 
	[2000B, 74000B, 140000B, 12767B, 12525B, 53566B, 111113B, 163100B,
 	 0B, 0B, 154000B, 53520B, 62520B, 53360B, 155440B, 140B];
      savedCursor: CursorBits = Cursor^;
      KeyBits: TYPE = ARRAY [0..SIZE[KeyDefs.KeyBits]-1) OF WORD;
      Keys: POINTER TO KeyBits = LOOPHOLE[KeyDefs.Keys+1];
      savedKeys: KeyBits = Keys^;
      RTC: POINTER TO
	    MACHINE DEPENDENT RECORD [high: [0..4096), low: [0..16)] =
	  LOOPHOLE[430B];
      savedTime: CARDINAL;
      state: {off, on1, on2};
      Cursor^ _ BlankCursor;  state _ off;  savedTime _ RTC.high;
	DO
	IF RTC.high # savedTime
	  THEN {
	    SELECT state FROM
	      off => {Cursor^ _ QueryCursor; state _ on1};
	      on1 => state _ on2;
 	      on2 => {Cursor^ _ BlankCursor; state _ off};
	      ENDCASE;
	    savedTime _ RTC.high};
	IF Keys^ # savedKeys THEN EXIT;
	ENDLOOP;
      Cursor^ _ savedCursor}};

-- processing options

  alto: BOOLEAN _ TRUE;
  pause: BOOLEAN _ TRUE;

-- making an image

  pgsVersion: PUBLIC BcdDefs.VersionStamp;

  tableseghandle: SegmentDefs.FileSegmentHandle;
  herald: STRING _ [50];
  tableseghandle _ MiscDefs.DestroyFakeModule[LOOPHOLE[PGSParseData]].seg;
--ImageDefs.MakeImage["PGS.image"];
  pgsVersion _ LOOPHOLE[ImageDefs.ImageVersion[]];	-- ** bootstrap **
  StringDefs.AppendString[to:herald, from:"Mesa PGS  "];
  TimeDefs.AppendDayTime[herald, TimeDefs.UnpackDT[pgsVersion.time]];
  herald.length _ herald.length - 3;
  
-- * * * * * * HERE IT BEGINS * * * * * *

  BEGIN OPEN SegmentDefs;
  outStream _ logstr _ StreamDefs.NewByteStream["pgs.log"L, Write+Append];
  outstring[herald]; outeol[1];
  END;

  BEGIN OPEN SegmentDefs;
    CR: CHARACTER = CharIO.CR;
    c: CHARACTER;
    ext, ok, scratchexists: BOOLEAN;
    cfa: POINTER TO AltoFileDefs.CFA = MiscDefs.CommandLineCFA[];
    commandStream: StreamDefs.StreamHandle _
	StreamDefs.CreateByteStream[SegmentDefs.InsertFile[@cfa.fp, Read], Read];
    StreamDefs.JumpToFA[commandStream, @cfa.fa];

    sourceName.length _ rootname.length _ extension.length _ 0; ext _ FALSE;
    UNTIL commandStream.endof[commandStream]
      DO
      IF (c_commandStream.get[commandStream]) # '  AND c # CR THEN EXIT;
      ENDLOOP;
    UNTIL commandStream.endof[commandStream] OR c = '  OR c = CR
      DO
      IF c = '/ THEN GO TO Switches;
      StringDefs.AppendChar[sourceName, c];
      IF c = '. THEN ext _ TRUE;
      StringDefs.AppendChar[IF ext THEN extension ELSE rootname, c];
      c _ commandStream.get[commandStream];
      REPEAT
	Switches => {
	  sense: BOOLEAN _ TRUE;
	  UNTIL commandStream.endof[commandStream] OR
		(c_commandStream.get[commandStream]) = '  OR c = CR
	    DO
	    SELECT c FROM
	      '-, '~ =>  sense _ ~sense;
	      'a, 'A =>  {alto _ sense; sense _ TRUE};
	      'p, 'P =>  {pause _ sense; sense _ TRUE};
	      ENDCASE;
	    ENDLOOP};
      ENDLOOP;
    IF sourceName.length = 0 THEN GO TO NoSource;
    IF ~ext THEN StringDefs.AppendString[sourceName, ".Mesa"L];
    outeol[1];  outstring["Process: "L];
    outstring[sourceName];  outeol[1];
    sourcestr _ StreamDefs.CreateByteStream[
		   NewFile[sourceName, Read, OldFileOnly
		     !FileNameError => {
		       outchar[' ,1]; outstring["File Name Error"L]; GO TO NoSource}],
		  Read];
    DisplayDefs.DisplayOff[black];
    savedCursor _ Cursor^;  Cursor^ _ PGSCursor;
    startTime _ TimeDefs.CurrentDayTime[];
    tB _ SystemDefs.AllocatePages[PGScondefs.TextPages];
    warningslogged _ scratchexists _ FALSE;

  binfname.length _ typename.length _ modfname.length _ intfname.length _ 0;
  IF ~ext OR StringDefs.EquivalentStrings[extension, ".Mesa"L] THEN {
    StringDefs.AppendChar[sourceName,'$];
    errstr _ StreamDefs.NewByteStream[sourceName, Write+Append];
    sourceName.length _ sourceName.length-1; --strip $
    tempFile _ NewFile["pgs.scratch"L,Read+Write+Append,DefaultVersion];
    outstr _ StreamDefs.CreateByteStream[tempFile, Write+Append];
    LockFile[tempFile];
    preprocess _ scratchexists _ TRUE;
    outStream _ outstr;
    PGScondefs.Format[binfname,typename,modfname,intfname !PGSfail => GOTO quit];
       -- copies input to sourceName$ (errstr), modified input to pgs.scratch (outstr),
       -- sets up data for printgrammar and optionally the binary and module file names
    outstr.destroy[outstr]; errstr.destroy[errstr]; sourcestr.destroy[sourcestr];

    -- since no rename facility, copy pgs.scratch to sourceName
    sourcestr _ StreamDefs.CreateByteStream[tempFile,Read];
    errstr _ StreamDefs.NewByteStream[sourceName,Write+Append];
    WHILE ~nextbuffer[].last DO NULL ENDLOOP;
    sourceVersion _ [0, 0, CreateTime[errstr]];
    errstr.destroy[errstr]; sourcestr.destroy[sourcestr];

    -- output grammar to pgs.scratch
    outstr _ StreamDefs.CreateByteStream[tempFile,Write+Append];
    outStream _ outstr;
    PGScondefs.PrintGrammar[];
    outstr.destroy[outstr];

    -- connect pgs.scratch to input stream and fix sourceNames
    sourcestr _ StreamDefs.CreateByteStream[tempFile,Read];
    IF modfname.length=0 THEN {
      IF typename.length # 0 THEN StringDefs.AppendString[modfname,typename]
      ELSE {
	StringDefs.AppendString[modfname,rootname];
	StringDefs.AppendString[modfname,"ParseTable"L]}};
    -- derive missing type id (compatibility feature)
    IF typename.length = 0 THEN
      FOR i: CARDINAL IN [0..modfname.length) DO
	IF modfname[i] = '. THEN EXIT;
	StringDefs.AppendChar[typename, modfname[i]];
	ENDLOOP;
    DefaultFileName[modfname,".Mesa"L];
    IF binfname.length=0 THEN {
      StringDefs.AppendString[binfname,rootname];
      StringDefs.AppendString[binfname,"ParseData"L]};
    DefaultFileName[binfname, IF intfname.length=0 THEN ".binary"L ELSE ".bcd"L]}
  ELSE {
    sourceVersion _ [0, 0, CreateTime[sourcestr]];
    StringDefs.AppendString[binfname,rootname];
    StringDefs.AppendString[binfname,".binary"L];
    -- derive type name
      StringDefs.AppendString[typename,rootname];
      StringDefs.AppendString[typename,"ParseTable"L];
    StringDefs.AppendString[modfname,typename];
    StringDefs.AppendString[modfname,".Mesa"L]};

    preprocess _ FALSE;
    outstr _ errstr _ NIL;
    sourceOrigin _ StreamDefs.GetIndex[sourcestr];

-- load table and call first pass here

    BEGIN
    SwapIn[tableseghandle];
    ok _ PGS1.Parse[LOOPHOLE[FileSegmentAddress[tableseghandle]]].nErrors = 0;
    Unlock[tableseghandle]; SwapOut[tableseghandle];
    END;

    SystemDefs.FreePages[tB];
    sourcestr.destroy[sourcestr];  closeoutstream[];
    IF scratchexists THEN {UnlockFile[tempFile]; DestroyFile[tempFile]};

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

    IF ok AND (flags[lists] OR flags[printlalr] OR flags[printlr]) THEN {
      ok _ PGScondefs.lalrgen[ ! PGSfail => {ok _ FALSE; CONTINUE}];
      IF ok AND flags[lists] THEN {
        outstr.destroy[outstr];    -- flush output from lalrgen
        outstr _ StreamDefs.CreateWordStream[tempFile,Read];  -- for reinput
        IF ~PGScondefs.tabgen[] THEN closewordstream[]
        ELSE {
	  IF intfname.length # 0 THEN PGScondefs.FixupBcdHeader[];
	  outstr.destroy[outstr]; -- flush tabgen output
	  outstr _ StreamDefs.NewByteStream[modfname, Write+Append];
	  outStream _ outstr;
	  PGScondefs.outmodule[typename,modfname];
	  outstr.destroy[outstr]}}};

    IF errstr # NIL THEN errstr.destroy[errstr];
    outStream _ logstr;
    IF ~ok OR warningslogged THEN advise[];
    Cursor^ _ savedCursor;  DisplayDefs.DisplayOn[];
    EXITS
    NoSource => NULL;
    quit => {
      outStream _ logstr;
      outeol[1]; outstring["Directives incorrect or out of sequence"L]; outeol[1];
      outstr.destroy[outstr]; UnlockFile[tempFile]; DestroyFile[tempFile]; advise[]};
    END;

  logstr.destroy[logstr];  ImageDefs.StopMesa[];

  END.