-- OpDefsGenerator.mesa
-- last edited by Johnsson, November 2, 1978  10:22 AM
-- last edited by Satterthwaite, May 12, 1983 2:06 pm

DIRECTORY
  DCSFileTypes: TYPE USING [tLeaderPage],
  Directory: TYPE USING [CreateFile, Error, Lookup, UpdateDates, ignore],
  File: TYPE USING [Capability, Permissions, delete, grow, read, shrink, write],
  Exec: TYPE USING [w],
  FileStream: TYPE USING [Create, EndOf, GetIndex, SetIndex],
  Format: TYPE USING [NumberFormat, Number, StringProc],
  Heap: TYPE USING [systemZone],
  LongString: TYPE USING [StringToNumber, StringToOctal],
  Stream: TYPE USING [Handle, Delete, GetChar, PutChar, PutWord],
  Strings: TYPE USING [String, AppendChar, AppendString],
  Time: TYPE USING [AppendCurrent],
  TTY: TYPE USING [Handle, GetChar, GetID, PutChar, PutLine, PutString];

OpDefsGenerator: PROGRAM
  IMPORTS
    Directory, Exec, FileStream, Format, Heap, LongString, Stream, Strings, Time, TTY = {

CompStrDesc: TYPE = RECORD [offset, length: CARDINAL];

nChars: CARDINAL;
in: Stream.Handle;

nOpCodes: CARDINAL = 256;
OpCode: TYPE = [0..nOpCodes);
StringArray: TYPE = ARRAY OpCode OF Strings.String;
NumberArray: TYPE = ARRAY OpCode OF CARDINAL;

stringData: LONG POINTER TO StringArray _ NIL;
push: LONG POINTER TO NumberArray _ NIL;
pop: LONG POINTER TO NumberArray _ NIL;
len: LONG POINTER TO NumberArray _ NIL;

Name: PROC [s: Strings.String] = {
  c: CHAR;
  nc: CARDINAL _ 0;
  collectingChars: BOOL _ FALSE;
  s.length _ 0;
  DO
    IF FileStream.EndOf[in] THEN RETURN;
    c _ in.GetChar;
    SELECT c FROM
      ' , '\t, '\n => IF collectingChars THEN EXIT;
      IN ['0..'9] => {
	IF ~collectingChars THEN {
	  FileStream.SetIndex[in, FileStream.GetIndex[in]-1]; EXIT};
	Strings.AppendChar[s,c]};
      IN ['A..'Z], IN ['a..'z] => {
	collectingChars _ TRUE; Strings.AppendChar[s,c]};
      ENDCASE => SIGNAL SyntaxError;
    ENDLOOP;
  nChars _ nChars + s.length};

Atom: PROC [s: Strings.String, del: CHAR] = {
  c: CHAR;
  nc: CARDINAL _ 0;
  collectingChars: BOOL _ FALSE;
  DO
    IF FileStream.EndOf[in] THEN SIGNAL SyntaxError;
    c _ in.GetChar;
    SELECT c FROM
      ' , '\n => IF collectingChars THEN EXIT;
      IN ['0..'9], IN ['A..'Z], IN ['a..'z], '+ => {
	s[nc] _ c; nc _ nc+1; collectingChars _ TRUE};
      ENDCASE => EXIT;
    ENDLOOP;
  s.length _ nc;
  IF c # del THEN SIGNAL SyntaxError};

SyntaxError: SIGNAL = CODE;


CollectOpData: PROC = { 
  name: STRING _ [20];
  s: STRING _ [8];
  code: CARDINAL;
  CRcount: CARDINAL _ 0;
  stringData _ (Heap.systemZone).NEW[StringArray _ ALL[NIL]];
  push _ (Heap.systemZone).NEW[NumberArray _ ALL[0]];
  pop _ (Heap.systemZone).NEW[NumberArray _ ALL[0]];
  len _ (Heap.systemZone).NEW[NumberArray _ ALL[0]];
  nChars _ 0;
  UNTIL CRcount = 3 DO
    IF in.GetChar = '\n THEN CRcount _ CRcount+1;
    ENDLOOP;
  code _ 0;
  THROUGH OpCode DO
    Name[name]; IF FileStream.EndOf[in] THEN EXIT;
    Atom[s, '(];
    IF ~(s.length=1 AND s[0]='+) THEN
      code _ LongString.StringToNumber[s, 8];
    Atom[s, ')];  -- decimal, ignore it
    IF name.length # 0 THEN {
      stringData[code] _ (Heap.systemZone).NEW[StringBody[name.length]];
      Strings.AppendString[stringData[code],name]};
    Atom[s, ',];
    push[code] _ LongString.StringToOctal[s];
    Atom[s, ',];
    pop[code] _ LongString.StringToOctal[s];
    Atom[s, ';];
    len[code] _ LongString.StringToOctal[s];
    code _ code+1;
    ENDLOOP};

ReleaseOpData: PROC = {
  (Heap.systemZone).FREE[@len];
  (Heap.systemZone).FREE[@pop]; (Heap.systemZone).FREE[@push];
  FOR i: OpCode IN OpCode DO
    IF stringData[i] # NIL THEN (Heap.systemZone).FREE[@stringData[i]];
    ENDLOOP;
  (Heap.systemZone).FREE[@stringData]};
  

OctalDecimalError: SIGNAL [CARDINAL] = CODE;
OpNameTooLong: ERROR [CARDINAL] = CODE;

OutStrings: PROC [boutfile: STRING] = {
  charpos: CARDINAL _ 0;
  bOut: Stream.Handle _ CreateFileStream[boutfile, writeAccess];
  bOut.PutWord[nOpCodes*CompStrDesc.SIZE+1];
  FOR i: OpCode IN OpCode DO
    j: CARDINAL = IF stringData[i] # NIL THEN stringData[i].length ELSE 0;
    bOut.PutWord[charpos];
    bOut.PutWord[j];
    charpos _ charpos + j;
    ENDLOOP;
  bOut.PutWord[nChars]; bOut.PutWord[nChars];
  FOR i: OpCode IN OpCode DO
   IF stringData[i] # NIL THEN {
    FOR j: CARDINAL IN [0..stringData[i].length)
      DO bOut.PutChar[stringData[i][j]] ENDLOOP};
   ENDLOOP;
  Stream.Delete[bOut]};


OutOpParams: PROC [apoutfile: STRING] = {
  out: Stream.Handle _ CreateFileStream[apoutfile, writeAccess];
  time: STRING _ [20];
  GetTime[time];
  OutString[out, "-- generated by OpDefsGenerator from "L];
  OutString[out, infile]; OutString[out, ", "L]; OutString[out, time];
  OutString[out, "\n
  Q: TYPE = PRIVATE RECORD [
    push, pop: [0..7], length: [0..3]];

  OpParms: PRIVATE ARRAY [0..256) OF Q = [\n"L];
  FOR i: OpCode IN OpCode DO
    IF i MOD 4 = 0 THEN {
      f: Format.NumberFormat = [8,TRUE,TRUE,3];
      OutString[out, "--"L];
      OutNameR[out, stringData[i], 10];
      OutNameR[out, stringData[i+1], 11];
      OutNameR[out, stringData[i+2], 11];
      OutNameR[out, stringData[i+3], 11];
      OutString[out, "   "L];
      OutNumF[out, i, f]; OutChar[out, '-];
      OutNumF[out, i+3, f]; OutString[out, "\n  "L]};
    OutString[out, "  Q["L];
    OutNum[out, push[i]]; OutChar[out, ',];
    OutNum[out, pop[i]]; OutChar[out, ',];
    OutNum[out, len[i]]; OutChar[out, ']];
    IF i MOD 4 = 3 THEN {
      IF i = OpCode.LAST THEN OutString[out, "];"L] ELSE OutChar[out, ',];
      OutChar[out, '\n]}
    ELSE OutChar[out, ',];
    ENDLOOP;
  Stream.Delete[out]};


GetTime: PROC [time: STRING] = {
  Time.AppendCurrent[time];
  time.length _ time.length - 3};

OutMopcodes: PROC [amoutfile, moduleName, prefixString: STRING] = {
  out: Stream.Handle _ CreateFileStream[amoutfile, writeAccess];
  i: OpCode;
  j, l: CARDINAL;
  time: STRING _ [20];
  GetTime[time];
  OutString[out, "-- generated by OpDefsGenerator from "L];
  OutString[out, infile]; OutString[out, ", "L]; OutString[out, time];
  OutChar[out, '\n];  OutChar[out, '\n];
  OutString[out, moduleName];
  OutString[out, ": DEFINITIONS = {\n
Op: TYPE = [0..400b);\n\n"L];
  FOR i IN OpCode DO
    IF stringData[i] # NIL AND (l _ stringData[i].length) # 0 THEN {
      IF l > 10 THEN ERROR OpNameTooLong[i];
      FOR j IN (l..10) DO OutChar[out, ' ] ENDLOOP;
      OutString[out, prefixString];
      OutString[out, stringData[i]];
      OutString[out, ": Op = "L];
      OutNumF[out, i, [8,FALSE,FALSE,3]]; OutChar[out, 'b];
      OutChar[out, ';]}
    ELSE { -- null item, check for rest of line empty
      FOR j _ i, j+1 DO
	IF stringData[j] # NIL AND stringData[j].length # 0 THEN EXIT;
        IF j MOD 4 = 3 THEN GOTO empty;
        ENDLOOP;
      FOR j IN [0..22) DO OutChar[out, ' ]; ENDLOOP;
      EXITS
        empty => {
	  blank: BOOL = (j-i)=3; -- TRUE iff whole line empty
	  i _ j;
	  IF blank THEN LOOP}}; -- no CR
    IF (i MOD 4) # 3 THEN OutChar[out, ' ] ELSE OutChar[out, '\n];
    ENDLOOP;
  OutString[out, "}.\n"L];
  Stream.Delete[out]};


OutNameR: PROC [out: Stream.Handle, s: Strings.String, n: CARDINAL] = {
  l: CARDINAL _ IF s = NIL THEN 0 ELSE s.length;
  THROUGH (l..n] DO OutChar[out, ' ]; ENDLOOP;
  OutString[out, s]};

OutNameL: PROC [out: Stream.Handle, s: Strings.String, n: CARDINAL] = {
  l: CARDINAL _ IF s = NIL THEN 0 ELSE s.length;
  OutString[out, s];
  THROUGH (l..n] DO OutChar[out, ' ]; ENDLOOP};

OutNum: PROC [out: Stream.Handle, n: CARDINAL] = INLINE {
  OutNumF[out, n, [10,FALSE,FALSE,1]]};

OutNumF: PROC [out: Stream.Handle, n: CARDINAL, f: Format.NumberFormat] = {
  PutNumber: Format.StringProc = {OutString[out, s]};
  Format.Number[n, f, PutNumber]};

OutString: PROC [out: Stream.Handle, s: Strings.String] = {
  IF s # NIL THEN
    FOR i: CARDINAL IN [0..s.length) DO out.PutChar[s[i]] ENDLOOP};

OutChar: PROC [out: Stream.Handle, c: CHAR] = INLINE {out.PutChar[c]};


OutListing: PROC [listfile: STRING] = {
  out: Stream.Handle _ CreateFileStream[listfile, writeAccess];
  time: STRING _ [18];
  GetTime[time];
  OutString[out, listfile]; OutString[out, ";  "L];
  OutString[out, time]; OutChar[out, '\n];
  OutString[out, "Format: name octal(decimal)push,pop,count\n\n"L];
  FOR i: OpCode IN OpCode DO
    OutNameL[out, stringData[i],8];
    OutNumF[out, i,[8,FALSE,FALSE,3]];
    OutChar[out, '(];
    OutNumF[out, i,[10,FALSE,FALSE,3]];
    OutChar[out, ')];
    OutNum[out, push[i]]; OutChar[out, ',];
    OutNum[out, pop[i]]; OutChar[out, ',];
    OutNum[out, len[i]]; OutChar[out, ';];
    IF i MOD 4 = 3 THEN OutChar[out, '\n] ELSE OutString[out, "  "L];
    ENDLOOP;
  Stream.Delete[out]};


-- OS utilities

readAccess: File.Permissions = File.read;
writeAccess: File.Permissions = File.write+File.grow+File.shrink+File.delete;

FileError: ERROR [name: Strings.String] = CODE;

CreateFileStream: PROC [name: Strings.String, access: File.Permissions]
    RETURNS [Stream.Handle] = {
  file: File.Capability;
  old: BOOL _ (access = File.read);
  IF ~old THEN { 
      file _ Directory.CreateFile[name, DCSFileTypes.tLeaderPage, 0
	      ! Directory.Error => {
		 IF type = fileAlreadyExists THEN GOTO fileExists 
		 ELSE GO TO fileProblem}];
      EXITS
        fileExists => old _ TRUE};
  IF old THEN
    file _ Directory.Lookup[fileName: name, permissions: Directory.ignore
	! Directory.Error => {GO TO fileProblem}];
  file _ Directory.UpdateDates[file, access];
  RETURN [FileStream.Create[file]]
  EXITS
    fileProblem => ERROR FileError[name]};
  

infile: STRING _ [40];

Main: PROC = {
  DefaultNames: TYPE = {infile, apoutfile, amoutfile, boutfile, listfile, modulename, prefix};
  DefaultStrings: TYPE = ARRAY DefaultNames OF Strings.String;

  MopDefaults: DefaultStrings _ [
    "OpCodes.txt"L, "OpParams"L, "Mopcodes.mesa"L, "OpNames.binary"L,
    "Mopcodes.list"L, "Mopcodes"L, "z"L];
  FopDefaults: DefaultStrings _ [
    "FOpCodes.txt"L, "FOpParams"L, "FOpCodes.mesa"L, "FOpNames.binary"L,
    "FOpCodes.list"L, "FOpCodes"L, "q"L];

  apoutfile: STRING _ [40];
  amoutfile: STRING _ [40];
  boutfile: STRING _ [40];
  listfile: STRING _ [40];
  moduleName: STRING _ [40];
  prefixString: STRING _ [10];

  SetDefaults: PROC [p: LONG POINTER TO DefaultStrings] = {
    infile.length_0;       Strings.AppendString[infile, p[$infile]];
    apoutfile.length_0;    Strings.AppendString[apoutfile, p[$apoutfile]];
    amoutfile.length_0;    Strings.AppendString[amoutfile, p[$amoutfile]];
    boutfile.length_0;     Strings.AppendString[boutfile, p[$boutfile]];
    listfile.length_0;     Strings.AppendString[listfile, p[$listfile]];
    moduleName.length_0;   Strings.AppendString[moduleName, p[$modulename]];
    prefixString.length_0; Strings.AppendString[prefixString, p[$prefix]]};

  tty: TTY.Handle = Exec.w;

  GetResponse: PROC [prompt, response: STRING] = {
    tty.PutString[prompt];
    tty.GetID[response];
    tty.PutChar['\n]};

  tty.PutString["\nMesa OpData Generator\n"L];
  DO
    DO
      tty.PutString["\nMopdata, Fopdata, or Quit: "L];
      SELECT tty.GetChar FROM
	'm,'M => {tty.PutLine["Mopdata"L]; SetDefaults[@MopDefaults]; EXIT};
	'f,'F => {tty.PutLine["Fopdata"L]; SetDefaults[@FopDefaults]; EXIT};
	'q,'Q => {tty.PutLine["Quit"L]; GOTO done};
	ENDCASE;
      ENDLOOP;
  tty.PutLine["\nUse escape key to get defaults"L];
  GetResponse["Input file: "L, infile];
  IF infile.length = 0 THEN EXIT;
  GetResponse["  OpParams file: "L, apoutfile];
  GetResponse["  Mopcodes file: "L, amoutfile];
  GetResponse["     Module name (capitalize correctly): "L, moduleName];
  GetResponse["     Prefix with: "L, prefixString];
  GetResponse["  binary file for OpName strings: "L, boutfile];
  GetResponse["  listing file: "L, listfile];
  in _ CreateFileStream[infile, readAccess];
  CollectOpData[];
  OutOpParams[apoutfile]; OutStrings[boutfile];
  OutMopcodes[amoutfile, moduleName, prefixString]; OutListing[listfile];
  ReleaseOpData[];
  Stream.Delete[in];
  REPEAT
    done => NULL;
  ENDLOOP};

Main[];

}.