step1: Phase-0 scaffolding — M2c module-skeleton compiler, 4/4 tests green

FileIO.def

@@ -0,0 +1,330 @@
+DEFINITION MODULE FileIO;
+(* This module attempts to provide several potentially non-portable
+   facilities for Coco/R.
+
+   (a)  A general file input/output module, with all routines required for
+        Coco/R itself, as well as several other that would be useful in
+        Coco-generated applications.
+   (b)  Definition of the "LONGINT" type needed by Coco.
+   (c)  Some conversion functions to handle this long type.
+   (d)  Some "long" and other constant literals that may be problematic
+        on some implementations.
+   (e)  Some string handling primitives needed to interface to a variety
+        of known implementations.
+
+   The intention is that the rest of the code of Coco and its generated
+   parsers should be as portable as possible.  Provided the definition
+   module given, and the associated implementation, satisfy the
+   specification given here, this should be almost 100% possible (with
+   the exception of a few constants, avoid changing anything in this
+   specification).
+
+   FileIO is based on code by MB 1990/11/25; heavily modified and extended
+   by PDT and others between 1992/1/6 and the present day. *)
+
+(* This is the ISO Gardens Point Modula (Linux/FreeBSD) version *)
+
+IMPORT SYSTEM, Strings;
+
+TYPE
+  File;                (* Preferably opaque *)
+  INT32 = INTEGER;     (* This may require a special import; on 32 bit
+                          systems INT32 = INTEGER may even suffice. *)
+
+CONST
+  EOF = 0C;            (* FileIO.Read returns EOF when eof is reached. *)
+  EOL = 12C;           (* FileIO.Read maps line marks onto EOL
+                          FileIO.Write maps EOL onto cr, lf, or cr/lf
+                          as appropriate for filing system. *)
+  ESC = 33C;           (* Standard ASCII escape. *)
+  CR  = 15C;           (* Standard ASCII carriage return. *)
+  LF  = 12C;           (* Standard ASCII line feed. *)
+  BS  = 10C;           (* Standard ASCII backspace. *)
+  DEL = 177C;          (* Standard ASCII DEL (rub-out). *)
+
+  BitSetSize = 16;     (* number of bits actually used in BITSET type *)
+
+  Long0 = VAL(INT32, 0); (* Some systems allow 0 or require 0L. *)
+  Long1 = VAL(INT32, 1); (* Some systems allow 1 or require 1L. *)
+  Long2 = VAL(INT32, 2); (* Some systems allow 2 or require 2L. *)
+
+  FrmExt = ".frm";     (* supplied frame files have this extension. *)
+  TxtExt = ".txt";     (* generated text files may have this extension. *)
+  ErrExt = ".err";     (* generated error files may have this extension. *)
+  DefExt = ".def";     (* generated definition modules have this extension. *)
+  PasExt = ".pas";     (* generated Pascal units have this extension. *)
+  ModExt = ".mod";     (* generated implementation/program modules have this
+                          extension. *)
+  PathSep = ":";       (* separate components in path environment variables
+                          DOS = ";"  UNIX = ":" *)
+  DirSep  = "/";       (* separate directory element of file specifiers
+                          DOS = "\"  UNIX = "/" *)
+
+VAR
+  Okay: BOOLEAN;       (* Status of last I/O operation. *)
+  con, err:  File;     (* Standard terminal and error channels. *)
+  StdIn, StdOut: File; (* standard input/output - redirectable *)
+  EOFChar: CHAR;       (* Signal EOF interactively *)
+
+(* The following routines provide access to command line parameters and
+   the environment. *)
+
+PROCEDURE NextParameter (VAR s: ARRAY OF CHAR);
+(* Extracts next parameter from command line.
+   Returns empty string (s[0] = 0C) if no further parameter can be found. *)
+
+PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
+(* Returns s as the value of environment variable envVar, or empty string
+   if that variable is not defined. *)
+
+(* The following routines provide a minimal set of file opening routines
+   and closing routines. *)
+
+PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
+(* Opens file f whose full name is specified by fileName.
+   Opening mode is specified by newFile:
+       TRUE:  the specified file is opened for output only.  Any existing
+              file with the same name is deleted.
+      FALSE:  the specified file is opened for input only.
+   FileIO.Okay indicates whether the file f has been opened successfully. *)
+
+PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
+                      newFile: BOOLEAN);
+(* As for Open, but tries to open file of given fileName by searching each
+   directory specified by the environment variable named by envVar. *)
+
+PROCEDURE Close (VAR f: File);
+(* Closes file f.  f becomes NIL.
+   If possible, Close should be called automatically for all files that
+   remain open when the application terminates.  This will be possible on
+   implementations that provide some sort of termination or at-exit
+   facility. *)
+
+PROCEDURE CloseAll;
+(* Closes all files opened by Open or SearchFile.
+   On systems that allow this, CloseAll should be automatically installed
+   as the termination (at-exit) procedure *)
+
+(* The following utility procedure is not used by Coco, but may be useful.
+   However, some operating systems may not allow for its implementation. *)
+
+PROCEDURE Delete (VAR f: File);
+(* Deletes file f.  f becomes NIL. *)
+
+(* The following routines provide a minimal set of file name manipulation
+   routines.  These are modelled after MS-DOS conventions, where a file
+   specifier is of a form exemplified by D:\DIR\SUBDIR\PRIMARY.EXT
+   Other conventions may be introduced; these routines are used by Coco to
+   derive names for the generated modules from the grammar name and the
+   directory in which the grammar specification is located. *)
+
+PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR;
+                            VAR directory: ARRAY OF CHAR);
+(* Extracts D:\DIRECTORY\ portion of fullName. *)
+
+PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR;
+                           VAR fileName: ARRAY OF CHAR);
+(* Extracts PRIMARY.EXT portion of fullName. *)
+
+PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+(* Constructs newName as complete file name by appending ext to oldName
+   if it doesn't end with "."  Examples: (assume ext = "EXT")
+         old.any ==> OLD.EXT
+         old.    ==> OLD.
+         old     ==> OLD.EXT
+   This is not a file renaming facility, merely a string manipulation
+   routine. *)
+
+PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+(* Constructs newName as a complete file name by changing extension of
+   oldName to ext.  Examples: (assume ext = "EXT")
+         old.any ==> OLD.EXT
+         old.    ==> OLD.EXT
+         old     ==> OLD.EXT
+   This is not a file renaming facility, merely a string manipulation
+   routine. *)
+
+(* The following routines provide a minimal set of file positioning routines.
+   Others may be introduced, but at least these should be implemented.
+   Success of each operation is recorded in FileIO.Okay. *)
+
+PROCEDURE Length (f: File): INT32;
+(* Returns length of file f. *)
+
+PROCEDURE GetPos (f: File): INT32;
+(* Returns the current read/write position in f. *)
+
+PROCEDURE SetPos (f: File; pos: INT32);
+(* Sets the current position for f to pos. *)
+
+(* The following routines provide a minimal set of file rewinding routines.
+   These two are not currently used by Coco itself.
+   Success of each operation is recorded in FileIO.Okay *)
+
+PROCEDURE Reset (f: File);
+(* Sets the read/write position to the start of the file *)
+
+PROCEDURE Rewrite (f: File);
+(* Truncates the file, leaving open for writing *)
+
+(* The following routines provide a minimal set of input routines.
+   Others may be introduced, but at least these should be implemented.
+   Success of each operation is recorded in FileIO.Okay. *)
+
+PROCEDURE EndOfLine (f: File): BOOLEAN;
+(* TRUE if f is currently at the end of a line, or at end of file. *)
+
+PROCEDURE EndOfFile (f: File): BOOLEAN;
+(* TRUE if f is currently at the end of file. *)
+
+PROCEDURE Read (f: File; VAR ch: CHAR);
+(* Reads a character ch from file f.
+   Maps filing system line mark sequence to FileIO.EOL. *)
+
+PROCEDURE ReadAgain (f: File);
+(* Prepares to re-read the last character read from f.
+   There is no buffer, so at most one character can be re-read. *)
+
+PROCEDURE ReadLn (f: File);
+(* Reads to start of next line on file f, or to end of file if no next
+   line.  Skips to, and consumes next line mark. *)
+
+PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR);
+(* Reads a string of characters from file f.
+   Leading blanks are skipped, and str is delimited by line mark.
+   Line mark is not consumed. *)
+
+PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR);
+(* Reads a string of characters from file f.
+   Leading blanks are not skipped, and str is terminated by line mark or
+   control character, which is not consumed. *)
+
+PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR);
+(* Reads a string of characters from file f.
+   Leading blanks and line feeds are skipped, and token is terminated by a
+   character <= ' ', which is not consumed. *)
+
+PROCEDURE ReadInt (f: File; VAR i: INTEGER);
+(* Reads an integer value from file f. *)
+
+PROCEDURE ReadCard (f: File; VAR i: CARDINAL);
+(* Reads a cardinal value from file f. *)
+
+PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL);
+(* Attempts to read len bytes from the current file position into buf.
+   After the call, len contains the number of bytes actually read. *)
+
+(* The following routines provide a minimal set of output routines.
+   Others may be introduced, but at least these should be implemented. *)
+
+PROCEDURE Write (f: File; ch: CHAR);
+(* Writes a character ch to file f.
+   If ch = FileIO.EOL, writes line mark appropriate to filing system. *)
+
+PROCEDURE WriteLn (f: File);
+(* Skips to the start of the next line on file f.
+   Writes line mark appropriate to filing system. *)
+
+PROCEDURE WriteString (f: File; str: ARRAY OF CHAR);
+(* Writes entire string str to file f. *)
+
+PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER);
+(* Writes text to file f.
+   At most len characters are written.  Trailing spaces are introduced
+   if necessary (thus providing left justification). *)
+
+PROCEDURE WriteInt (f: File; int: INTEGER; wid: CARDINAL);
+(* Writes an INTEGER int into a field of wid characters width.
+   If the number does not fit into wid characters, wid is expanded.
+   If wid = 0, exactly one leading space is introduced. *)
+
+PROCEDURE WriteCard (f: File; card, wid: CARDINAL);
+(* Writes a CARDINAL card into a field of wid characters width.
+   If the number does not fit into wid characters, wid is expanded.
+   If wid = 0, exactly one leading space is introduced. *)
+
+PROCEDURE WriteBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; len: CARDINAL);
+(* Writes len bytes from buf to f at the current file position. *)
+
+(* The following procedures are not currently used by Coco, and may be
+   safely omitted, or implemented as null procedures.  They might be
+   useful in measuring performance. *)
+
+PROCEDURE WriteDate (f: File);
+(* Write current date DD/MM/YYYY to file f. *)
+
+PROCEDURE WriteTime (f: File);
+(* Write time HH:MM:SS to file f. *)
+
+PROCEDURE WriteElapsedTime (f: File);
+(* Write elapsed time in seconds since last call of this procedure. *)
+
+PROCEDURE WriteExecutionTime (f: File);
+(* Write total execution time in seconds thus far to file f. *)
+
+(* The following procedures are a minimal set used within Coco for
+   string manipulation.  They almost follow the conventions of the ISO
+   routines, and are provided here to interface onto whatever Strings
+   library is available.  On ISO compilers it should be possible to
+   implement most of these with CONST declarations, and even replace
+   SLENGTH with the pervasive function LENGTH at the points where it is
+   called.
+
+CONST
+  SLENGTH = Strings.Length;
+  Assign  = Strings.Assign;
+  Extract = Strings.Extract;
+  Concat  = Strings.Concat;
+
+*)
+
+PROCEDURE SLENGTH (stringVal: ARRAY OF CHAR): CARDINAL;
+(* Returns number of characters in stringVal, not including nul *)
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+(* Copies as much of source to destination as possible, truncating if too
+   long, and nul terminating if shorter.
+   Be careful - some libraries have the parameters reversed! *)
+
+PROCEDURE Extract (source: ARRAY OF CHAR;
+                   startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+(* Extracts at most numberToExtract characters from source[startIndex]
+   to destination.  If source is too short, fewer will be extracted, even
+   zero perhaps *)
+
+PROCEDURE Concat (stringVal1, stringVal2: ARRAY OF CHAR;
+                  VAR destination: ARRAY OF CHAR);
+(* Concatenates stringVal1 and stringVal2 to form destination.
+   Nul terminated if concatenation is short enough, truncated if it is
+   too long *)
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
+(* Returns -1, 0, 1 depending whether stringVal1 < = > stringVal2.
+   This is not directly ISO compatible *)
+
+(* The following routines are for conversions to and from the INT32 type.
+   Their names are modelled after the ISO pervasive routines that would
+   achieve the same end.  Where possible, replacing calls to these routines
+   by the pervasives would improve performance markedly.  As used in Coco,
+   these routines should not give range problems. *)
+
+PROCEDURE ORDL (n: INT32): CARDINAL;
+(* Convert long integer n to corresponding (short) cardinal value.
+   Potentially FileIO.ORDL(n) = VAL(CARDINAL, n) *)
+
+PROCEDURE INTL (n: INT32): INTEGER;
+(* Convert long integer n to corresponding short integer value.
+   Potentially FileIO.INTL(n) = VAL(INTEGER, n) *)
+
+PROCEDURE INT (n: CARDINAL): INT32;
+(* Convert cardinal n to corresponding long integer value.
+   Potentially FileIO.INT(n) = VAL(INT32, n) *)
+
+PROCEDURE QuitExecution;
+(* Close all files and halt execution.
+   On some implementations QuitExecution will be simply implemented as HALT *)
+
+END FileIO.

FileIO.mod

@@ -0,0 +1,881 @@
+IMPLEMENTATION MODULE FileIO;
+(* ISO (GPM) version by Pat Terry.  Sat  04-25-98  p.terry@ru.ac.za *)
+
+(* This module attempts to provide several potentially non-portable
+   facilities for Coco/R.
+
+   (a)  A general file input/output module, with all routines required for
+        Coco/R itself, as well as several other that would be useful in
+        Coco-generated applications.
+   (b)  Definition of the "LONGINT" type needed by Coco.
+   (c)  Some conversion functions to handle this long type.
+   (d)  Some "long" and other constant literals that may be problematic
+        on some implementations.
+   (e)  Some string handling primitives needed to interface to a variety
+        of known implementations.
+
+   The intention is that the rest of the code of Coco and its generated
+   parsers should be as portable as possible.  Provided the definition
+   module given, and the associated implementation, satisfy the
+   specification given here, this should be almost 100% possible.
+
+   FileIO is based on code by MB 1990/11/25; heavily modified and extended
+   by PDT and others between 1992/1/6 and the present day. *)
+
+IMPORT (* GNU Modula-2 specific *) Environment,FileSysOp,
+       SYSTEM, Strings, SysClock, ProgramArgs, TextIO, RawIO, WholeIO,
+       IOChan, IOResult, RndFile, TermFile, StdChans, ChanConsts;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+CONST
+  MaxFiles = BitSetSize;
+  NameLength = 256;
+
+TYPE
+  File = POINTER TO FileRec;
+  FileRec = RECORD
+              ref: IOChan.ChanId;
+              self: File;
+              handle: CARDINAL;
+              savedCh: CHAR;
+              textOK, eof, eol, noOutput, noInput, haveCh: BOOLEAN;
+              name: ARRAY [0 .. NameLength] OF CHAR;
+            END;
+
+VAR
+  Handles: BITSET;
+  Opened: ARRAY [0 .. MaxFiles-1] OF File;
+  FromKeyboard, ToScreen: BOOLEAN;
+  res: ChanConsts.OpenResults;
+
+PROCEDURE NotRead (f: File): BOOLEAN;
+  BEGIN
+    RETURN (f = NIL) OR (f^.self # f) OR (f^.noInput);
+  END NotRead;
+
+PROCEDURE NotWrite (f: File): BOOLEAN;
+  BEGIN
+    RETURN (f = NIL) OR (f^.self # f) OR (f^.noOutput);
+  END NotWrite;
+
+PROCEDURE NotFile (f: File): BOOLEAN;
+  BEGIN
+    RETURN (f = NIL) OR (f^.self # f) OR (f = con) OR (f = err)
+      OR (f = StdIn) & FromKeyboard
+      OR (f = StdOut) & ToScreen
+  END NotFile;
+
+PROCEDURE CheckRedirection;
+  BEGIN
+    FromKeyboard := TRUE; ToScreen := TRUE; (* ISO fail safe *)
+    (* Ideally we would like
+       FromKeyboard := NOT (StdIn has been redirected )
+       ToScreen := NOT (StdOut has been redirected )
+    *)
+  END CheckRedirection;
+
+PROCEDURE ASCIIZ (VAR s1, s2: ARRAY OF CHAR);
+(* Convert s2 to a nul terminated string in s1 *)
+  VAR
+    i: CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i <= HIGH(s2)) & (s2[i] # 0C) DO
+      s1[i] := s2[i]; INC(i)
+    END;
+    s1[i] := 0C
+  END ASCIIZ;
+
+PROCEDURE NextParameter (VAR s: ARRAY OF CHAR);
+  BEGIN
+    IF ProgramArgs.IsArgPresent()
+      THEN
+        TextIO.ReadToken(ProgramArgs.ArgChan(), s);
+        ProgramArgs.NextArg()
+      ELSE s[0] := 0C
+    END
+  END NextParameter;
+
+PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
+(* ++++ GNU Modula-2 specific routine used ++++ *)
+
+  VAR
+    OK : BOOLEAN;
+
+  BEGIN
+    OK := Environment.GetEnvironment(envVar, s);
+  END GetEnv;
+
+PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
+  VAR
+    i: CARDINAL;
+    name: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    ExtractFileName(fileName, name);
+    FOR i := 0 TO NameLength - 1 DO name[i] := CAP(name[i]) END;
+    IF (name[0] = 0C) OR (Compare(name, "CON") = 0) THEN
+      (* con already opened, but reset it *)
+      Okay := TRUE; f := con;
+      f^.savedCh := 0C; f^.haveCh := FALSE;
+      f^.eof := FALSE; f^.eol := FALSE; f^.name := "CON";
+      RETURN
+    ELSIF Compare(name, "ERR") = 0 THEN
+      Okay := TRUE; f := err; RETURN
+    ELSE
+      ALLOCATE(f, SYSTEM.TSIZE(FileRec));
+      (* Flags below may have to be altered according to implementation *)
+      IF newFile
+        THEN RndFile.OpenClean(f^.ref, fileName,
+             RndFile.old (* + RndFile.text *) + RndFile.raw, res)
+        ELSE RndFile.OpenOld(f^.ref, fileName,
+             RndFile.read (* + RnfDile.text *) +RndFile.raw, res)
+      END;
+      Okay := res = RndFile.opened;
+      IF ~ Okay
+        THEN
+          DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
+        ELSE
+      (* textOK below may have to be altered according to implementation *)
+          f^.savedCh := 0C; f^.haveCh := FALSE; f^.textOK := FALSE;
+          f^.eof := newFile; f^.eol := newFile; f^.self := f;
+          f^.noInput := newFile; f^.noOutput := ~ newFile;
+          ASCIIZ(f^.name, fileName);
+          i := 0 (* find next available filehandle *);
+          WHILE (i IN Handles) & (i < MaxFiles) DO INC(i) END;
+          IF i < MaxFiles
+            THEN f^.handle := i; INCL(Handles, i); Opened[i] := f
+            ELSE WriteString(err, "Too many files"); Okay := FALSE
+          END;
+      END
+    END
+  END Open;
+
+PROCEDURE Close (VAR f: File);
+  BEGIN
+    Okay := TRUE;
+    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
+      THEN Okay := FALSE
+      ELSE
+        EXCL(Handles, f^.handle);
+        RndFile.Close(f^.ref);
+        IF Okay THEN DEALLOCATE(f, SYSTEM.TSIZE(FileRec)) END;
+        f := NIL
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; f := NIL; RETURN
+*)
+  END Close;
+
+PROCEDURE Delete (VAR f: File);
+(* ++++ GNU Modula-2 specific routine used ++++ *)
+  VAR
+    fname : ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
+      THEN Okay := FALSE
+      ELSE
+        Assign(f^.name, fname);
+        Close(f);
+        Okay := FileSysOp.Unlink(fname);
+    END
+  END Delete;
+
+PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
+                      newFile: BOOLEAN);
+  VAR
+    i, j: INTEGER;
+    k: CARDINAL;
+    c: CHAR;
+    fname: ARRAY [0 .. NameLength] OF CHAR;
+    path: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    FOR k := 0 TO HIGH(envVar) DO envVar[k] := CAP(envVar[k]) END;
+    GetEnv(envVar, path);
+    i := 0;
+    REPEAT
+      j := 0;
+      REPEAT
+        c := path[i]; fname[j] := c; INC(i); INC(j)
+      UNTIL (c = PathSep) OR (c = 0C);
+      IF (j > 1) & (fname[j-2] = DirSep) THEN DEC(j) ELSE fname[j-1] := DirSep END;
+      fname[j] := 0C; Concat(fname, fileName, fname);
+      Open(f, fname, newFile);
+    UNTIL (c = 0C) OR Okay
+  END SearchFile;
+
+PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR;
+                            VAR directory: ARRAY OF CHAR);
+  VAR
+    i, start: CARDINAL;
+  BEGIN
+    start := 0; i := 0;
+    WHILE (i <= HIGH(fullName)) & (fullName[i] # 0C) DO
+      IF i <= HIGH(directory) THEN
+        directory[i] := fullName[i];
+      END;
+      IF (fullName[i] = ":") OR (fullName[i] = DirSep) THEN start := i + 1 END;
+      INC(i)
+    END;
+    IF start <= HIGH(directory) THEN directory[start] := 0C END
+  END ExtractDirectory;
+
+PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR;
+                           VAR fileName: ARRAY OF CHAR);
+  VAR
+    i, l, start: CARDINAL;
+  BEGIN
+    start := 0; l := 0;
+    WHILE (l <= HIGH(fullName)) & (fullName[l] # 0C) DO
+      IF (fullName[l] = ":") OR (fullName[l] = DirSep) THEN start := l + 1 END;
+      INC(l)
+    END;
+    i := 0;
+    WHILE (start < l) & (i <= HIGH(fileName)) DO
+      fileName[i] := fullName[start]; INC(start); INC(i)
+    END;
+    IF i <= HIGH(fileName) THEN fileName[i] := 0C END
+  END ExtractFileName;
+
+PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+  VAR
+    i, j: CARDINAL;
+    fn: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    ExtractDirectory(oldName, newName);
+    ExtractFileName(oldName, fn);
+    i := 0; j := 0;
+    WHILE (i <= NameLength) & (fn[i] # 0C) DO
+      IF fn[i] = "." THEN j := i + 1 END;
+      INC(i)
+    END;
+    IF (j # i) (* then name did not end with "." *) OR (i = 0) THEN
+      IF j # 0 THEN i := j - 1 END;
+      IF (ext[0] # ".") & (ext[0] # 0C) THEN
+        IF i <= NameLength THEN fn[i] := "."; INC(i) END
+      END;
+      j := 0;
+      WHILE (j <= HIGH(ext)) & (ext[j] # 0C) & (i <= NameLength) DO
+        fn[i] := ext[j]; INC(i); INC(j)
+      END
+    END;
+    IF i <= NameLength THEN fn[i] := 0C END;
+    Concat(newName, fn, newName)
+  END AppendExtension;
+
+PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+  VAR
+    i, j: CARDINAL;
+    fn: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    ExtractDirectory(oldName, newName);
+    ExtractFileName(oldName, fn);
+    i := 0; j := 0;
+    WHILE (i <= NameLength) & (fn[i] # 0C) DO
+      IF fn[i] = "." THEN j := i + 1 END;
+      INC(i)
+    END;
+    IF j # 0 THEN i := j - 1 END;
+    IF (ext[0] # ".") & (ext[0] # 0C) THEN
+      IF i <= NameLength THEN fn[i] := "."; INC(i) END
+    END;
+    j := 0;
+    WHILE (j <= HIGH(ext)) & (ext[j] # 0C) & (i <= NameLength) DO
+      fn[i] := ext[j]; INC(i); INC(j)
+    END;
+    IF i <= NameLength THEN fn[i] := 0C END;
+    Concat(newName, fn, newName)
+  END ChangeExtension;
+
+PROCEDURE Length (f: File): INT32;
+(* ++++ implementation specific coercion routine may have to be used ++++ *)
+  VAR
+    pos: RndFile.FilePos;
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE; RETURN Long0
+      ELSE
+        Okay := TRUE;
+        pos := RndFile.EndPos(f^.ref);
+        (* ++++ GPM specific routine used ++++ *)
+        RETURN VAL(INT32, pos)
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN Long0
+*)
+  END Length;
+
+PROCEDURE GetPos (f: File): INT32;
+(* ++++ implementation specific coercion routine may have to be used ++++ *)
+  VAR
+    pos: RndFile.FilePos;
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE; RETURN Long0
+      ELSE
+        Okay := TRUE;
+        pos := RndFile.CurrentPos(f^.ref);
+        (* ++++ GPM specific casting used ++++ *)
+        RETURN VAL(INT32, pos)
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN Long0
+*)
+  END GetPos;
+
+PROCEDURE SetPos (f: File; pos: INT32);
+(* ++++ implementation specific coercion routine may have to be used ++++ *)
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE
+      ELSE
+        Okay := TRUE; f^.haveCh := FALSE;
+        (* ++++ GPM specific routine used ++++ *)
+        RndFile.SetPos(f^.ref, VAL(CARDINAL, pos));
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; f^.haveCh := FALSE; RETURN
+*)
+  END SetPos;
+
+PROCEDURE Reset (f: File);
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE
+      ELSE
+        SetPos(f, 0);
+        IF Okay THEN
+          f^.haveCh := FALSE; f^.eof := f^.noInput; f^.eol := f^.noInput
+        END
+    END
+  END Reset;
+
+PROCEDURE Rewrite (f: File);
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE
+      ELSE
+        RndFile.Close(f^.ref);
+        (* Flags below may have to be altered according to implementation *)
+        RndFile.OpenClean(f^.ref, f^.name,
+                          RndFile.old + (* RndFile.text + *) RndFile.raw, res);
+        Okay := res = RndFile.opened;
+        IF ~ Okay
+          THEN
+            DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
+          ELSE
+            f^.savedCh := 0C; f^.haveCh := FALSE;
+            f^.eof := TRUE; f^.eol := TRUE; 
+            f^.noInput := TRUE; f^.noOutput := FALSE;
+        END
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN
+*)
+  END Rewrite;
+
+PROCEDURE EndOfLine (f: File): BOOLEAN;
+  BEGIN
+    IF NotRead(f)
+      THEN Okay := FALSE; RETURN TRUE
+      ELSE Okay := TRUE; RETURN f^.eol OR f^.eof
+    END
+  END EndOfLine;
+
+PROCEDURE EndOfFile (f: File): BOOLEAN;
+  BEGIN
+    IF NotRead(f)
+      THEN Okay := FALSE; RETURN TRUE
+      ELSE Okay := TRUE; RETURN f^.eof
+    END
+  END EndOfFile;
+
+PROCEDURE Read (f: File; VAR ch: CHAR);
+  BEGIN
+    IF NotRead(f) THEN Okay := FALSE; ch := 0C; RETURN END;
+    IF f^.haveCh OR f^.eof
+      THEN
+        ch := f^.savedCh; Okay := ch # 0C;
+      ELSE
+        Okay := TRUE;
+        IF ~ f^.textOK (* Work around as best one can *)
+          THEN RawIO.Read(f^.ref, ch)
+          ELSE TextIO.ReadChar(f^.ref, ch);
+        END; 
+        IF f^.textOK & (IOResult.ReadResult(f^.ref) = IOResult.endOfLine)
+          THEN TextIO.SkipLine(f^.ref); ch := EOL
+          ELSIF ch = LF (* Work around possible bug *) THEN ch := EOL
+        END;
+        IF IOResult.ReadResult(f^.ref) = IOResult.endOfInput THEN
+          Okay := FALSE; ch := 0C;
+        END;
+        IF ch = EOFChar THEN Okay := FALSE; ch := 0C END;
+    END;
+    IF ~ Okay THEN ch := 0C END;
+    f^.savedCh := ch; f^.haveCh := ~ Okay;
+    f^.eof := ch = 0C; f^.eol := f^.eof OR (ch = EOL);
+  END Read;
+
+PROCEDURE ReadAgain (f: File);
+  BEGIN
+    IF NotRead(f)
+      THEN Okay := FALSE
+      ELSE f^.haveCh := TRUE
+    END
+  END ReadAgain;
+
+PROCEDURE ReadLn (f: File);
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    WHILE ~ f^.eol DO Read(f, ch) END;
+    f^.haveCh := FALSE; f^.eol := FALSE;
+  END ReadLn;
+
+PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR);
+  VAR
+    j: CARDINAL;
+    ch: CHAR;
+  BEGIN
+    str[0] := 0C; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    REPEAT Read(f, ch) UNTIL (ch # " ") OR ~ Okay;
+    IF Okay THEN
+      WHILE ch >= " " DO
+        IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
+        Read(f, ch);
+        WHILE (ch = BS) OR (ch = DEL) DO
+          IF j > 0 THEN DEC(j) END; Read(f, ch)
+        END
+      END;
+      IF j <= HIGH(str) THEN str[j] := 0C END;
+      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
+    END
+  END ReadString;
+
+PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR);
+  VAR
+    j: CARDINAL;
+    ch: CHAR;
+  BEGIN
+    str[0] := 0C; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    Read(f, ch);
+    IF Okay THEN
+      WHILE ch >= " " DO
+        IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
+        Read(f, ch);
+        WHILE (ch = BS) OR (ch = DEL) DO
+          IF j > 0 THEN DEC(j) END; Read(f, ch)
+        END
+      END;
+      IF j <= HIGH(str) THEN str[j] := 0C END;
+      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
+    END
+  END ReadLine;
+
+PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR);
+  VAR
+    j: CARDINAL;
+    ch: CHAR;
+  BEGIN
+    str[0] := 0C; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    REPEAT Read(f, ch) UNTIL (ch > " ") OR ~ Okay;
+    IF Okay THEN
+      WHILE ch > " " DO
+        IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
+        Read(f, ch);
+        WHILE (ch = BS) OR (ch = DEL) DO
+          IF j > 0 THEN DEC(j) END; Read(f, ch)
+        END
+      END;
+      IF j <= HIGH(str) THEN str[j] := 0C END;
+      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
+    END
+  END ReadToken;
+
+PROCEDURE ReadInt (f: File; VAR i: INTEGER);
+  VAR
+    Digit: INTEGER;
+    j: CARDINAL;
+    Negative: BOOLEAN;
+    s: ARRAY [0 .. 80] OF CHAR;
+  BEGIN
+    i := 0; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    ReadToken(f, s);
+    IF s[0] = "-" (* deal with sign *)
+      THEN Negative := TRUE; INC(j)
+      ELSE Negative := FALSE; IF s[0] = "+" THEN INC(j) END
+    END;
+    IF (s[j] < "0") OR (s[j] > "9") THEN Okay := FALSE END;
+    WHILE (j <= 80) & (s[j] >= "0") & (s[j] <= "9") DO
+      Digit := VAL(INTEGER, ORD(s[j]) - ORD("0"));
+      IF i <= (MAX(INTEGER) - Digit) DIV 10
+        THEN i := 10 * i + Digit
+        ELSE Okay := FALSE
+      END;
+      INC(j)
+    END;
+    IF Negative THEN i := -i END;
+    IF (j > 80) OR (s[j] # 0C) THEN Okay := FALSE END;
+    IF ~ Okay THEN i := 0 END;
+  END ReadInt;
+
+PROCEDURE ReadCard (f: File; VAR i: CARDINAL);
+  VAR
+    Digit: CARDINAL;
+    j: CARDINAL;
+    s: ARRAY [0 .. 80] OF CHAR;
+  BEGIN
+    i := 0; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    ReadToken(f, s);
+    WHILE (j <= 80) & (s[j] >= "0") & (s[j] <= "9") DO
+      Digit := ORD(s[j]) - ORD("0");
+      IF i <= (MAX(CARDINAL) - Digit) DIV 10
+        THEN i := 10 * i + Digit
+        ELSE Okay := FALSE
+      END;
+      INC(j)
+    END;
+    IF (j > 80) OR (s[j] # 0C) THEN Okay := FALSE END;
+    IF ~ Okay THEN i := 0 END;
+  END ReadCard;
+
+PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL);
+  VAR
+    TooMany: BOOLEAN;
+    Wanted: CARDINAL;
+  BEGIN
+    IF NotRead(f) OR (f = con)
+      THEN Okay := FALSE; len := 0;
+      ELSE
+        IF len = 0 THEN Okay := TRUE; RETURN END;
+        TooMany := len - 1 > HIGH(buf);
+        IF TooMany THEN Wanted := HIGH(buf) + 1 ELSE Wanted := len END;
+        IOChan.RawRead(f^.ref, SYSTEM.ADR(buf), Wanted, Wanted);
+        Okay := Wanted # 0;
+        IF len # Wanted THEN Okay := FALSE END;
+        len := Wanted;
+    END;
+    IF ~ Okay THEN f^.eof := TRUE END;
+    IF TooMany THEN Okay := FALSE END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; len := 0; RETURN
+*)
+  END ReadBytes;
+
+PROCEDURE Write (f: File; ch: CHAR);
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    Okay := TRUE;
+    IF ch = EOL
+      THEN (* implementation may not support Text operations on all files *)
+        IF f^.textOK 
+          THEN TextIO.WriteLn(f^.ref)
+          ELSE ch := LF; RawIO.Write(f^.ref, ch)
+              (* but you may have to write CR/LF or CR or LF *)
+        END
+      ELSE 
+        IF f^.textOK
+          THEN TextIO.WriteChar(f^.ref, ch)
+          ELSE RawIO.Write(f^.ref, ch)
+        END
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN
+*)
+  END Write;
+
+PROCEDURE WriteLn (f: File);
+  BEGIN
+    IF NotWrite(f)
+      THEN Okay := FALSE;
+      ELSE Write(f, EOL)
+    END
+  END WriteLn;
+
+PROCEDURE WriteString (f: File; str: ARRAY OF CHAR);
+  VAR
+    pos: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    pos := 0;
+    WHILE (pos <= HIGH(str)) & (str[pos] # 0C) DO
+      Write(f, str[pos]); INC(pos)
+    END
+  END WriteString;
+
+PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER);
+  VAR
+    i, slen: INTEGER;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    slen := LENGTH(text);
+    FOR i := 0 TO len - 1 DO
+      IF i < slen THEN Write(f, text[i]) ELSE Write(f, " ") END;
+    END
+  END WriteText;
+
+PROCEDURE WriteInt (f: File; n: INTEGER; wid: CARDINAL);
+  VAR
+    l, d: CARDINAL;
+    x: INTEGER;
+    t: ARRAY [1 .. 25] OF CHAR;
+    sign: CHAR;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    IF n < 0
+      THEN sign := "-"; x := - n;
+      ELSE sign := " "; x := n;
+    END;
+    l := 0;
+    REPEAT
+      d := x MOD 10; x := x DIV 10;
+      INC(l); t[l] := CHR(ORD("0") + d);
+    UNTIL x = 0;
+    IF wid = 0 THEN Write(f, " ") END;
+    WHILE wid > l + 1 DO Write(f, " "); DEC(wid); END;
+    IF (sign = "-") OR (wid > l) THEN Write(f, sign); END;
+    WHILE l > 0 DO Write(f, t[l]); DEC(l); END;
+  END WriteInt;
+
+PROCEDURE WriteCard (f: File; n, wid: CARDINAL);
+  VAR
+    l, d: CARDINAL;
+    t: ARRAY [1 .. 25] OF CHAR;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    l := 0;
+    REPEAT
+      d := n MOD 10; n := n DIV 10;
+      INC(l); t[l] := CHR(ORD("0") + d);
+    UNTIL n = 0;
+    IF wid = 0 THEN Write(f, " ") END;
+    WHILE wid > l DO Write(f, " "); DEC(wid); END;
+    WHILE l > 0 DO Write(f, t[l]); DEC(l); END;
+  END WriteCard;
+
+PROCEDURE WriteBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; len: CARDINAL);
+  VAR
+    TooMany: BOOLEAN;
+  BEGIN
+    TooMany := (len > 0) & (len - 1 > HIGH(buf));
+    IF NotWrite(f) OR (f = con) OR (f = err)
+      THEN
+        Okay := FALSE
+      ELSE
+        Okay := TRUE;
+        IF TooMany THEN len := HIGH(buf) + 1 END;
+        IOChan.RawWrite(f^.ref, SYSTEM.ADR(buf), len);
+    END;
+    IF TooMany THEN Okay := FALSE END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN
+*)
+  END WriteBytes;
+
+PROCEDURE GetDate (VAR Year, Month, Day: CARDINAL);
+  VAR
+    time: SysClock.DateTime;
+  BEGIN
+    SysClock.GetClock(time);
+    Year := time.year;
+    Month := time.month;
+    Day := time.day;
+  END GetDate;
+
+PROCEDURE GetTime (VAR Hrs, Mins, Secs, Hsecs: CARDINAL);
+  VAR
+    time: SysClock.DateTime;
+  BEGIN
+    SysClock.GetClock(time);
+    Hrs := time.hour;
+    Mins := time.minute;
+    Secs := time.second;
+    Hsecs := time.fractions;
+  END GetTime;
+
+PROCEDURE Write2 (f: File; i: CARDINAL);
+  BEGIN
+    Write(f, CHR(i DIV 10 + ORD("0")));
+    Write(f, CHR(i MOD 10 + ORD("0")));
+  END Write2;
+
+PROCEDURE WriteDate (f: File);
+  VAR
+    Year, Month, Day: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetDate(Year, Month, Day);
+    Write2(f, Day); Write(f, "/"); Write2(f, Month); Write(f, "/");
+    WriteCard(f, Year, 1)
+  END WriteDate;
+
+PROCEDURE WriteTime (f: File);
+  VAR
+    Hrs, Mins, Secs, Hsecs: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetTime(Hrs, Mins, Secs, Hsecs);
+    Write2(f, Hrs); Write(f, ":"); Write2(f, Mins); Write(f, ":");
+    Write2(f, Secs)
+  END WriteTime;
+
+VAR
+  Hrs0, Mins0, Secs0, Hsecs0: CARDINAL;
+  Hrs1, Mins1, Secs1, Hsecs1: CARDINAL;
+
+PROCEDURE WriteElapsedTime (f: File);
+  VAR
+    Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetTime(Hrs, Mins, Secs, Hsecs);
+    WriteString(f, "Elapsed time: ");
+    IF Hrs >= Hrs1
+      THEN s := (Hrs - Hrs1) * 3600 + (Mins - Mins1) * 60 + Secs - Secs1
+      ELSE s := (Hrs + 24 - Hrs1) * 3600 + (Mins - Mins1) * 60 + Secs - Secs1
+    END;
+    IF Hsecs >= Hsecs1
+      THEN hs := Hsecs - Hsecs1
+      ELSE hs := (Hsecs + 100) - Hsecs1; DEC(s);
+    END;
+    WriteCard(f, s, 1); Write(f, ".");
+    Write2(f, hs); WriteString(f, " s"); WriteLn(f);
+    Hrs1 := Hrs; Mins1 := Mins; Secs1 := Secs; Hsecs1 := Hsecs;
+  END WriteElapsedTime;
+
+PROCEDURE WriteExecutionTime (f: File);
+  VAR
+    Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetTime(Hrs, Mins, Secs, Hsecs);
+    WriteString(f, "Execution time: ");
+    IF Hrs >= Hrs0
+      THEN s := (Hrs - Hrs0) * 3600 + (Mins - Mins0) * 60 + Secs - Secs0
+      ELSE s := (Hrs + 24 - Hrs0) * 3600 + (Mins - Mins0) * 60 + Secs - Secs0
+    END;
+    IF Hsecs >= Hsecs0
+      THEN hs := Hsecs - Hsecs0
+      ELSE hs := (Hsecs + 100) - Hsecs0; DEC(s);
+    END;
+    WriteCard(f, s, 1); Write(f, "."); Write2(f, hs);
+    WriteString(f, " s"); WriteLn(f);
+  END WriteExecutionTime;
+
+(* The code for the next four procedures below may be commented out if your
+   compiler supports ISO PROCEDURE constant declarations and these declarations
+   are made in the DEFINITION MODULE *)
+
+PROCEDURE SLENGTH (stringVal: ARRAY OF CHAR): CARDINAL;
+  BEGIN
+    RETURN LENGTH(stringVal)
+  END SLENGTH;
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  BEGIN
+  (* Be careful - some libraries have the parameters reversed! *)
+    Strings.Assign(source, destination)
+  END Assign;
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   numberToExtract: CARDINAL; VAR destination: ARRAY OF CHAR);
+  BEGIN
+    Strings.Extract(source, startIndex, numberToExtract, destination)
+  END Extract;
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  BEGIN
+    Strings.Concat(source1, source2, destination);
+  END Concat;
+
+(* The code for the four procedures above may be commented out if your
+   compiler supports ISO PROCEDURE constant declarations and these declarations
+   are made in the DEFINITION MODULE *)
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
+  BEGIN
+    RETURN VAL(INTEGER, Strings.Compare(stringVal1, stringVal2)) - 1;
+  END Compare;
+
+PROCEDURE ORDL (n: INT32): CARDINAL;
+   BEGIN RETURN VAL(CARDINAL, n) END ORDL;
+
+PROCEDURE INTL (n: INT32): INTEGER;
+   BEGIN RETURN VAL(INTEGER, n) END INTL;
+
+PROCEDURE INT (n: CARDINAL): INT32;
+   BEGIN RETURN VAL(INT32, n) END INT;
+
+PROCEDURE CloseAll;
+  VAR
+    handle: CARDINAL;
+  BEGIN
+    FOR handle := 0 TO MaxFiles - 1 DO
+      IF handle IN Handles THEN Close(Opened[handle]) END
+    END;
+  END CloseAll;
+
+PROCEDURE QuitExecution;
+  BEGIN
+    HALT
+  END QuitExecution;
+
+BEGIN
+  CheckRedirection; (* Not apparently available on many systems *)
+  ProgramArgs.NextArg(); (* Not necessary on some systems *)
+  GetTime(Hrs0, Mins0, Secs0, Hsecs0);
+  Hrs1 := Hrs0; Mins1 := Mins0; Secs1 := Secs0; Hsecs1 := Hsecs0;
+  Handles := BITSET{};
+  Okay := FALSE; EOFChar := 04C;
+
+  ALLOCATE(con, SYSTEM.TSIZE(FileRec));
+  TermFile.Open(con^.ref, TermFile.read + TermFile.write + TermFile.text
+                + TermFile.echo, res);
+  con^.savedCh := 0C; con^.haveCh := FALSE; con^.self := con;
+  con^.noOutput := FALSE; con^.noInput := FALSE; con^.textOK := TRUE;
+  con^.eof := FALSE; con^.eol := FALSE;
+
+  ALLOCATE(StdIn, SYSTEM.TSIZE(FileRec));
+  StdIn^.ref := StdChans.StdInChan();
+  StdIn^.savedCh := 0C; StdIn^.haveCh := FALSE; StdIn^.self := StdIn;
+  StdIn^.noOutput := TRUE; StdIn^.noInput := FALSE; StdIn^.textOK := TRUE;
+  StdIn^.eof := FALSE; StdIn^.eol := FALSE;
+
+  ALLOCATE(StdOut, SYSTEM.TSIZE(FileRec));
+  StdOut^.ref := StdChans.StdOutChan();
+  StdOut^.savedCh := 0C; StdOut^.haveCh := FALSE; StdOut^.self := StdOut;
+  StdOut^.noOutput := FALSE; StdOut^.noInput := TRUE; StdOut^.textOK := TRUE;
+  StdOut^.eof := TRUE; StdOut^.eol := TRUE;
+
+  ALLOCATE(err, SYSTEM.TSIZE(FileRec));
+  err^.ref := StdChans.StdErrChan();
+  err^.savedCh := 0C; err^.haveCh := FALSE; err^.self := err;
+  err^.noOutput := FALSE; err^.noInput := TRUE; err^.textOK := TRUE;
+  err^.eof := TRUE; err^.eol := TRUE;
+
+(* 
+  FINALLY (* For ISO compilers *)
+  (* Preferably find some way to install CloseAll as an at-exit procedure *)
+  CloseAll;
+*)
+END FileIO.

M2c.atg

@@ -0,0 +1,36 @@
+COMPILER M2c
+(* Phase 0: module skeleton only.
+   Accepts "MODULE <name> ; [ BEGIN ] END <name> ." and checks that
+   the closing name matches (error 202). No declarations, no
+   statements, no symbol table yet — those arrive in Phase 1. *)
+
+CHARACTERS
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit  = "0123456789" .
+
+IGNORE CHR(9) .. CHR(13)
+
+COMMENTS
+  FROM "(*" TO "*)" NESTED
+
+TOKENS
+  ident = letter { letter | digit } .
+
+PRODUCTIONS
+  M2c                             (. VAR m1, m2: ARRAY [0 .. 63] OF CHAR;
+                                       i: CARDINAL; same: BOOLEAN; .)
+    = "MODULE" ident              (. LexName(m1); .)
+      ";" [ "BEGIN" ] "END"
+      ident                       (. LexName(m2);
+                                     i := 0; same := TRUE;
+                                     WHILE same & ((m1[i] # 0C)
+                                           OR (m2[i] # 0C)) DO
+                                       IF m1[i] # m2[i] THEN
+                                         same := FALSE
+                                       END;
+                                       INC(i)
+                                     END;
+                                     IF ~same THEN SemError(202) END; .)
+      "." .
+
+END M2c.

M2c.err

@@ -0,0 +1,8 @@
+   0: Msg("EOF expected")
+|  1: Msg("ident expected")
+|  2: Msg("'MODULE' expected")
+|  3: Msg("';' expected")
+|  4: Msg("'BEGIN' expected")
+|  5: Msg("'END' expected")
+|  6: Msg("'.' expected")
+|  7: Msg("not expected")

M2c.lst

@@ -0,0 +1,24 @@
+Coco/R - Compiler-Compiler V1.53
+Released by Pat Terry 17 September 2002
+Source file: M2c.atg
+
+Grammar Tests:
+
+Deletable symbols:        -- none --
+Undefined nonterminals:   -- none --
+Unreachable nonterminals: -- none --
+Circular derivations:     -- none --
+Underivable nonterminals: -- none --
+LL(1) conditions:         --  ok  --
+
+Statistics:
+
+  nr of terminals:         8 (limit   400)
+  nr of non-terminals:     1 (limit   210)
+  nr of pragmas:           0 (limit   492)
+  nr of symbolnodes:       9 (limit   500)
+  nr of graphnodes:       12 (limit  1500)
+  nr of conditionsets:     1 (limit   100)
+  nr of charactersets:     3 (limit   250)
+
+

M2c.mod

@@ -0,0 +1,221 @@
+MODULE M2c;
+(* Minimal main module for the M2c Modula-2 compiler (Coco/R).
+   Assumes the FileIO/Storage I/O libraries and the generated
+   <Grammar>S (scanner) and <Grammar>P (parser) modules. *)
+
+  FROM M2cS IMPORT lst, src, errors, Error, CharAt;
+  FROM M2cP IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+
+  TYPE
+    INT32 = FileIO.INT32 (* 32 bit integers needed *);
+
+  MODULE ListHandler;
+  (* ------------------- Source Listing and Error handler -------------- *)
+    FROM FileIO IMPORT CR, LF, EOF, WriteString, Write, WriteLn, WriteInt, Long0;
+    FROM Storage IMPORT ALLOCATE;
+    FROM SYSTEM IMPORT TSIZE;
+    IMPORT lst, CharAt, errors, INT32;
+    EXPORT StoreError, PrintListing;
+
+    TYPE
+      Err = POINTER TO ErrDesc;
+      ErrDesc = RECORD
+        nr, line, col: INTEGER;
+        next: Err
+      END;
+
+    CONST
+      tab = 11C;
+
+    VAR
+      firstErr, lastErr: Err;
+      Extra: INTEGER;
+
+    PROCEDURE StoreError (nr, line, col: INTEGER; pos: INT32);
+    (* Store an error message for later printing *)
+      VAR
+        nextErr: Err;
+      BEGIN
+        ALLOCATE(nextErr, TSIZE(ErrDesc));
+        nextErr^.nr := nr; nextErr^.line := line; nextErr^.col := col;
+        nextErr^.next := NIL;
+        IF firstErr = NIL
+          THEN firstErr := nextErr
+          ELSE lastErr^.next := nextErr
+        END;
+        lastErr := nextErr;
+        INC(errors)
+      END StoreError;
+
+    PROCEDURE GetLine (VAR pos: INT32;
+                       VAR line: ARRAY OF CHAR;
+                       VAR eof: BOOLEAN);
+    (* Read a source line. Return empty line if eof *)
+      VAR
+        ch: CHAR;
+        i: CARDINAL;
+      BEGIN
+        i := 0; eof := FALSE; ch := CharAt(pos); INC(pos);
+        WHILE (ch # CR) & (ch # LF) & (ch # EOF) DO
+          line[i] := ch; INC(i); ch := CharAt(pos); INC(pos);
+        END;
+        eof := (i = 0) & (ch = EOF); line[i] := 0C;
+        IF ch = CR THEN (* check for MsDos *)
+          ch := CharAt(pos);
+          IF ch = LF THEN INC(pos); Extra := 0 END
+        END
+      END GetLine;
+
+    PROCEDURE PrintErr (line: ARRAY OF CHAR; nr, col: INTEGER);
+    (* Print an error message *)
+
+      PROCEDURE Msg (s: ARRAY OF CHAR);
+        BEGIN
+          WriteString(lst, s)
+        END Msg;
+
+      PROCEDURE Pointer;
+        VAR
+          i: INTEGER;
+        BEGIN
+          WriteString(lst, "*****  ");
+          i := 0;
+          WHILE i < col + Extra - 2 DO
+            IF line[i] = tab
+              THEN Write(lst, tab)
+              ELSE Write(lst, ' ')
+            END;
+            INC(i)
+          END;
+          WriteString(lst, "^ ")
+        END Pointer;
+
+      BEGIN
+        Pointer;
+        CASE nr OF
+           0: Msg("EOF expected")
+        |  1: Msg("ident expected")
+        |  2: Msg("'MODULE' expected")
+        |  3: Msg("';' expected")
+        |  4: Msg("'BEGIN' expected")
+        |  5: Msg("'END' expected")
+        |  6: Msg("'.' expected")
+        |  7: Msg("not expected")
+        
+        (* add customized cases here *)
+        | 202: Msg("module name mismatch")
+        ELSE         Msg("Error: "); WriteInt(lst, nr, 0);
+        END;
+        WriteLn(lst)
+      END PrintErr;
+
+    PROCEDURE PrintListing;
+    (* Print a source listing with error messages *)
+      VAR
+        nextErr: Err;
+        eof: BOOLEAN;
+        lnr, errC: INTEGER;
+        srcPos: INT32;
+        line: ARRAY [0 .. 255] OF CHAR;
+      BEGIN
+        WriteString(lst, "Listing:");
+        WriteLn(lst); WriteLn(lst);
+        srcPos := 0; nextErr := firstErr;
+        GetLine(srcPos, line, eof); lnr := 1; errC := 0;
+        WHILE ~ eof DO
+          WriteInt(lst, lnr, 5); WriteString(lst, "  ");
+          WriteString(lst, line); WriteLn(lst);
+          WHILE (nextErr # NIL) & (nextErr^.line = lnr) DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END;
+          GetLine(srcPos, line, eof); INC(lnr);
+        END;
+        IF nextErr # NIL THEN
+          WriteInt(lst, lnr, 5); WriteLn(lst);
+          WHILE nextErr # NIL DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END
+        END;
+        WriteLn(lst);
+        WriteInt(lst, errC, 5); WriteString(lst, " error");
+        IF errC # 1 THEN Write(lst, 's') END;
+        WriteLn(lst); WriteLn(lst); WriteLn(lst);
+      END PrintListing;
+
+    BEGIN
+      firstErr := NIL; Extra := 1;
+    END ListHandler;
+
+  (* --------------------------- main module ------------------------------- *)
+
+  PROCEDURE ChangeExtension (oldName, Ext: ARRAY OF CHAR;
+                             VAR newName: ARRAY OF CHAR);
+  (* Constructs newName by replacing the extension of oldName with Ext. *)
+    VAR
+      i, l: CARDINAL;
+    BEGIN
+      Strings.Assign(oldName, newName);
+      i := LENGTH(oldName); l := i;
+      WHILE (i > 0) & (oldName[i -1] # '.')
+            & (oldName[i -1] # '\') & (oldName[i -1] # '/') DO
+        DEC(i)
+      END;
+      IF (i > 0) & (oldName[i-1] = '.') THEN
+        Strings.Delete(newName, i - 1, l + 1 - i)
+      END;
+      IF Ext[0] = '.' THEN Strings.Delete(Ext, 0, 1) END;
+      Strings.Append(".", newName);
+      Strings.Append(Ext, newName)
+    END ChangeExtension;
+
+  VAR
+    sourceName, listName: ARRAY [0 .. 255] OF CHAR;
+
+  BEGIN
+    (* check on correct parameter usage *)
+    FileIO.NextParameter(sourceName);
+    IF sourceName[0] = 0C THEN
+      FileIO.WriteString(FileIO.StdOut, "No input file specified");
+      HALT
+    END;
+
+    (* open the source file - Scanner.src *)
+    FileIO.Open(src, sourceName, FALSE);
+    IF ~ FileIO.Okay THEN
+      FileIO.WriteString(FileIO.StdOut, "Could not open input file");
+      FileIO.WriteLn(FileIO.StdOut);
+      HALT
+    END;
+
+    (* open the output file for the source listing - Scanner.lst *)
+    ChangeExtension(sourceName, ".LST", listName);
+    FileIO.Open(lst, listName, TRUE);
+    IF ~ FileIO.Okay THEN
+      FileIO.WriteString(FileIO.StdOut, "Could not open listing file");
+      FileIO.WriteLn(FileIO.StdOut);
+      (* default Scanner.lst to screen *) lst := FileIO.StdOut;
+    END;
+
+    (* install error reporting procedure - Scanner.Error *)
+    Error := StoreError;
+
+    (* instigate the compilation - Parser.Parse *)
+    FileIO.WriteString(FileIO.StdOut, "Parsing"); FileIO.WriteLn(FileIO.StdOut);
+    Parse;
+
+    (* generate the source listing on lst file *)
+    PrintListing;
+    IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
+
+    (* examine the outcome *)
+    IF NOT Successful()
+      THEN
+        FileIO.WriteString(FileIO.StdOut, "Incorrect source");
+      ELSE
+        FileIO.WriteString(FileIO.StdOut, "Parsed correctly");
+    END;
+  END M2c.

M2cP.def

@@ -0,0 +1,28 @@
+DEFINITION MODULE M2cP;
+
+(* Parser generated by Coco/R *)
+
+PROCEDURE Parse;
+
+PROCEDURE Successful (): BOOLEAN;
+(* Returns TRUE if no errors have been recorded while parsing *)
+
+PROCEDURE SynError (errNo: INTEGER);
+(* Report syntax error errNo *)
+
+PROCEDURE SemError (errNo: INTEGER);
+(* Report semantic error errNo *)
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of current token *)
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of current token (capitalized if IGNORE CASE) *)
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of lookahead token *)
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of lookahead token (capitalized if IGNORE CASE) *)
+
+END M2cP.

M2cP.mod

@@ -0,0 +1,158 @@
+IMPLEMENTATION MODULE M2cP;
+
+(* Parser generated by Coco/R - assuming ISO IO library will be available. *)
+
+IMPORT M2cS, FileIO;
+
+
+
+CONST 
+  maxT = 7;
+  minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
+  setsize     = 16;  (* sets are stored in 16 bits *)
+
+TYPE
+  SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;
+
+VAR
+  symSet:  ARRAY [0 ..   0] OF SymbolSet; (*symSet[0] = allSyncSyms*)
+  errDist: CARDINAL;   (* number of symbols recognized since last error *)
+  sym:     CARDINAL;   (* current input symbol *)
+
+PROCEDURE SemError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      M2cS.Error(errNo, M2cS.line, M2cS.col, M2cS.pos);
+    END;
+    errDist := 0;
+  END SemError;
+
+PROCEDURE SynError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      M2cS.Error(errNo, M2cS.nextLine, M2cS.nextCol, M2cS.nextPos);
+    END;
+    errDist := 0;
+  END SynError;
+
+PROCEDURE Get;
+  VAR
+    s: ARRAY [0 .. 31] OF CHAR;
+  BEGIN
+    REPEAT
+      M2cS.Get(sym);
+      IF sym <= maxT THEN
+        INC(errDist);
+      ELSE
+        
+      END;
+    UNTIL sym <= maxT
+  END Get;
+
+PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN;
+  BEGIN
+    RETURN x MOD setsize IN s[x DIV setsize];
+  END In;
+
+PROCEDURE Expect (n: CARDINAL);
+  BEGIN
+    IF sym = n THEN Get ELSE SynError(n) END
+  END Expect;
+
+PROCEDURE ExpectWeak (n, follow: CARDINAL);
+  BEGIN
+    IF sym = n
+      THEN Get
+      ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END
+    END
+  END ExpectWeak;
+
+PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN;
+  VAR
+    s: SymbolSet;
+    i: CARDINAL;
+  BEGIN
+    IF sym = n
+      THEN Get; RETURN TRUE
+      ELSIF In(symSet[repFol], sym) THEN RETURN FALSE
+      ELSE
+        i := 0;
+        WHILE i <= maxT DIV setsize DO
+          s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
+        END;
+        SynError(n); WHILE ~ In(s, sym) DO Get END;
+        RETURN In(symSet[syFol], sym)
+    END
+  END WeakSeparator;
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2cS.GetName(M2cS.pos, M2cS.len, Lex)
+  END LexName;
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2cS.GetString(M2cS.pos, M2cS.len, Lex)
+  END LexString;
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2cS.GetName(M2cS.nextPos, M2cS.nextLen, Lex)
+  END LookAheadName;
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2cS.GetString(M2cS.nextPos, M2cS.nextLen, Lex)
+  END LookAheadString;
+
+PROCEDURE Successful (): BOOLEAN;
+  BEGIN
+    RETURN M2cS.errors = 0
+  END Successful;
+
+(* ----- FORWARD not needed in multipass compilers
+
+PROCEDURE M2c; FORWARD;
+
+----- *)
+
+PROCEDURE M2c;
+  VAR m1, m2: ARRAY [0 .. 63] OF CHAR;
+    i: CARDINAL; same: BOOLEAN;
+  BEGIN
+    Expect(2);
+    Expect(1);
+    LexName(m1);;
+    Expect(3);
+    IF (sym = 4) THEN
+      Get;
+    END;
+    Expect(5);
+    Expect(1);
+    LexName(m2);
+    i := 0; same := TRUE;
+    WHILE same & ((m1[i] # 0C)
+          OR (m2[i] # 0C)) DO
+      IF m1[i] # m2[i] THEN
+        same := FALSE
+      END;
+      INC(i)
+    END;
+    IF ~same THEN SemError(202) END;;
+    Expect(6);
+  END M2c;
+
+
+
+PROCEDURE Parse;
+  BEGIN
+    M2cS.Reset; Get;
+    M2c;
+
+  END Parse;
+
+BEGIN
+  errDist := minErrDist;
+  symSet[ 0, 0] := BITSET{0};
+END M2cP.
+

M2cS.def

@@ -0,0 +1,39 @@
+DEFINITION MODULE M2cS;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO;
+
+TYPE
+  INT32 = FileIO.INT32 (* need 32 bit integers *);
+
+VAR
+  src, lst:    FileIO.File;(*source/list files. To be opened by the main pgm*)
+  directory:   ARRAY [0 .. 255] OF CHAR (*of source file*);
+  line, col:   INTEGER;      (*line and column of current symbol*)
+  len:         CARDINAL;     (*length of current symbol*)
+  pos:         INT32;        (*file position of current symbol*)
+  nextLine:    INTEGER;      (*line of lookahead symbol*)
+  nextCol:     INTEGER;      (*column of lookahead symbol*)
+  nextLen:     CARDINAL;     (*length of lookahead symbol*)
+  nextPos:     INT32;        (*file position of lookahead symbol*)
+  errors:      INTEGER;      (*number of detected errors*)
+  Error:       PROCEDURE ((*nr*)INTEGER, (*line*)INTEGER, (*col*)INTEGER,
+                          (*pos*)INT32);
+
+PROCEDURE Get (VAR sym: CARDINAL);
+(* Gets next symbol from source file *)
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves exact string of max length len from position pos in source file *)
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves name of symbol of length len at position pos in source file *)
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+(* Returns exact character at position pos in source file *)
+
+PROCEDURE Reset;
+(* Reads and stores source file internally *)
+
+END M2cS.

M2cS.mod

@@ -0,0 +1,267 @@
+IMPLEMENTATION MODULE M2cS;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO, Storage;
+
+CONST
+  noSYMB  = 7; (*error token code*)
+  (* not only for errors but also for not finished states of scanner analysis *)
+  eof     = 32C (* MS-DOS Keyboard eof char *);
+  EOF     = 0C;
+  EOL     = 15C;
+  CR      = 15C;
+  LF      = 12C;
+  Long0   = 0;
+  Long1   = 1;
+  BlkSize = 16384;
+TYPE
+  BufBlock   = ARRAY [0 .. BlkSize-1] OF CHAR;
+  Buffer     = ARRAY [0 .. 31] OF POINTER TO BufBlock;
+  StartTable = ARRAY [0 .. 255] OF INTEGER;
+  GetCH      = PROCEDURE (INT32): CHAR;
+VAR
+  lastCh,
+  ch:        CHAR;       (*current input character*)
+  curLine:   INTEGER;    (*current input line (may be higher than line)*)
+  lineStart: INT32;      (*start position of current line*)
+  apx:       INT32;      (*length of appendix (CONTEXT phrase)*)
+  oldEols:   INTEGER;    (*number of EOLs in a comment*)
+  bp, bp0:   INT32;      (*current position in buf
+                           (bp0: position of current token)*)
+  inputLen:  INT32;      (*source file size*)
+  buf:       Buffer;     (*source buffer for low-level access*)
+  start:     StartTable; (*start state for every character*)
+  CurrentCh: GetCH;
+
+PROCEDURE Err (nr, line, col: INTEGER; pos: INT32);
+  BEGIN
+    INC(errors)
+  END Err;
+
+PROCEDURE NextCh;
+(* Return global variable ch *)
+  BEGIN
+    lastCh := ch; INC(bp); ch := CurrentCh(bp);
+    IF (ch = EOL) OR (ch = LF) AND (lastCh # EOL) THEN
+      INC(curLine); lineStart := bp
+    END
+  END NextCh;
+
+PROCEDURE Comment (): BOOLEAN;
+  VAR
+    level, startLine: INTEGER;
+    oldLineStart: INT32;
+  BEGIN
+    level := 1; startLine := curLine; oldLineStart := lineStart;
+    IF (ch = "(") THEN
+      NextCh;
+      IF (ch = "*") THEN
+        NextCh;
+        LOOP
+          IF (ch = "*") THEN
+            NextCh;
+            IF (ch = ")") THEN
+              DEC(level); NextCh;
+              IF level = 0 THEN RETURN TRUE END
+            END;
+          ELSIF (ch = "(") THEN
+            NextCh;
+            IF (ch = "*") THEN INC(level); NextCh END;
+          ELSIF ch = EOF THEN RETURN FALSE
+          ELSE NextCh END;
+        END; (* LOOP *)
+      ELSE
+        IF (ch = CR) OR (ch = LF) THEN
+          DEC(curLine); lineStart := oldLineStart
+        END;
+        DEC(bp); ch := lastCh;
+      END;
+    END;
+    RETURN FALSE;
+  END Comment;
+
+PROCEDURE Get (VAR sym: CARDINAL);
+  VAR
+    state: CARDINAL;
+
+  PROCEDURE Equal (s: ARRAY OF CHAR): BOOLEAN;
+    VAR
+      i: CARDINAL;
+      q: INT32;
+    BEGIN
+      IF nextLen # LENGTH(s) THEN RETURN FALSE END;
+      i := 1; q := bp0; INC(q);
+      WHILE i < nextLen DO
+        IF CurrentCh(q) # s[i] THEN RETURN FALSE END;
+        INC(i); INC(q)
+      END;
+      RETURN TRUE
+    END Equal;
+
+  PROCEDURE CheckLiteral;
+    BEGIN
+      CASE CurrentCh(bp0) OF
+        "B": IF Equal("BEGIN") THEN sym := 4; 
+             END
+      | "E": IF Equal("END") THEN sym := 5; 
+             END
+      | "M": IF Equal("MODULE") THEN sym := 2; 
+             END
+      ELSE
+      END
+    END CheckLiteral;
+
+  BEGIN (*Get*)
+    WHILE (ch = ' ') OR
+          ((ch >= CHR(9)) & (ch <= CHR(13))) DO NextCh END;
+    IF ((ch = "(")) & Comment() THEN Get(sym); RETURN END;
+    pos := nextPos;   nextPos := bp;
+    col := nextCol;   nextCol := VAL(INTEGER, bp - lineStart);
+    line := nextLine; nextLine := curLine;
+    len := nextLen;   nextLen := 0;
+    apx := 0; state := start[ORD(ch)]; bp0 := bp;
+    LOOP
+      NextCh; INC(nextLen);
+      CASE state OF
+         1: IF ((ch >= "0") & (ch <= "9") OR
+               (ch >= "A") & (ch <= "Z") OR
+               (ch >= "a") & (ch <= "z")) THEN 
+            ELSE sym := 1; CheckLiteral; RETURN
+            END;
+      |  2: sym := 3; RETURN
+      |  3: sym := 6; RETURN
+      |  4: sym := 0; ch := 0C; DEC(bp); RETURN
+      ELSE sym := noSYMB; RETURN (*NextCh already done*)
+      END
+    END
+  END Get;
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CharAt(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetString;
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CurrentCh(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetName;
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)];
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CharAt;
+
+PROCEDURE CapChAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := CAP(buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)]);
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CapChAt;
+
+PROCEDURE Reset;
+  VAR
+    i, read: CARDINAL;
+  BEGIN (*assert: src has been opened*)
+    i := 0; inputLen := 0;
+    REPEAT
+      Storage.ALLOCATE(buf[i], BlkSize);
+      read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
+      INC(i); INC(inputLen, VAL(INT32, read))
+    UNTIL read # BlkSize;
+    buf[i-1]^[read] := EOF;
+    curLine := 1; lineStart := -2; bp := -1;
+    oldEols := 0; apx := 0; errors := 0;
+    NextCh;
+  END Reset;
+
+BEGIN
+  CurrentCh := CharAt;
+  start[  0] :=  4; start[  1] :=  5; start[  2] :=  5; start[  3] :=  5; 
+  start[  4] :=  5; start[  5] :=  5; start[  6] :=  5; start[  7] :=  5; 
+  start[  8] :=  5; start[  9] :=  5; start[ 10] :=  5; start[ 11] :=  5; 
+  start[ 12] :=  5; start[ 13] :=  5; start[ 14] :=  5; start[ 15] :=  5; 
+  start[ 16] :=  5; start[ 17] :=  5; start[ 18] :=  5; start[ 19] :=  5; 
+  start[ 20] :=  5; start[ 21] :=  5; start[ 22] :=  5; start[ 23] :=  5; 
+  start[ 24] :=  5; start[ 25] :=  5; start[ 26] :=  5; start[ 27] :=  5; 
+  start[ 28] :=  5; start[ 29] :=  5; start[ 30] :=  5; start[ 31] :=  5; 
+  start[ 32] :=  5; start[ 33] :=  5; start[ 34] :=  5; start[ 35] :=  5; 
+  start[ 36] :=  5; start[ 37] :=  5; start[ 38] :=  5; start[ 39] :=  5; 
+  start[ 40] :=  5; start[ 41] :=  5; start[ 42] :=  5; start[ 43] :=  5; 
+  start[ 44] :=  5; start[ 45] :=  5; start[ 46] :=  3; start[ 47] :=  5; 
+  start[ 48] :=  5; start[ 49] :=  5; start[ 50] :=  5; start[ 51] :=  5; 
+  start[ 52] :=  5; start[ 53] :=  5; start[ 54] :=  5; start[ 55] :=  5; 
+  start[ 56] :=  5; start[ 57] :=  5; start[ 58] :=  5; start[ 59] :=  2; 
+  start[ 60] :=  5; start[ 61] :=  5; start[ 62] :=  5; start[ 63] :=  5; 
+  start[ 64] :=  5; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
+  start[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
+  start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 
+  start[ 76] :=  1; start[ 77] :=  1; start[ 78] :=  1; start[ 79] :=  1; 
+  start[ 80] :=  1; start[ 81] :=  1; start[ 82] :=  1; start[ 83] :=  1; 
+  start[ 84] :=  1; start[ 85] :=  1; start[ 86] :=  1; start[ 87] :=  1; 
+  start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] :=  5; 
+  start[ 92] :=  5; start[ 93] :=  5; start[ 94] :=  5; start[ 95] :=  5; 
+  start[ 96] :=  5; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
+  start[100] :=  1; start[101] :=  1; start[102] :=  1; start[103] :=  1; 
+  start[104] :=  1; start[105] :=  1; start[106] :=  1; start[107] :=  1; 
+  start[108] :=  1; start[109] :=  1; start[110] :=  1; start[111] :=  1; 
+  start[112] :=  1; start[113] :=  1; start[114] :=  1; start[115] :=  1; 
+  start[116] :=  1; start[117] :=  1; start[118] :=  1; start[119] :=  1; 
+  start[120] :=  1; start[121] :=  1; start[122] :=  1; start[123] :=  5; 
+  start[124] :=  5; start[125] :=  5; start[126] :=  5; start[127] :=  5; 
+  start[128] :=  5; start[129] :=  5; start[130] :=  5; start[131] :=  5; 
+  start[132] :=  5; start[133] :=  5; start[134] :=  5; start[135] :=  5; 
+  start[136] :=  5; start[137] :=  5; start[138] :=  5; start[139] :=  5; 
+  start[140] :=  5; start[141] :=  5; start[142] :=  5; start[143] :=  5; 
+  start[144] :=  5; start[145] :=  5; start[146] :=  5; start[147] :=  5; 
+  start[148] :=  5; start[149] :=  5; start[150] :=  5; start[151] :=  5; 
+  start[152] :=  5; start[153] :=  5; start[154] :=  5; start[155] :=  5; 
+  start[156] :=  5; start[157] :=  5; start[158] :=  5; start[159] :=  5; 
+  start[160] :=  5; start[161] :=  5; start[162] :=  5; start[163] :=  5; 
+  start[164] :=  5; start[165] :=  5; start[166] :=  5; start[167] :=  5; 
+  start[168] :=  5; start[169] :=  5; start[170] :=  5; start[171] :=  5; 
+  start[172] :=  5; start[173] :=  5; start[174] :=  5; start[175] :=  5; 
+  start[176] :=  5; start[177] :=  5; start[178] :=  5; start[179] :=  5; 
+  start[180] :=  5; start[181] :=  5; start[182] :=  5; start[183] :=  5; 
+  start[184] :=  5; start[185] :=  5; start[186] :=  5; start[187] :=  5; 
+  start[188] :=  5; start[189] :=  5; start[190] :=  5; start[191] :=  5; 
+  start[192] :=  5; start[193] :=  5; start[194] :=  5; start[195] :=  5; 
+  start[196] :=  5; start[197] :=  5; start[198] :=  5; start[199] :=  5; 
+  start[200] :=  5; start[201] :=  5; start[202] :=  5; start[203] :=  5; 
+  start[204] :=  5; start[205] :=  5; start[206] :=  5; start[207] :=  5; 
+  start[208] :=  5; start[209] :=  5; start[210] :=  5; start[211] :=  5; 
+  start[212] :=  5; start[213] :=  5; start[214] :=  5; start[215] :=  5; 
+  start[216] :=  5; start[217] :=  5; start[218] :=  5; start[219] :=  5; 
+  start[220] :=  5; start[221] :=  5; start[222] :=  5; start[223] :=  5; 
+  start[224] :=  5; start[225] :=  5; start[226] :=  5; start[227] :=  5; 
+  start[228] :=  5; start[229] :=  5; start[230] :=  5; start[231] :=  5; 
+  start[232] :=  5; start[233] :=  5; start[234] :=  5; start[235] :=  5; 
+  start[236] :=  5; start[237] :=  5; start[238] :=  5; start[239] :=  5; 
+  start[240] :=  5; start[241] :=  5; start[242] :=  5; start[243] :=  5; 
+  start[244] :=  5; start[245] :=  5; start[246] :=  5; start[247] :=  5; 
+  start[248] :=  5; start[249] :=  5; start[250] :=  5; start[251] :=  5; 
+  start[252] :=  5; start[253] :=  5; start[254] :=  5; start[255] :=  5; 
+  Error := Err; lastCh := EOF;
+END M2cS.

build.sh

@@ -0,0 +1,32 @@
+#!/bin/sh
+#
+# Builds the M2c compiler (Phase 0: module skeleton).
+# Requires GNU Modula-2 (gm2) and the Coco/R CR binary.
+#
+# Usage: ./build.sh   (from the m2c directory)
+#
+# Pipeline: M2c.atg -> M2cS/M2cP/M2c (.mod) -> gm2 -fiso -> ./M2c
+#
+
+CRBIN="${CRBIN:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+
+echo "=== Regenerating M2cS / M2cP / M2c from M2c.atg ==="
+CRFRAMES="$(pwd)" "$CRBIN" -m -C M2c.atg || exit 1
+
+echo "=== Deleting all o files ==="
+rm -f ./*.o
+
+echo "=== Compiling the needed modules ==="
+for m in FileIO M2cS M2cP M2c; do
+  gm2 -fiso -c "$m.mod" || exit 1
+done
+
+echo "=== Phase 1: generating the module list ==="
+gm2 -fiso -fgen-module-list=modules.lst -o /dev/null \
+    M2cS.o M2cP.o FileIO.o M2c.mod || exit 1
+
+echo "=== Phase 2: compiling main module and linking using the module list ==="
+gm2 -fiso -fuse-list=modules.lst -o M2c \
+    M2cS.o M2cP.o FileIO.o M2c.mod || exit 1
+
+echo "=== M2c built ==="

compiler.frm

@@ -0,0 +1,213 @@
+MODULE -->Grammar;
+(* Minimal main module for the M2c Modula-2 compiler (Coco/R).
+   Assumes the FileIO/Storage I/O libraries and the generated
+   <Grammar>S (scanner) and <Grammar>P (parser) modules. *)
+
+  FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
+  FROM -->Parser IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+
+  TYPE
+    INT32 = FileIO.INT32 (* 32 bit integers needed *);
+
+  MODULE ListHandler;
+  (* ------------------- Source Listing and Error handler -------------- *)
+    FROM FileIO IMPORT CR, LF, EOF, WriteString, Write, WriteLn, WriteInt, Long0;
+    FROM Storage IMPORT ALLOCATE;
+    FROM SYSTEM IMPORT TSIZE;
+    IMPORT lst, CharAt, errors, INT32;
+    EXPORT StoreError, PrintListing;
+
+    TYPE
+      Err = POINTER TO ErrDesc;
+      ErrDesc = RECORD
+        nr, line, col: INTEGER;
+        next: Err
+      END;
+
+    CONST
+      tab = 11C;
+
+    VAR
+      firstErr, lastErr: Err;
+      Extra: INTEGER;
+
+    PROCEDURE StoreError (nr, line, col: INTEGER; pos: INT32);
+    (* Store an error message for later printing *)
+      VAR
+        nextErr: Err;
+      BEGIN
+        ALLOCATE(nextErr, TSIZE(ErrDesc));
+        nextErr^.nr := nr; nextErr^.line := line; nextErr^.col := col;
+        nextErr^.next := NIL;
+        IF firstErr = NIL
+          THEN firstErr := nextErr
+          ELSE lastErr^.next := nextErr
+        END;
+        lastErr := nextErr;
+        INC(errors)
+      END StoreError;
+
+    PROCEDURE GetLine (VAR pos: INT32;
+                       VAR line: ARRAY OF CHAR;
+                       VAR eof: BOOLEAN);
+    (* Read a source line. Return empty line if eof *)
+      VAR
+        ch: CHAR;
+        i: CARDINAL;
+      BEGIN
+        i := 0; eof := FALSE; ch := CharAt(pos); INC(pos);
+        WHILE (ch # CR) & (ch # LF) & (ch # EOF) DO
+          line[i] := ch; INC(i); ch := CharAt(pos); INC(pos);
+        END;
+        eof := (i = 0) & (ch = EOF); line[i] := 0C;
+        IF ch = CR THEN (* check for MsDos *)
+          ch := CharAt(pos);
+          IF ch = LF THEN INC(pos); Extra := 0 END
+        END
+      END GetLine;
+
+    PROCEDURE PrintErr (line: ARRAY OF CHAR; nr, col: INTEGER);
+    (* Print an error message *)
+
+      PROCEDURE Msg (s: ARRAY OF CHAR);
+        BEGIN
+          WriteString(lst, s)
+        END Msg;
+
+      PROCEDURE Pointer;
+        VAR
+          i: INTEGER;
+        BEGIN
+          WriteString(lst, "*****  ");
+          i := 0;
+          WHILE i < col + Extra - 2 DO
+            IF line[i] = tab
+              THEN Write(lst, tab)
+              ELSE Write(lst, ' ')
+            END;
+            INC(i)
+          END;
+          WriteString(lst, "^ ")
+        END Pointer;
+
+      BEGIN
+        Pointer;
+        CASE nr OF
+        -->Errors
+        (* add customized cases here *)
+        | 202: Msg("module name mismatch")
+        ELSE         Msg("Error: "); WriteInt(lst, nr, 0);
+        END;
+        WriteLn(lst)
+      END PrintErr;
+
+    PROCEDURE PrintListing;
+    (* Print a source listing with error messages *)
+      VAR
+        nextErr: Err;
+        eof: BOOLEAN;
+        lnr, errC: INTEGER;
+        srcPos: INT32;
+        line: ARRAY [0 .. 255] OF CHAR;
+      BEGIN
+        WriteString(lst, "Listing:");
+        WriteLn(lst); WriteLn(lst);
+        srcPos := 0; nextErr := firstErr;
+        GetLine(srcPos, line, eof); lnr := 1; errC := 0;
+        WHILE ~ eof DO
+          WriteInt(lst, lnr, 5); WriteString(lst, "  ");
+          WriteString(lst, line); WriteLn(lst);
+          WHILE (nextErr # NIL) & (nextErr^.line = lnr) DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END;
+          GetLine(srcPos, line, eof); INC(lnr);
+        END;
+        IF nextErr # NIL THEN
+          WriteInt(lst, lnr, 5); WriteLn(lst);
+          WHILE nextErr # NIL DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END
+        END;
+        WriteLn(lst);
+        WriteInt(lst, errC, 5); WriteString(lst, " error");
+        IF errC # 1 THEN Write(lst, 's') END;
+        WriteLn(lst); WriteLn(lst); WriteLn(lst);
+      END PrintListing;
+
+    BEGIN
+      firstErr := NIL; Extra := 1;
+    END ListHandler;
+
+  (* --------------------------- main module ------------------------------- *)
+
+  PROCEDURE ChangeExtension (oldName, Ext: ARRAY OF CHAR;
+                             VAR newName: ARRAY OF CHAR);
+  (* Constructs newName by replacing the extension of oldName with Ext. *)
+    VAR
+      i, l: CARDINAL;
+    BEGIN
+      Strings.Assign(oldName, newName);
+      i := LENGTH(oldName); l := i;
+      WHILE (i > 0) & (oldName[i -1] # '.')
+            & (oldName[i -1] # '\') & (oldName[i -1] # '/') DO
+        DEC(i)
+      END;
+      IF (i > 0) & (oldName[i-1] = '.') THEN
+        Strings.Delete(newName, i - 1, l + 1 - i)
+      END;
+      IF Ext[0] = '.' THEN Strings.Delete(Ext, 0, 1) END;
+      Strings.Append(".", newName);
+      Strings.Append(Ext, newName)
+    END ChangeExtension;
+
+  VAR
+    sourceName, listName: ARRAY [0 .. 255] OF CHAR;
+
+  BEGIN
+    (* check on correct parameter usage *)
+    FileIO.NextParameter(sourceName);
+    IF sourceName[0] = 0C THEN
+      FileIO.WriteString(FileIO.StdOut, "No input file specified");
+      HALT
+    END;
+
+    (* open the source file - Scanner.src *)
+    FileIO.Open(src, sourceName, FALSE);
+    IF ~ FileIO.Okay THEN
+      FileIO.WriteString(FileIO.StdOut, "Could not open input file");
+      FileIO.WriteLn(FileIO.StdOut);
+      HALT
+    END;
+
+    (* open the output file for the source listing - Scanner.lst *)
+    ChangeExtension(sourceName, ".LST", listName);
+    FileIO.Open(lst, listName, TRUE);
+    IF ~ FileIO.Okay THEN
+      FileIO.WriteString(FileIO.StdOut, "Could not open listing file");
+      FileIO.WriteLn(FileIO.StdOut);
+      (* default Scanner.lst to screen *) lst := FileIO.StdOut;
+    END;
+
+    (* install error reporting procedure - Scanner.Error *)
+    Error := StoreError;
+
+    (* instigate the compilation - Parser.Parse *)
+    FileIO.WriteString(FileIO.StdOut, "Parsing"); FileIO.WriteLn(FileIO.StdOut);
+    Parse;
+
+    (* generate the source listing on lst file *)
+    PrintListing;
+    IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
+
+    (* examine the outcome *)
+    IF NOT Successful()
+      THEN
+        FileIO.WriteString(FileIO.StdOut, "Incorrect source");
+      ELSE
+        FileIO.WriteString(FileIO.StdOut, "Parsed correctly");
+    END;
+  END -->Grammar.

modules.lst

@@ -0,0 +1,65 @@
+SYSTEM
+ASCII
+Strings
+StrLib
+Environment
+CFileSysOp
+Indexing
+SysExceptions
+M2EXCEPTION
+RTExceptions
+M2Dependent
+M2RTS
+wrapc
+FIO
+errno
+termios
+IO
+StdIO
+StrIO
+NumberIO
+Debug
+Selective
+ldtoa
+dtoa
+StringConvert
+M2Diagnostic
+SysStorage
+RTentity
+EXCEPTIONS
+Storage
+Assertion
+DynamicStrings
+StringFileSysOp
+FileSysOp
+wrapclock
+UnixArgs
+Args
+SysClock
+IOConsts
+ChanConsts
+IOLink
+RTio
+ErrnoCategory
+RTgenif
+RTfio
+RTgen
+StdChans
+IOChan
+RTdata
+ProgramArgs
+CharClass
+TextUtil
+TextIO
+RawIO
+ConvTypes
+WholeConv
+StringChan
+WholeIO
+IOResult
+RndFile
+TermFile
+FileIO
+M2cS
+M2cP
+M2c

parser.frm

@@ -0,0 +1,152 @@
+IMPLEMENTATION MODULE -->modulename;
+
+(* Parser generated by Coco/R - assuming ISO IO library will be available. *)
+
+IMPORT -->scanner, FileIO;
+
+-->declarations
+
+CONST 
+  -->constants
+  minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
+  setsize     = 16;  (* sets are stored in 16 bits *)
+
+TYPE
+  SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;
+
+VAR
+  symSet:  ARRAY [0 .. -->symSetSize] OF SymbolSet; (*symSet[0] = allSyncSyms*)
+  errDist: CARDINAL;   (* number of symbols recognized since last error *)
+  sym:     CARDINAL;   (* current input symbol *)
+
+PROCEDURE SemError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      -->error
+    END;
+    errDist := 0;
+  END SemError;
+
+PROCEDURE SynError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      -->error
+    END;
+    errDist := 0;
+  END SynError;
+
+PROCEDURE Get;
+  VAR
+    s: ARRAY [0 .. 31] OF CHAR;
+  BEGIN
+    REPEAT
+      -->scanner.Get(sym);
+      IF sym <= maxT THEN
+        INC(errDist);
+      ELSE
+        -->pragmas
+      END;
+    UNTIL sym <= maxT
+  END Get;
+
+PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN;
+  BEGIN
+    RETURN x MOD setsize IN s[x DIV setsize];
+  END In;
+
+PROCEDURE Expect (n: CARDINAL);
+  BEGIN
+    IF sym = n THEN Get ELSE SynError(n) END
+  END Expect;
+
+PROCEDURE ExpectWeak (n, follow: CARDINAL);
+  BEGIN
+    IF sym = n
+      THEN Get
+      ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END
+    END
+  END ExpectWeak;
+
+PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN;
+  VAR
+    s: SymbolSet;
+    i: CARDINAL;
+  BEGIN
+    IF sym = n
+      THEN Get; RETURN TRUE
+      ELSIF In(symSet[repFol], sym) THEN RETURN FALSE
+      ELSE
+        i := 0;
+        WHILE i <= maxT DIV setsize DO
+          s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
+        END;
+        SynError(n); WHILE ~ In(s, sym) DO Get END;
+        RETURN In(symSet[syFol], sym)
+    END
+  END WeakSeparator;
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetName(-->scanner.pos, -->scanner.len, Lex)
+  END LexName;
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetString(-->scanner.pos, -->scanner.len, Lex)
+  END LexString;
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetName(-->scanner.nextPos, -->scanner.nextLen, Lex)
+  END LookAheadName;
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetString(-->scanner.nextPos, -->scanner.nextLen, Lex)
+  END LookAheadString;
+
+PROCEDURE Successful (): BOOLEAN;
+  BEGIN
+    RETURN -->scanner.errors = 0
+  END Successful;
+
+-->productions
+
+PROCEDURE Parse;
+  BEGIN
+    -->parseRoot
+  END Parse;
+
+BEGIN
+  errDist := minErrDist;
+  -->initialization
+END -->modulename.
+
+-->definitionDEFINITION MODULE -->modulename;
+
+(* Parser generated by Coco/R *)
+
+PROCEDURE Parse;
+
+PROCEDURE Successful (): BOOLEAN;
+(* Returns TRUE if no errors have been recorded while parsing *)
+
+PROCEDURE SynError (errNo: INTEGER);
+(* Report syntax error errNo *)
+
+PROCEDURE SemError (errNo: INTEGER);
+(* Report semantic error errNo *)
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of current token *)
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of current token (capitalized if IGNORE CASE) *)
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of lookahead token *)
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of lookahead token (capitalized if IGNORE CASE) *)
+
+END -->modulename.

run_tests.sh

@@ -0,0 +1,52 @@
+#!/bin/sh
+#
+# Phase-0 test runner for M2c.
+# Usage: ./run_tests.sh   (from the m2c directory, after ./build.sh)
+#
+
+pass=0
+fail=0
+
+expect_ok() {
+  # $1 = test file (no dir)
+  name="$1"
+  out=$(./M2c "tests/$name" 2>&1)
+  case "$out" in
+    *"Parsed correctly"*)
+      echo "ok   $name accepted"
+      pass=$((pass+1)) ;;
+    *)
+      echo "FAIL $name: expected accept, got: $out"
+      fail=$((fail+1)) ;;
+  esac
+}
+
+expect_fail() {
+  # $1 = test file, $2 = message text expected in the .LST
+  name="$1"
+  want="$2"
+  out=$(./M2c "tests/$name" 2>&1)
+  case "$out" in
+    *"Incorrect source"*) ;;
+    *)
+      echo "FAIL $name: expected rejection, got: $out"
+      fail=$((fail+1)); return ;;
+  esac
+  lst="tests/$(basename "$name" .mod).LST"
+  if grep -q "$want" "$lst" 2>/dev/null; then
+    echo "ok   $name rejected with [$want]"
+    pass=$((pass+1))
+  else
+    echo "FAIL $name: [$want] not found in $lst"
+    fail=$((fail+1))
+  fi
+}
+
+echo "=== Phase-0 tests ==="
+expect_ok ok_minimal.mod
+expect_ok ok_nobegin.mod
+expect_fail bad_mismatch.mod "module name mismatch"
+expect_fail bad_syntax.mod "expected"
+
+echo "=== $pass passed, $fail failed ==="
+test "$fail" = 0

scanner.frm

@@ -0,0 +1,201 @@
+IMPLEMENTATION MODULE -->modulename;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO, Storage;
+
+CONST
+  noSYMB  = -->unknownsym; (*error token code*)
+  (* not only for errors but also for not finished states of scanner analysis *)
+  eof     = 32C (* MS-DOS Keyboard eof char *);
+  EOF     = 0C;
+  EOL     = 15C;
+  CR      = 15C;
+  LF      = 12C;
+  Long0   = 0;
+  Long1   = 1;
+  BlkSize = 16384;
+TYPE
+  BufBlock   = ARRAY [0 .. BlkSize-1] OF CHAR;
+  Buffer     = ARRAY [0 .. 31] OF POINTER TO BufBlock;
+  StartTable = ARRAY [0 .. 255] OF INTEGER;
+  GetCH      = PROCEDURE (INT32): CHAR;
+VAR
+  lastCh,
+  ch:        CHAR;       (*current input character*)
+  curLine:   INTEGER;    (*current input line (may be higher than line)*)
+  lineStart: INT32;      (*start position of current line*)
+  apx:       INT32;      (*length of appendix (CONTEXT phrase)*)
+  oldEols:   INTEGER;    (*number of EOLs in a comment*)
+  bp, bp0:   INT32;      (*current position in buf
+                           (bp0: position of current token)*)
+  inputLen:  INT32;      (*source file size*)
+  buf:       Buffer;     (*source buffer for low-level access*)
+  start:     StartTable; (*start state for every character*)
+  CurrentCh: GetCH;
+
+PROCEDURE Err (nr, line, col: INTEGER; pos: INT32);
+  BEGIN
+    INC(errors)
+  END Err;
+
+PROCEDURE NextCh;
+(* Return global variable ch *)
+  BEGIN
+    lastCh := ch; INC(bp); ch := CurrentCh(bp);
+    IF (ch = EOL) OR (ch = LF) AND (lastCh # EOL) THEN
+      INC(curLine); lineStart := bp
+    END
+  END NextCh;
+
+PROCEDURE Comment (): BOOLEAN;
+  VAR
+    level, startLine: INTEGER;
+    oldLineStart: INT32;
+  BEGIN
+    level := 1; startLine := curLine; oldLineStart := lineStart;
+    -->commentRETURN FALSE;
+  END Comment;
+
+PROCEDURE Get (VAR sym: CARDINAL);
+  VAR
+    state: CARDINAL;
+
+  PROCEDURE Equal (s: ARRAY OF CHAR): BOOLEAN;
+    VAR
+      i: CARDINAL;
+      q: INT32;
+    BEGIN
+      IF nextLen # LENGTH(s) THEN RETURN FALSE END;
+      i := 1; q := bp0; INC(q);
+      WHILE i < nextLen DO
+        IF CurrentCh(q) # s[i] THEN RETURN FALSE END;
+        INC(i); INC(q)
+      END;
+      RETURN TRUE
+    END Equal;
+
+  PROCEDURE CheckLiteral;
+    BEGIN
+      -->literals
+    END CheckLiteral;
+
+  BEGIN (*Get*)
+    -->GetSy1
+    pos := nextPos;   nextPos := bp;
+    col := nextCol;   nextCol := VAL(INTEGER, bp - lineStart);
+    line := nextLine; nextLine := curLine;
+    len := nextLen;   nextLen := 0;
+    apx := 0; state := start[ORD(ch)]; bp0 := bp;
+    LOOP
+      NextCh; INC(nextLen);
+      CASE state OF
+      -->GetSy2
+      ELSE sym := noSYMB; RETURN (*NextCh already done*)
+      END
+    END
+  END Get;
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CharAt(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetString;
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CurrentCh(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetName;
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)];
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CharAt;
+
+PROCEDURE CapChAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := CAP(buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)]);
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CapChAt;
+
+PROCEDURE Reset;
+  VAR
+    i, read: CARDINAL;
+  BEGIN (*assert: src has been opened*)
+    i := 0; inputLen := 0;
+    REPEAT
+      Storage.ALLOCATE(buf[i], BlkSize);
+      read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
+      INC(i); INC(inputLen, VAL(INT32, read))
+    UNTIL read # BlkSize;
+    buf[i-1]^[read] := EOF;
+    curLine := 1; lineStart := -2; bp := -1;
+    oldEols := 0; apx := 0; errors := 0;
+    NextCh;
+  END Reset;
+
+BEGIN
+  -->initializations
+  Error := Err; lastCh := EOF;
+END -->modulename.
+-->definitionDEFINITION MODULE -->modulename;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO;
+
+TYPE
+  INT32 = FileIO.INT32 (* need 32 bit integers *);
+
+VAR
+  src, lst:    FileIO.File;(*source/list files. To be opened by the main pgm*)
+  directory:   ARRAY [0 .. 255] OF CHAR (*of source file*);
+  line, col:   INTEGER;      (*line and column of current symbol*)
+  len:         CARDINAL;     (*length of current symbol*)
+  pos:         INT32;        (*file position of current symbol*)
+  nextLine:    INTEGER;      (*line of lookahead symbol*)
+  nextCol:     INTEGER;      (*column of lookahead symbol*)
+  nextLen:     CARDINAL;     (*length of lookahead symbol*)
+  nextPos:     INT32;        (*file position of lookahead symbol*)
+  errors:      INTEGER;      (*number of detected errors*)
+  Error:       PROCEDURE ((*nr*)INTEGER, (*line*)INTEGER, (*col*)INTEGER,
+                          (*pos*)INT32);
+
+PROCEDURE Get (VAR sym: CARDINAL);
+(* Gets next symbol from source file *)
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves exact string of max length len from position pos in source file *)
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves name of symbol of length len at position pos in source file *)
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+(* Returns exact character at position pos in source file *)
+
+PROCEDURE Reset;
+(* Reads and stores source file internally *)
+
+END -->modulename.

tests/bad_mismatch.LST

@@ -0,0 +1,10 @@
+Listing:
+
+    1  MODULE M;
+    2  BEGIN
+    3  END N.
+*****      ^ module name mismatch
+
+    1 error
+
+

tests/bad_mismatch.mod

@@ -0,0 +1,3 @@
+MODULE M;
+BEGIN
+END N.

tests/bad_syntax.LST

@@ -0,0 +1,11 @@
+Listing:
+
+    1  MODULE M;
+    2  BEGIN
+    3  END M
+    4
+*****  ^ '.' expected
+
+    1 error
+
+

tests/bad_syntax.mod

@@ -0,0 +1,3 @@
+MODULE M;
+BEGIN
+END M

tests/ok_minimal.LST

@@ -0,0 +1,9 @@
+Listing:
+
+    1  MODULE M;
+    2  BEGIN
+    3  END M.
+
+    0 errors
+
+

tests/ok_minimal.mod

@@ -0,0 +1,3 @@
+MODULE M;
+BEGIN
+END M.

tests/ok_nobegin.LST

@@ -0,0 +1,8 @@
+Listing:
+
+    1  MODULE M;
+    2  END M.
+
+    0 errors
+
+

tests/ok_nobegin.mod

@@ -0,0 +1,2 @@
+MODULE M;
+END M.