Test2: SimpleMod2 scalar subset with QBE backend, 20/20 tests pass

.gitignore

@@ -19,6 +19,10 @@ Pascal
 *.lst
 modules.lst
 
+# --- Test2 QBE pipeline products (regenerated by build_qbe.sh) ---
+Test2/gen_qbe/*
+!Test2/gen_qbe/*.ssa
+
 # --- Editor/OS droppings ---
 *~
 *.swp

Test2/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.

Test2/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.

Test2/QbeGen.def

@@ -0,0 +1,120 @@
+DEFINITION MODULE QbeGen;
+(* QBE backend for the scalar subset of SimpleMod2 (see SimpleQ.atg).
+
+   Emits QBE SSA text to "gen_qbe/<Module>.ssa" (directory "gen_qbe"
+   must exist). Supported: scalar globals of INTEGER / CARDINAL /
+   SHORTINT / LONGINT / BOOLEAN / CHAR (QBE "w") and REAL / LONGREAL
+   (QBE "d", i.e. REAL is widened to double), enumeration types with
+   ordinal values, CONST initializers that are plain literals, full
+   scalar expressions, and IF / CASE / WHILE / REPEAT / LOOP+EXIT /
+   FOR statements.
+
+   Anything else (ARRAY / RECORD / SET / POINTER values, string
+   variables, WITH, IN, set literals, non-literal CONST expressions
+   or BY steps, EXIT outside LOOP, use of imported names as values)
+   is reported by the parser with error 230; this module only emits
+   structurally valid placeholder code for those cases.
+
+   Test convention: if the source declares a global
+     VAR ExitCode : INTEGER;
+   the generated "main" returns its value as the process exit code,
+   otherwise it returns 0. This makes compiled programs observable
+   (the language itself has no I/O). *)
+
+TYPE
+  QVal = ARRAY [0 .. 63] OF CHAR;
+  (* A QBE operand: either an immediate ("42", "-5", "d_3.14") or a
+     temporary ("%t7"). Labels ("@L3") travel in plain strings. *)
+
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
+(* Opens gen_qbe/<name>.ssa, resets counters. *)
+
+PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
+(* Emits "data $name = ..." (w for scalars, d for REAL). The second
+   parameter is a SymTab.TypeIndex; other classes get a "w 0"
+   placeholder so the file stays assembleable. *)
+
+PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
+(* Like DeclVar but initialized from the literal text val
+   ("100", "-5", "d_3.14"); non-literal val gives a 0 placeholder.
+   NOTE: this qbe accepts only integer literals in "data", so a
+   non-zero REAL initializer is emitted as "d 0" plus a runtime copy
+   at function start (see BeginBody). *)
+
+PROCEDURE BeginBody;
+(* Emits "export function w $main() {@start" (once). *)
+
+PROCEDURE EndModule;
+(* Emits the return sequence (via ExitCode when present), closes the
+   function and the file. *)
+
+PROCEDURE NewTemp (VAR t: QVal);
+(* Fresh "%tN" operand. *)
+
+PROCEDURE NewLabel (VAR l: QVal);
+(* Fresh "@LN" label. *)
+
+PROCEDURE EmitLabel (l: ARRAY OF CHAR);
+PROCEDURE Jmp (l: ARRAY OF CHAR);
+PROCEDURE Jnz (c, t, f: ARRAY OF CHAR);
+(* "jnz c, @t, @f". *)
+
+PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
+(* q := fresh temp holding $name. *)
+
+PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
+(* "storew/stored q, $name". *)
+
+PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
+               isReal: BOOLEAN);
+(* "res =w/=d mn l, r". *)
+
+PROCEDURE Cmp (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal;
+               isReal: BOOLEAN);
+(* Signed integer (ceqw/cnew/csltw/...) or double (ceqd/.../cled/...)
+   comparison selected by a SymTab.OpEq..OpGe code; q := fresh w. *)
+
+PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
+(* q := fresh temp holding "-a" (sub from 0). *)
+
+PROCEDURE NotQ (a: ARRAY OF CHAR; VAR q: QVal);
+(* q := fresh temp holding "NOT a" (xor 1, a). *)
+
+PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
+(* q := fresh double holding "swtof a" (INTEGER -> REAL). *)
+
+PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+PROCEDURE IntStr (v: INTEGER; VAR s: QVal);
+PROCEDURE NormInt (s: ARRAY OF CHAR; VAR d: QVal);
+(* "123" -> "123"; "0FFH" -> "255". *)
+
+PROCEDURE NormReal (s: ARRAY OF CHAR; VAR d: QVal);
+(* "3.14" -> "d_3.14" (QBE double immediates carry a d_ prefix). *)
+
+PROCEDURE CharVal (s: ARRAY OF CHAR): INTEGER;
+(* ORD of a 1-character literal such as 'a'. *)
+
+PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: QVal);
+(* Folds a unary minus into a literal operand ("5" -> "-5"). *)
+
+PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
+(* TRUE for literal operands (not %temporaries). *)
+
+PROCEDURE IsNeg (s: ARRAY OF CHAR): BOOLEAN;
+(* TRUE for a leading '-'. *)
+
+PROCEDURE PushLoop (exit: ARRAY OF CHAR);
+PROCEDURE PopLoop;
+PROCEDURE TopLoop (VAR exit: QVal): BOOLEAN;
+(* Innermost LOOP exit label; FALSE when outside any LOOP. *)
+
+PROCEDURE NoQbeEnter;
+PROCEDURE NoQbeExit;
+PROCEDURE NoQbe (): BOOLEAN;
+(* Guard depth for unsupported constructs: while > 0 the grammar
+   suppresses follow-on 230 errors to avoid cascades. *)
+
+PROCEDURE Remark (s: ARRAY OF CHAR);
+(* Emits a "# s" comment line. *)
+
+END QbeGen.

Test2/QbeGen.mod

@@ -0,0 +1,448 @@
+IMPLEMENTATION MODULE QbeGen;
+
+IMPORT FileIO, SymTab;
+
+VAR
+  out     : FileIO.File;
+  opened  : BOOLEAN;
+  inBody  : BOOLEAN;
+  nTemp   : CARDINAL;
+  nLab    : CARDINAL;
+  loopTop : CARDINAL;
+  loopSt  : ARRAY [0 .. 15] OF QVal;
+  noqbe   : CARDINAL;
+  nR      : CARDINAL;
+  rNames  : ARRAY [0 .. 31] OF QVal;
+  rVals   : ARRAY [0 .. 31] OF QVal;
+
+(* ---------------- small string utilities ---------------- *)
+
+PROCEDURE Len (s: ARRAY OF CHAR): CARDINAL;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
+    RETURN i
+  END Len;
+
+PROCEDURE Cpy (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(d)) & (i < HIGH(s)) & (s[i] # 0C) DO
+      d[i] := s[i]; INC(i)
+    END;
+    IF i <= HIGH(d) THEN d[i] := 0C END
+  END Cpy;
+
+PROCEDURE App (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
+  VAR i, j : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i <= HIGH(d)) & (d[i] # 0C) DO INC(i) END;
+    j := 0;
+    WHILE (i < HIGH(d)) & (j < HIGH(s)) & (s[j] # 0C) DO
+      d[i] := s[j]; INC(i); INC(j)
+    END;
+    IF i <= HIGH(d) THEN d[i] := 0C END
+  END App;
+
+PROCEDURE W (s: ARRAY OF CHAR);
+  BEGIN
+    IF opened THEN FileIO.WriteString(out, s) END
+  END W;
+
+PROCEDURE WL (s: ARRAY OF CHAR);
+  BEGIN
+    W(s);
+    IF opened THEN FileIO.WriteLn(out) END
+  END WL;
+
+PROCEDURE AppNum (VAR d: ARRAY OF CHAR; v: CARDINAL);
+(* Appends v in decimal to d. *)
+  VAR buf : ARRAY [0 .. 15] OF CHAR;
+    n, i, L : CARDINAL;
+  BEGIN
+    n := 0;
+    IF v = 0 THEN buf[0] := "0"; n := 1 END;
+    WHILE (v > 0) & (n <= HIGH(buf)) DO
+      buf[n] := CHR(ORD("0") + v MOD 10); v := v DIV 10; INC(n)
+    END;
+    i := n;
+    WHILE i > 0 DO
+      DEC(i);
+      L := Len(d);
+      IF L < HIGH(d) THEN d[L] := buf[i]; d[L + 1] := 0C END
+    END
+  END AppNum;
+
+(* ---------------- exported helpers ---------------- *)
+
+PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+  BEGIN
+    Cpy(d, s)
+  END CopyOp;
+
+PROCEDURE IntStr (v: INTEGER; VAR s: QVal);
+  VAR neg : BOOLEAN;
+    mag : CARDINAL;
+    buf : ARRAY [0 .. 15] OF CHAR;
+    n, i, L : CARDINAL;
+    t : CHAR;
+  BEGIN
+    neg := v < 0;
+    IF neg THEN mag := VAL(CARDINAL, -v) ELSE mag := VAL(CARDINAL, v) END;
+    n := 0;
+    IF mag = 0 THEN buf[0] := "0"; n := 1 END;
+    WHILE (mag > 0) & (n < HIGH(buf)) DO
+      buf[n] := CHR(ORD("0") + mag MOD 10); mag := mag DIV 10; INC(n)
+    END;
+    i := 0;
+    WHILE i < n DIV 2 DO
+      t := buf[i]; buf[i] := buf[n - 1 - i]; buf[n - 1 - i] := t; INC(i)
+    END;
+    s[0] := 0C;
+    IF neg THEN App(s, "-") END;
+    i := 0;
+    WHILE i < n DO
+      L := Len(s);
+      IF L < HIGH(s) THEN s[L] := buf[i]; s[L + 1] := 0C END;
+      INC(i)
+    END
+  END IntStr;
+
+PROCEDURE HexVal (ch: CHAR): INTEGER;
+  BEGIN
+    IF (ch >= "0") & (ch <= "9") THEN RETURN ORD(ch) - ORD("0") END;
+    IF (ch >= "A") & (ch <= "F") THEN RETURN ORD(ch) - ORD("A") + 10 END;
+    IF (ch >= "a") & (ch <= "f") THEN RETURN ORD(ch) - ORD("a") + 10 END;
+    RETURN 0
+  END HexVal;
+
+PROCEDURE NormInt (s: ARRAY OF CHAR; VAR d: QVal);
+(* "0FFH" -> "255", plain decimals are copied through. *)
+  VAR n, i : CARDINAL;
+    v : INTEGER;
+  BEGIN
+    n := Len(s);
+    IF (n > 0) & ((s[n - 1] = "H") OR (s[n - 1] = "h")) THEN
+      v := 0; i := 0;
+      WHILE i < n - 1 DO v := v * 16 + HexVal(s[i]); INC(i) END;
+      IntStr(v, d)
+    ELSE
+      Cpy(d, s)
+    END
+  END NormInt;
+
+PROCEDURE NormReal (s: ARRAY OF CHAR; VAR d: QVal);
+  BEGIN
+    Cpy(d, "d_");
+    App(d, s)
+  END NormReal;
+
+PROCEDURE CharVal (s: ARRAY OF CHAR): INTEGER;
+  BEGIN
+    IF Len(s) >= 2 THEN RETURN ORD(s[1]) END;
+    RETURN 0
+  END CharVal;
+
+PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: QVal);
+(* Safe for a and q being the same variable. *)
+  VAR i, j, L : CARDINAL;
+    tmp : QVal;
+  BEGIN
+    Cpy(tmp, a);
+    IF Len(tmp) = 0 THEN Cpy(q, "0"); RETURN END;
+    IF tmp[0] = "-" THEN
+      i := 1; j := 0;
+      WHILE (tmp[i] # 0C) & (j < HIGH(q)) DO
+        q[j] := tmp[i]; INC(i); INC(j)
+      END;
+      IF j <= HIGH(q) THEN q[j] := 0C END
+    ELSIF (tmp[0] = "d") & (Len(tmp) > 1) & (tmp[1] = "_") THEN
+      Cpy(q, "d_-");
+      i := 2;
+      WHILE tmp[i] # 0C DO
+        L := Len(q);
+        IF L < HIGH(q) THEN q[L] := tmp[i]; q[L + 1] := 0C END;
+        INC(i)
+      END
+    ELSE
+      Cpy(q, "-");
+      App(q, tmp)
+    END
+  END NegFold;
+
+PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
+  VAR c : CHAR;
+  BEGIN
+    IF Len(s) = 0 THEN RETURN FALSE END;
+    c := s[0];
+    RETURN ((c >= "0") & (c <= "9")) OR (c = "-") OR (c = "d")
+  END IsImm;
+
+PROCEDURE IsNeg (s: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN (Len(s) > 0) & (s[0] = "-")
+  END IsNeg;
+
+(* ---------------- module / data section ---------------- *)
+
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
+  VAR fname : ARRAY [0 .. 127] OF CHAR;
+  BEGIN
+    fname[0] := 0C;
+    App(fname, "gen_qbe/");
+    App(fname, name);
+    App(fname, ".ssa");
+    FileIO.Open(out, fname, TRUE);
+    opened := FileIO.Okay;
+    inBody := FALSE;
+    nTemp := 0; nLab := 0; loopTop := 0; noqbe := 0; nR := 0;
+    WL("# QBE IR generated by the SimpleQ backend");
+    WL("")
+  END OpenModule;
+
+PROCEDURE DataLine (name: ARRAY OF CHAR; isReal: BOOLEAN; init: ARRAY OF CHAR);
+  BEGIN
+    IF ~opened THEN RETURN END;
+    W("data $"); W(name);
+    IF isReal THEN W(" = { d ") ELSE W(" = { w ") END;
+    W(init);
+    WL(" }")
+  END DataLine;
+
+PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
+  BEGIN
+    IF SymTab.ClassOf(t) = SymTab.ClReal THEN DataLine(name, TRUE, "0")
+    ELSE DataLine(name, FALSE, "0")
+    END
+  END DeclVar;
+
+PROCEDURE IsZeroReal (val: ARRAY OF CHAR): BOOLEAN;
+(* TRUE when the "d_..." literal denotes zero (checked textually). *)
+  VAR i : CARDINAL;
+    seen : BOOLEAN;
+    ch : CHAR;
+  BEGIN
+    i := 0;
+    IF (Len(val) > 1) & (val[0] = "d") & (val[1] = "_") THEN i := 2 END;
+    seen := FALSE;
+    WHILE val[i] # 0C DO
+      ch := val[i];
+      IF (ch >= "0") & (ch <= "9") THEN
+        seen := TRUE;
+        IF ch # "0" THEN RETURN FALSE END
+      ELSIF (ch # ".") & (ch # "E") & (ch # "e")
+            & (ch # "+") & (ch # "-") THEN
+        RETURN FALSE
+      END;
+      INC(i)
+    END;
+    RETURN seen
+  END IsZeroReal;
+
+PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
+  VAR cls : INTEGER;
+    init : QVal;
+  BEGIN
+    cls := SymTab.ClassOf(t);
+    IF (cls = SymTab.ClStr) OR ~IsImm(val) THEN
+      DeclVar(name, t); RETURN
+    END;
+    IF cls = SymTab.ClReal THEN
+      IF IsZeroReal(val) THEN DataLine(name, TRUE, "0")
+      ELSE
+        DataLine(name, TRUE, "0");
+        IF nR <= HIGH(rNames) THEN
+          Cpy(rNames[nR], name); Cpy(rVals[nR], val); INC(nR)
+        END
+      END
+    ELSE DataLine(name, FALSE, val)
+    END
+  END DeclConst;
+
+(* ---------------- function body ---------------- *)
+
+PROCEDURE BeginBody;
+  VAR i : CARDINAL;
+    t : QVal;
+  BEGIN
+    IF ~opened OR inBody THEN RETURN END;
+    WL("");
+    WL("export function w $main() {");
+    WL("@start");
+    inBody := TRUE;
+    i := 0;
+    WHILE i < nR DO
+      NewTemp(t);
+      W("  "); W(t); W(" =d copy "); WL(rVals[i]);
+      StoreVar(rNames[i], t, TRUE);
+      INC(i)
+    END
+  END BeginBody;
+
+PROCEDURE EndModule;
+  BEGIN
+    IF ~opened THEN RETURN END;
+    IF ~inBody THEN BeginBody END;
+    IF SymTab.Lookup("ExitCode")
+       & (SymTab.SymKind("ExitCode") = SymTab.KindVar)
+       & SymTab.IsIntFamily(SymTab.SymType("ExitCode")) THEN
+      WL("  %ec =w loadw $ExitCode");
+      WL("  ret %ec")
+    ELSE
+      WL("  ret 0")
+    END;
+    WL("}");
+    FileIO.Close(out);
+    opened := FALSE
+  END EndModule;
+
+(* ---------------- temporaries, labels, jumps ---------------- *)
+
+PROCEDURE NewTemp (VAR t: QVal);
+  BEGIN
+    Cpy(t, "%t");
+    AppNum(t, nTemp);
+    INC(nTemp)
+  END NewTemp;
+
+PROCEDURE NewLabel (VAR l: QVal);
+  BEGIN
+    Cpy(l, "@L");
+    AppNum(l, nLab);
+    INC(nLab)
+  END NewLabel;
+
+PROCEDURE EmitLabel (l: ARRAY OF CHAR);
+  BEGIN
+    WL(l)
+  END EmitLabel;
+
+PROCEDURE Jmp (l: ARRAY OF CHAR);
+  BEGIN
+    W("  jmp "); WL(l)
+  END Jmp;
+
+PROCEDURE Jnz (c, t, f: ARRAY OF CHAR);
+  BEGIN
+    W("  jnz "); W(c); W(", "); W(t); W(", "); WL(f)
+  END Jnz;
+
+(* ---------------- data movement and operators ---------------- *)
+
+PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
+  BEGIN
+    NewTemp(q);
+    W("  "); W(q);
+    IF isReal THEN W(" =d loadd $") ELSE W(" =w loadw $") END;
+    WL(name)
+  END LoadVar;
+
+PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
+  BEGIN
+    IF isReal THEN W("  stored ") ELSE W("  storew ") END;
+    W(q); W(", $"); WL(name)
+  END StoreVar;
+
+PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
+               isReal: BOOLEAN);
+  BEGIN
+    W("  "); W(res);
+    IF isReal THEN W(" =d ") ELSE W(" =w ") END;
+    W(mn); W(" "); W(l); W(", "); WL(r)
+  END Op3;
+
+PROCEDURE Cmp (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal;
+               isReal: BOOLEAN);
+  VAR mn : ARRAY [0 .. 7] OF CHAR;
+  BEGIN
+    mn[0] := 0C;
+    IF isReal THEN
+      IF op = SymTab.OpEq THEN Cpy(mn, "ceqd")
+      ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cned")
+      ELSIF op = SymTab.OpLt THEN Cpy(mn, "cltd")
+      ELSIF op = SymTab.OpLe THEN Cpy(mn, "cled")
+      ELSIF op = SymTab.OpGt THEN Cpy(mn, "cgtd")
+      ELSE Cpy(mn, "cged")
+      END
+    ELSE
+      IF op = SymTab.OpEq THEN Cpy(mn, "ceqw")
+      ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cnew")
+      ELSIF op = SymTab.OpLt THEN Cpy(mn, "csltw")
+      ELSIF op = SymTab.OpLe THEN Cpy(mn, "cslew")
+      ELSIF op = SymTab.OpGt THEN Cpy(mn, "csgtw")
+      ELSE Cpy(mn, "csgew")
+      END
+    END;
+    NewTemp(q);
+    Op3(mn, q, l, r, FALSE)
+  END Cmp;
+
+PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
+  BEGIN
+    NewTemp(q);
+    IF isReal THEN Op3("sub", q, "d_0.0", a, TRUE)
+    ELSE Op3("sub", q, "0", a, FALSE)
+    END
+  END NegQ;
+
+PROCEDURE NotQ (a: ARRAY OF CHAR; VAR q: QVal);
+  BEGIN
+    NewTemp(q);
+    Op3("xor", q, "1", a, FALSE)
+  END NotQ;
+
+PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
+  BEGIN
+    NewTemp(q);
+    W("  "); W(q); W(" =d swtof "); WL(a)
+  END ConvIR;
+
+(* ---------------- loop stack and 230 guard ---------------- *)
+
+PROCEDURE PushLoop (exit: ARRAY OF CHAR);
+  BEGIN
+    IF loopTop <= HIGH(loopSt) THEN
+      Cpy(loopSt[loopTop], exit); INC(loopTop)
+    END
+  END PushLoop;
+
+PROCEDURE PopLoop;
+  BEGIN
+    IF loopTop > 0 THEN DEC(loopTop) END
+  END PopLoop;
+
+PROCEDURE TopLoop (VAR exit: QVal): BOOLEAN;
+  BEGIN
+    IF loopTop = 0 THEN RETURN FALSE END;
+    Cpy(exit, loopSt[loopTop - 1]);
+    RETURN TRUE
+  END TopLoop;
+
+PROCEDURE NoQbeEnter;
+  BEGIN
+    INC(noqbe)
+  END NoQbeEnter;
+
+PROCEDURE NoQbeExit;
+  BEGIN
+    IF noqbe > 0 THEN DEC(noqbe) END
+  END NoQbeExit;
+
+PROCEDURE NoQbe (): BOOLEAN;
+  BEGIN
+    RETURN noqbe > 0
+  END NoQbe;
+
+PROCEDURE Remark (s: ARRAY OF CHAR);
+  BEGIN
+    W("# "); WL(s)
+  END Remark;
+
+BEGIN
+  opened := FALSE;
+  inBody := FALSE;
+  nTemp := 0; nLab := 0; loopTop := 0; noqbe := 0; nR := 0
+END QbeGen.

Test2/SimpleQ.atg

@@ -0,0 +1,856 @@
+COMPILER SimpleQ
+(* Simplified Modula-2 without PROCEDURE / FUNCTION, with a QBE backend
+   for the scalar subset (see QbeGen for details).
+
+   - program module only, no DEFINITION / IMPLEMENTATION split
+   - no local modules, no EXPORT, no PRIORITY
+   - no ProcedureDeclaration, FormalParameters, ProcedureType,
+     ProcedureCall, ActualParameters, FORWARD, RETURN
+   - statements: assignment, IF, CASE, WHILE, REPEAT, LOOP/EXIT, FOR, WITH
+   - symbol table (SymTab) with static type checking: same error codes
+     200/201/202 and 210-224 as SimpleMod2 (Test1), same lenient rules
+     (single pass, declare-before-use; INTEGER, CARDINAL and subranges
+     form one integer family; no mixed INTEGER/REAL arithmetic; INTEGER
+     assigns to REAL; 1-character literal is CHAR; InvalidType suppresses
+     follow-on errors)
+   - backend (QbeGen): emits QBE SSA to gen_qbe/<ModName>.ssa
+     (directory gen_qbe/ must exist), assembled with "qbe" and linked
+     with "cc" into a native binary. Only scalar data is lowered:
+     INTEGER/CARDINAL/SHORTINT/LONGINT/BOOLEAN/CHAR/enumerations as
+     QBE "w", REAL/LONGREAL as QBE "d". Everything else parses and
+     type-checks but gets error 230 (qbe backend: construct not
+     supported in scalar subset): ARRAY/RECORD/SET/POINTER variables,
+     string variables, WITH, IN, set literals, non-literal CONST
+     expressions and BY steps, EXIT outside LOOP, imported names used
+     as values.
+   - test convention (the language has no I/O): a global
+       VAR ExitCode : INTEGER;
+     makes the generated main return its value as the process exit
+     code; otherwise the program returns 0. *)
+
+IMPORT SymTab, QbeGen;
+
+CHARACTERS
+  eol      = CHR(13) .
+  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit    = "0123456789" .
+  hexDigit = digit + "ABCDEF" .
+  noQuote1 = ANY - "'" - eol .
+  noQuote2 = ANY - '"' - eol .
+
+IGNORE CHR(9) .. CHR(13)
+
+COMMENTS
+  FROM "(*" TO "*)" NESTED
+
+TOKENS
+  ident   = letter { letter | digit } .
+  integer = digit { digit }
+          | digit { digit } CONTEXT("..")
+          | digit { hexDigit } "H" .
+  real    = digit { digit } "." { digit }
+            [ "E" [ "+" | "-" ] digit { digit } ] .
+  string  = "'" { noQuote1 } "'"
+          | '"' { noQuote2 } '"' .
+
+PRODUCTIONS
+  SimpleQ                               (. VAR m1, m2: SymTab.Name; .)
+    = "MODULE"
+      GetIdent<m1>                      (. SymTab.Init; QbeGen.OpenModule(m1);
+                                           IF ~SymTab.Enter(m1, SymTab.KindModule)
+                                           THEN SemError(200) END .)
+      ";"
+      { Import } Block GetIdent<m2>     (. IF ~SymTab.Equal(m1, m2)
+                                           THEN SemError(202) END .)
+      "."                               (. QbeGen.EndModule;
+                                           SymTab.PrintTable; .) .
+  Import                                (. VAR n: SymTab.Name; .)
+    = "FROM"
+      GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
+                                           THEN SemError(200) END .)
+      "IMPORT"
+      ImportList ";"
+    | "IMPORT"
+      ImportList ";" .
+  ImportList                            (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
+                                           THEN SemError(200) END .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.Enter(n, SymTab.KindImport)
+                                           THEN SemError(200) END .) } .
+  Block      = { Declaration }
+               [ "BEGIN"                (. QbeGen.BeginBody; .)
+                 StatSeq ]
+               "END" .
+  Declaration = "CONST"
+                          {
+                            ConstDecl ";" }
+              | "TYPE"
+                          {
+                            TypeDecl ";" }
+              | "VAR"
+                          {
+                            VarDecl ";" } .
+  ConstDecl                             (. VAR n: SymTab.Name;
+                                             t: SymTab.TypeIndex;
+                                             qv: QbeGen.QVal;
+                                             cls: INTEGER; .)
+    = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindConst)
+                                           THEN SemError(200) END .)
+      "="
+      ConstExpr<t, qv>                  (. SymTab.SetSymType(n, t);
+                                           cls := SymTab.ClassOf(t);
+                                           IF cls = SymTab.ClStr THEN
+                                             SemError(230)
+                                           ELSIF ~QbeGen.IsImm(qv) THEN
+                                             SemError(230)
+                                           END;
+                                           QbeGen.DeclConst(n, qv, t); .) .
+  ConstExpr <VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+    = Expr<t, q> .
+  TypeDecl                              (. VAR n: SymTab.Name;
+                                             t0, t1: SymTab.TypeIndex; .)
+    = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindType)
+                                           THEN SemError(200) END;
+                                           t0 := SymTab.NewAlias();
+                                           SymTab.SetSymType(n, t0); .)
+      "="
+      Type<t1>                          (. IF t1 = t0 THEN SemError(223);
+                                             SymTab.SetTarget(t0,
+                                               SymTab.InvalidType)
+                                           ELSE SymTab.SetTarget(t0, t1) END; .) .
+  VarDecl                               (. VAR t: SymTab.TypeIndex;
+                                             i: CARDINAL;
+                                             nm: SymTab.Name;
+                                             cls: INTEGER; .)
+    = VarIdents ":"
+      Type<t>                           (. cls := SymTab.ClassOf(t);
+                                           IF (cls # SymTab.ClInt)
+                                              & (cls # SymTab.ClReal)
+                                              & (cls # SymTab.ClBool)
+                                              & (cls # SymTab.ClChar)
+                                              & (cls # SymTab.ClEnum) THEN
+                                             SemError(230)
+                                           END;
+                                           i := 0;
+                                           WHILE i < SymTab.PendCount() DO
+                                             SymTab.PendName(i, nm);
+                                             QbeGen.DeclVar(nm, t);
+                                             INC(i)
+                                           END;
+                                           SymTab.FixPending(t); .) .
+  VarIdents                             (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.EnterPending(n,
+                                             SymTab.KindVar)
+                                           THEN SemError(200) END .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.EnterPending(n,
+                                             SymTab.KindVar)
+                                           THEN SemError(200) END .) } .
+  QualIdent <VAR t: SymTab.TypeIndex>
+                                        (. VAR n, m: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+                                             SemError(201);
+                                             t := SymTab.InvalidType
+                                           ELSIF (SymTab.SymKind(n) #
+                                                  SymTab.KindType)
+                                             & (SymTab.SymKind(n) #
+                                                SymTab.KindPredef)
+                                             & (SymTab.SymKind(n) #
+                                                SymTab.KindImport) THEN
+                                             SemError(221);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.SymType(n) END; .)
+      { "."
+        GetIdent<m>                     (. t := SymTab.InvalidType; .) } .
+
+  (* Types: ProcedureType removed; subrange factored for LL(1) *)
+  Type <VAR t: SymTab.TypeIndex>
+    = SimpleType<t> | ArrayType<t> | RecordType<t>
+    | SetType<t> | PointerType<t> .
+  SimpleType <VAR t: SymTab.TypeIndex>
+                                        (. VAR t1, t2: SymTab.TypeIndex;
+                                             q1, q2: QbeGen.QVal; .)
+    = QualIdent<t> [ "["
+                      ConstExpr<t1, q1>  (. IF (t1 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+                      ".."
+                      ConstExpr<t2, q2>  (. IF (t2 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+                      "]"
+                                     (. t := SymTab.NewSub(t1); .) ]
+    | "["
+      ConstExpr<t1, q1>                  (. IF (t1 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+      ".."
+      ConstExpr<t2, q2>                  (. IF (t2 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+      "]"                                (. t := SymTab.NewSub(t1); .)
+    | Enum<t> .
+  Enum <VAR t: SymTab.TypeIndex>
+                                        (. VAR n: SymTab.Name;
+                                             qs: QbeGen.QVal;
+                                             ord: INTEGER; .)
+    = "("                               (. t := SymTab.NewEnum();
+                                           ord := 0; .)
+      GetIdent<n>                       (. IF ~SymTab.Enter(n,
+                                             SymTab.KindConst)
+                                           THEN SemError(200) END;
+                                           SymTab.SetSymType(n, t);
+                                           QbeGen.IntStr(ord, qs);
+                                           QbeGen.DeclConst(n, qs, t);
+                                           INC(ord); .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.Enter(n,
+                                             SymTab.KindConst)
+                                           THEN SemError(200) END;
+                                           SymTab.SetSymType(n, t);
+                                           QbeGen.IntStr(ord, qs);
+                                           QbeGen.DeclConst(n, qs, t);
+                                           INC(ord); .) }
+      ")" .
+  ArrayType <VAR t: SymTab.TypeIndex>
+                                        (. VAR s, s2, e: SymTab.TypeIndex;
+                                             qs: QbeGen.QVal; .)
+    = "ARRAY"
+      SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+      { ","
+        SimpleType<s2>                  (. IF (s2 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(s2) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(s2) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(s2) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .) }
+      "OF"
+      Type<e>                           (. t := SymTab.NewArray(e); .) .
+  RecordType <VAR t: SymTab.TypeIndex>
+    = "RECORD"                          (. t := SymTab.NewRecord(); .)
+      FieldSeq<t>
+      "END" .
+  FieldSeq <rt: SymTab.TypeIndex>
+    = Field<rt> { ";"
+                  Field<rt> } .
+  Field <rt: SymTab.TypeIndex>
+                                        (. VAR et: SymTab.TypeIndex; .)
+    = [ FieldIdents<rt> ":"
+        Type<et>                       (. SymTab.FixPendingF(rt, et); .) ] .
+  FieldIdents <rt: SymTab.TypeIndex>
+                                        (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.FieldPending(rt, n)
+                                           THEN SemError(200) END .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.FieldPending(rt, n)
+                                           THEN SemError(200) END .) } .
+  SetType <VAR t: SymTab.TypeIndex>
+                                        (. VAR s: SymTab.TypeIndex; .)
+    = "SET"
+      "OF"
+      SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END;
+                                           t := SymTab.NewSet(s); .) .
+  PointerType <VAR t: SymTab.TypeIndex>
+                                        (. VAR b: SymTab.TypeIndex; .)
+    = "POINTER"
+      "TO"
+      Type<b>                           (. t := SymTab.NewPtr(b); .) .
+
+  (* Statements: ProcedureCall and RETURN removed *)
+  StatSeq    = Stat { ";"
+                     Stat } .
+  Stat                                  (. VAR lx: QbeGen.QVal; .)
+    = [ Assign | IfStat | CaseStat | WhileStat
+      | RepeatStat | LoopStat | ForStat | WithStat
+      | "EXIT"                 (. IF QbeGen.TopLoop(lx) THEN
+                                    QbeGen.Jmp(lx)
+                                  ELSE SemError(230) END; .) ] .
+  Assign                                (. VAR dt, et: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             qd, qe, qt: QbeGen.QVal;
+                                             qn: SymTab.Name;
+                                             sfx: BOOLEAN;
+                                             isR, conv: BOOLEAN; .)
+    = Design<dt, dk, qd, qn, sfx> ":="
+      Expr<et, qe>                      (. IF (dt # SymTab.InvalidType)
+                                           & (dk # SymTab.KindVar)
+                                           & (dk # SymTab.KindField)
+                                           & (dk # SymTab.KindImport) THEN
+                                           SemError(210)
+                                         ELSIF ~SymTab.Assignable(et, dt) THEN
+                                           SemError(210) END;
+                                         IF dk = SymTab.KindImport THEN
+                                           SemError(230)
+                                         END;
+                                         isR := (dt # SymTab.InvalidType)
+                                                & (SymTab.ClassOf(dt)
+                                                   = SymTab.ClReal);
+                                         conv := isR
+                                                 & SymTab.IsIntFamily(et);
+                                         IF ~sfx
+                                            & (dk = SymTab.KindVar) THEN
+                                           IF conv THEN
+                                             QbeGen.ConvIR(qe, qt);
+                                             QbeGen.StoreVar(qn, qt, TRUE)
+                                           ELSE
+                                             QbeGen.StoreVar(qn, qe, isR)
+                                           END
+                                         END; .) .
+  IfStat                                (. VAR t: SymTab.TypeIndex;
+                                             q: QbeGen.QVal;
+                                             lThen, lElse, lEnd: QbeGen.QVal;
+                                             hasElse: BOOLEAN; .)
+    = "IF"
+      Expr<t, q>                        (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           QbeGen.NewLabel(lThen);
+                                           QbeGen.NewLabel(lElse);
+                                           QbeGen.NewLabel(lEnd);
+                                           QbeGen.Jnz(q, lThen, lElse);
+                                           QbeGen.EmitLabel(lThen);
+                                           hasElse := FALSE; .)
+      "THEN"
+      StatSeq
+      { "ELSIF"                         (. QbeGen.Jmp(lEnd);
+                                           QbeGen.EmitLabel(lElse); .)
+        Expr<t, q>                      (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           QbeGen.NewLabel(lThen);
+                                           QbeGen.NewLabel(lElse);
+                                           QbeGen.Jnz(q, lThen, lElse);
+                                           QbeGen.EmitLabel(lThen); .)
+        "THEN"
+        StatSeq }
+      [ "ELSE"                          (. QbeGen.Jmp(lEnd);
+                                           QbeGen.EmitLabel(lElse);
+                                           hasElse := TRUE; .)
+        StatSeq ]
+      "END"                             (. IF ~hasElse THEN
+                                           QbeGen.EmitLabel(lElse)
+                                         END;
+                                         QbeGen.EmitLabel(lEnd); .) .
+  CaseStat                              (. VAR st: SymTab.TypeIndex;
+                                             sq: QbeGen.QVal;
+                                             lEnd: QbeGen.QVal; .)
+    = "CASE"
+      Expr<st, sq>
+      "OF"                              (. QbeGen.NewLabel(lEnd); .)
+      Case<st, sq, lEnd> { "|"
+                 Case<st, sq, lEnd> }
+      [ "ELSE"
+        StatSeq ]
+      "END"                             (. QbeGen.EmitLabel(lEnd); .) .
+  Case <sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal>
+                                        (. VAR lB, lN: QbeGen.QVal; .)
+    = [ LabelList<sel, sq, lB, lN> ":" (. QbeGen.EmitLabel(lB); .)
+        StatSeq                         (. QbeGen.Jmp(endL);
+                                           QbeGen.EmitLabel(lN); .) ] .
+  LabelList <sel: SymTab.TypeIndex; sq: QbeGen.QVal;
+             VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal>
+    =                                   (. QbeGen.NewLabel(lB);
+                                           QbeGen.NewLabel(lN); .)
+      Labels<sel, sq, lB> { ","
+                    Labels<sel, sq, lB> }
+                                        (. QbeGen.Jmp(lN); .) .
+  Labels <sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal>
+                                        (. VAR t, t2: SymTab.TypeIndex;
+                                             q, q2, qk, qg, ql, qb: QbeGen.QVal;
+                                             lC: QbeGen.QVal;
+                                             r, hasRange: BOOLEAN; .)
+    = ConstExpr<t, q>                   (. IF ~SymTab.EqCheck(t, sel) THEN
+                                           SemError(213) END;
+                                           r := (SymTab.ClassOf(sel)
+                                                 = SymTab.ClReal)
+                                                & (SymTab.ClassOf(t)
+                                                   = SymTab.ClReal);
+                                           hasRange := FALSE; .)
+      [ ".."
+        ConstExpr<t2, q2>               (. IF ~SymTab.EqCheck(t2, sel) THEN
+                                           SemError(213) END;
+                                           hasRange := TRUE; .) ]
+                                        (. IF hasRange THEN
+                                             QbeGen.Cmp(SymTab.OpGe,
+                                               sq, q, qg, r);
+                                             QbeGen.Cmp(SymTab.OpLe,
+                                               sq, q2, ql, r);
+                                             QbeGen.NewTemp(qb);
+                                             QbeGen.Op3("and", qb, qg, ql,
+                                               FALSE)
+                                           ELSE
+                                             QbeGen.Cmp(SymTab.OpEq,
+                                               sq, q, qb, r)
+                                           END;
+                                           QbeGen.NewLabel(lC);
+                                           QbeGen.Jnz(qb, lB, lC);
+                                           QbeGen.EmitLabel(lC); .) .
+  WhileStat                             (. VAR t: SymTab.TypeIndex;
+                                             q: QbeGen.QVal;
+                                             lC, lB, lE: QbeGen.QVal; .)
+    = "WHILE"                           (. QbeGen.NewLabel(lC);
+                                           QbeGen.NewLabel(lB);
+                                           QbeGen.NewLabel(lE);
+                                           QbeGen.EmitLabel(lC); .)
+      Expr<t, q>                        (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           QbeGen.Jnz(q, lB, lE);
+                                           QbeGen.EmitLabel(lB); .)
+      "DO"
+      StatSeq
+      "END"                             (. QbeGen.Jmp(lC);
+                                           QbeGen.EmitLabel(lE); .) .
+  RepeatStat                            (. VAR t: SymTab.TypeIndex;
+                                             q: QbeGen.QVal;
+                                             lTop, lE: QbeGen.QVal; .)
+    = "REPEAT"                          (. QbeGen.NewLabel(lTop);
+                                           QbeGen.NewLabel(lE);
+                                           QbeGen.EmitLabel(lTop); .)
+      StatSeq
+      "UNTIL"
+      Expr<t, q>                        (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           QbeGen.Jnz(q, lE, lTop);
+                                           QbeGen.EmitLabel(lE); .) .
+  LoopStat                              (. VAR lTop, lE: QbeGen.QVal; .)
+    = "LOOP"                            (. QbeGen.NewLabel(lTop);
+                                           QbeGen.NewLabel(lE);
+                                           QbeGen.EmitLabel(lTop);
+                                           QbeGen.PushLoop(lE); .)
+      StatSeq
+      "END"                             (. QbeGen.Jmp(lTop);
+                                           QbeGen.EmitLabel(lE);
+                                           QbeGen.PopLoop; .) .
+  ForStat                               (. VAR n, lv: SymTab.Name;
+                                             lo, hi, by: SymTab.TypeIndex;
+                                             qlo, qhi, qby, hiS, byS: QbeGen.QVal;
+                                             qt, qk: QbeGen.QVal;
+                                             lTop, lChk, lEnd: QbeGen.QVal;
+                                             neg: BOOLEAN; .)
+    = "FOR"
+      GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+                                            SemError(201)
+                                          ELSIF (SymTab.SymKind(n) #
+                                                 SymTab.KindVar)
+                                            & (SymTab.SymKind(n) #
+                                               SymTab.KindField) THEN
+                                            SemError(220)
+                                          ELSIF (SymTab.SymType(n) #
+                                                 SymTab.InvalidType)
+                                            & ~SymTab.IsIntFamily(
+                                                SymTab.SymType(n)) THEN
+                                            SemError(220) END;
+                                            QbeGen.CopyOp(n, lv); .)
+      ":="
+      Expr<lo, qlo>                     (. IF (lo # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(lo) THEN
+                                           SemError(220) END;
+                                           IF (lo # SymTab.InvalidType)
+                                              & SymTab.IsIntFamily(lo) THEN
+                                             QbeGen.StoreVar(lv, qlo, FALSE)
+                                           ELSE
+                                             QbeGen.StoreVar(lv, "0", FALSE)
+                                           END; .)
+      "TO"
+      Expr<hi, qhi>                     (. IF (hi # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(hi) THEN
+                                           SemError(220) END;
+                                           QbeGen.CopyOp(qhi, hiS);
+                                           QbeGen.CopyOp("1", byS);
+                                           neg := FALSE;
+                                           by := SymTab.IntType(); .)
+      [ "BY"
+        ConstExpr<by, qby>              (. IF (by # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(by) THEN
+                                           SemError(220) END;
+                                           IF QbeGen.IsImm(qby) THEN
+                                             QbeGen.CopyOp(qby, byS);
+                                             neg := QbeGen.IsNeg(qby)
+                                           ELSE SemError(230);
+                                             QbeGen.CopyOp("1", byS);
+                                             neg := FALSE
+                                           END; .) ]
+      "DO"                              (. QbeGen.NewLabel(lTop);
+                                           QbeGen.NewLabel(lChk);
+                                           QbeGen.NewLabel(lEnd);
+                                           QbeGen.Jmp(lChk);
+                                           QbeGen.EmitLabel(lTop); .)
+      StatSeq
+      "END"                             (. QbeGen.LoadVar(lv, FALSE, qt);
+                                           QbeGen.NewTemp(qk);
+                                           QbeGen.Op3("add", qk, qt, byS,
+                                             FALSE);
+                                           QbeGen.StoreVar(lv, qk, FALSE);
+                                           QbeGen.EmitLabel(lChk);
+                                           QbeGen.LoadVar(lv, FALSE, qt);
+                                           QbeGen.NewTemp(qk);
+                                           IF neg THEN
+                                             QbeGen.Op3("csgew", qk, qt, hiS,
+                                               FALSE)
+                                           ELSE
+                                             QbeGen.Op3("cslew", qk, qt, hiS,
+                                               FALSE)
+                                           END;
+                                           QbeGen.Jnz(qk, lTop, lEnd);
+                                           QbeGen.EmitLabel(lEnd); .) .
+  WithStat                              (. VAR dt: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             dq: QbeGen.QVal;
+                                             qn: SymTab.Name;
+                                             sfx: BOOLEAN;
+                                             pushed: BOOLEAN; .)
+    = "WITH"
+      Design<dt, dk, dq, qn, sfx>       (. pushed := FALSE;
+                                           IF dt # SymTab.InvalidType THEN
+                                             pushed :=
+                                               SymTab.PushRecord(dt);
+                                             IF ~pushed THEN
+                                               SemError(215)
+                                             END
+                                           END;
+                                           IF pushed THEN
+                                             QbeGen.NoQbeEnter;
+                                             SemError(230)
+                                           END; .)
+      "DO"
+      StatSeq
+      "END"                             (. IF pushed THEN
+                                             SymTab.PopScope;
+                                             QbeGen.NoQbeExit
+                                           END; .) .
+
+  (* Expressions: Designator without ActualParameters.
+     Only record fields resolve qualified access; WITH pushes an
+     inner scope so field names also work unqualified in its body
+     (both report 230 in the scalar subset). Each expression
+     synthesizes its SymTab type in t and its QBE operand in q
+     (an immediate or a fresh %temporary holding the value). *)
+  Design <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+          VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
+                                        (. VAR n, m: SymTab.Name;
+                                             it: SymTab.TypeIndex;
+                                             qr: QbeGen.QVal;
+                                             cls: INTEGER; .)
+    = GetIdent<n>                       (. QbeGen.CopyOp(n, qn);
+                                           sfx := FALSE;
+                                           IF ~SymTab.Lookup(n) THEN
+                                             SemError(201);
+                                             t := SymTab.InvalidType; k := -1;
+                                             QbeGen.CopyOp("0", q)
+                                           ELSE
+                                             t := SymTab.SymType(n);
+                                             k := SymTab.SymKind(n);
+                                             IF k = SymTab.KindConst THEN
+                                               IF SymTab.Equal(n, "TRUE") THEN
+                                                 t := SymTab.BoolType();
+                                                 QbeGen.CopyOp("1", q)
+                                               ELSIF SymTab.Equal(n,
+                                                       "FALSE") THEN
+                                                 t := SymTab.BoolType();
+                                                 QbeGen.CopyOp("0", q)
+                                               ELSE
+                                                 cls :=
+                                                   SymTab.ClassOf(t);
+                                                 IF (t #
+                                                     SymTab.InvalidType)
+                                                    & (cls # SymTab.ClStr)
+                                                    & ((cls = SymTab.ClInt)
+                                                    OR (cls = SymTab.ClReal)
+                                                    OR (cls = SymTab.ClBool)
+                                                    OR (cls = SymTab.ClChar)
+                                                    OR (cls
+                                                        = SymTab.ClEnum)) THEN
+                                                   QbeGen.LoadVar(n,
+                                                     cls = SymTab.ClReal, q)
+                                                 ELSE
+                                                   QbeGen.CopyOp("0", q)
+                                                 END
+                                               END
+                                             ELSIF k = SymTab.KindVar THEN
+                                               cls := SymTab.ClassOf(t);
+                                               IF (cls = SymTab.ClInt)
+                                                  OR (cls = SymTab.ClReal)
+                                                  OR (cls = SymTab.ClBool)
+                                                  OR (cls = SymTab.ClChar)
+                                                  OR (cls
+                                                      = SymTab.ClEnum) THEN
+                                                 QbeGen.LoadVar(n,
+                                                   cls = SymTab.ClReal, q)
+                                               ELSE SemError(230);
+                                                 QbeGen.CopyOp("0", q)
+                                               END
+                                             ELSE QbeGen.CopyOp("0", q);
+                                               IF k = SymTab.KindField THEN
+                                                 IF ~QbeGen.NoQbe() THEN
+                                                   SemError(230)
+                                                 END
+                                               ELSIF k
+                                                     = SymTab.KindImport THEN
+                                                 SemError(230)
+                                               END
+                                             END
+                                           END; .)
+      { "."                             (. sfx := TRUE; .)
+        GetIdent<m>                     (. IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClRecord THEN
+                                             SemError(215);
+                                             t := SymTab.InvalidType
+                                           ELSIF ~SymTab.FieldExists(t, m) THEN
+                                             SemError(216);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.FieldType(t, m);
+                                             SemError(230)
+                                           END;
+                                           QbeGen.CopyOp("0", q); .)
+      | "["                             (. sfx := TRUE; .)
+        Expr<it, qr>                    (. IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClArray THEN
+                                             SemError(217);
+                                             t := SymTab.InvalidType
+                                           ELSIF (it #
+                                                  SymTab.InvalidType)
+                                             & ~SymTab.IsIntFamily(it) THEN
+                                             SemError(218);
+                                             t := SymTab.InvalidType
+                                           ELSE t :=
+                                             SymTab.ArrayElem(t);
+                                             SemError(230)
+                                           END;
+                                           QbeGen.CopyOp("0", q); .)
+        { ","
+          Expr<it, qr>                  (. IF (it # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(it) THEN
+                                           SemError(218) END; .) }
+        "]"
+      | "^"                             (. sfx := TRUE;
+                                           IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClPtr THEN
+                                             SemError(219);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.PtrBase(t);
+                                             SemError(230)
+                                           END;
+                                           QbeGen.CopyOp("0", q); .) } .
+  Expr <VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR t2: SymTab.TypeIndex;
+                                             tc, op: INTEGER;
+                                             q2, qk: QbeGen.QVal;
+                                             r: BOOLEAN; .)
+    = SimExpr<t, q> [ Rel<op> SimExpr<t2, q2>
+      (. IF op = SymTab.OpIn THEN
+           IF SymTab.InCheck(t, t2) THEN
+             t := SymTab.BoolType();
+             SemError(230)
+           ELSE SemError(222);
+             t := SymTab.InvalidType
+           END;
+           QbeGen.CopyOp("0", q)
+         ELSE
+           tc := SymTab.ClassOf(t);
+           IF SymTab.RelCheck(t, t2, op) THEN
+             t := SymTab.BoolType()
+           ELSE SemError(213); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             r := tc = SymTab.ClReal;
+             QbeGen.Cmp(op, q, q2, qk, r);
+             QbeGen.CopyOp(qk, q)
+           ELSE QbeGen.CopyOp("0", q)
+           END
+         END; .) ] .
+  Rel <VAR op: INTEGER>
+    = "="                     (. op := SymTab.OpEq; .)
+    | "#"                     (. op := SymTab.OpNeq1; .)
+    | "<>"                    (. op := SymTab.OpNeq2; .)
+    | "<"                     (. op := SymTab.OpLt; .)
+    | "<="                    (. op := SymTab.OpLe; .)
+    | ">"                     (. op := SymTab.OpGt; .)
+    | ">="                    (. op := SymTab.OpGe; .)
+    | "IN"                    (. op := SymTab.OpIn; .) .
+  SimExpr <VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR t2, res2: SymTab.TypeIndex;
+                                             op: INTEGER;
+                                             q2, qt: QbeGen.QVal;
+                                             neg, isR: BOOLEAN; .)
+    =                                   (. neg := FALSE; .)
+      [ "+" | "-"                       (. neg := TRUE; .) ]
+      Term<t, q>                        (. IF neg THEN
+                                           IF QbeGen.IsImm(q) THEN
+                                             QbeGen.NegFold(q, q)
+                                           ELSE QbeGen.NewTemp(qt);
+                                             QbeGen.NegQ(q, qt,
+                                               SymTab.ClassOf(t)
+                                               = SymTab.ClReal);
+                                             QbeGen.CopyOp(qt, q)
+                                           END
+                                         END; .)
+      { AddOp<op> Term<t2, q2>
+      (. IF op = SymTab.OpOr THEN
+           IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+             t := SymTab.BoolType()
+           ELSE SemError(212); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             QbeGen.NewTemp(qt);
+             QbeGen.Op3("or", qt, q, q2, FALSE);
+             QbeGen.CopyOp(qt, q)
+           ELSE QbeGen.CopyOp("0", q)
+           END
+         ELSE
+           IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
+           ELSE SemError(211); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             isR := SymTab.ClassOf(t) = SymTab.ClReal;
+             QbeGen.NewTemp(qt);
+             IF op = SymTab.OpAdd THEN
+               QbeGen.Op3("add", qt, q, q2, isR)
+             ELSE
+               QbeGen.Op3("sub", qt, q, q2, isR)
+             END;
+             QbeGen.CopyOp(qt, q)
+           ELSE QbeGen.CopyOp("0", q)
+           END
+         END; .) } .
+  AddOp <VAR op: INTEGER>
+    = "+"                     (. op := SymTab.OpAdd; .)
+    | "-"                     (. op := SymTab.OpSub; .)
+    | "OR"                    (. op := SymTab.OpOr; .) .
+  Term <VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR t2, res2: SymTab.TypeIndex;
+                                             op: INTEGER;
+                                             q2, qt: QbeGen.QVal;
+                                             isR: BOOLEAN; .)
+    = Fact<t, q> { MulOp<op> Fact<t2, q2>
+      (. IF op = SymTab.OpAnd THEN
+           IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+             t := SymTab.BoolType()
+           ELSE SemError(212); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             QbeGen.NewTemp(qt);
+             QbeGen.Op3("and", qt, q, q2, FALSE);
+             QbeGen.CopyOp(qt, q)
+           ELSE QbeGen.CopyOp("0", q)
+           END
+         ELSE
+           IF SymTab.ArithCheck(t, t2,
+                (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+                res2) THEN t := res2
+           ELSE SemError(211); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             isR := SymTab.ClassOf(t) = SymTab.ClReal;
+             QbeGen.NewTemp(qt);
+             IF op = SymTab.OpTimes THEN
+               QbeGen.Op3("mul", qt, q, q2, isR)
+             ELSIF op = SymTab.OpSlash THEN
+               QbeGen.Op3("div", qt, q, q2, isR)
+             ELSIF op = SymTab.OpDiv THEN
+               QbeGen.Op3("div", qt, q, q2, FALSE)
+             ELSE
+               QbeGen.Op3("rem", qt, q, q2, FALSE)
+             END;
+             QbeGen.CopyOp(qt, q)
+           ELSE QbeGen.CopyOp("0", q)
+           END
+         END; .) } .
+  MulOp <VAR op: INTEGER>
+    = "*"                     (. op := SymTab.OpTimes; .)
+    | "/"                     (. op := SymTab.OpSlash; .)
+    | "DIV"                   (. op := SymTab.OpDiv; .)
+    | "MOD"                   (. op := SymTab.OpMod; .)
+    | "AND"                   (. op := SymTab.OpAnd; .)
+    | "&"                     (. op := SymTab.OpAnd; .) .
+  Fact <VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR s: ARRAY [0 .. 255] OF CHAR;
+                                             t2, et, dt, st: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             qd, q2: QbeGen.QVal;
+                                             qnF: SymTab.Name;
+                                             sfxF: BOOLEAN; .)
+    = integer                         (. LexString(s);
+                                         QbeGen.NormInt(s, q);
+                                         t := SymTab.IntType(); .)
+    | real                            (. LexString(s);
+                                         QbeGen.NormReal(s, q);
+                                         t := SymTab.RealType(); .)
+    | string                          (. LexString(s);
+                                         IF SymTab.StrLen(s) <= 3 THEN
+                                           t := SymTab.CharType();
+                                           QbeGen.IntStr(
+                                             QbeGen.CharVal(s), q)
+                                         ELSE t := SymTab.NewStr();
+                                           SemError(230);
+                                           QbeGen.CopyOp("0", q)
+                                         END; .)
+    | Design<dt, dk, qd, qnF, sfxF>    (. t := dt;
+                                         QbeGen.CopyOp(qd, q); .)
+    | "("
+      Expr<et, q> ")"                 (. t := et; .)
+    | ( "NOT" | "~" )
+      Fact<t2, q2>                    (. IF SymTab.BoolCheck(t2) THEN
+                                           t := SymTab.BoolType()
+                                         ELSE SemError(212);
+                                           t := SymTab.InvalidType END;
+                                         IF t # SymTab.InvalidType THEN
+                                           QbeGen.NotQ(q2, q)
+                                         ELSE QbeGen.CopyOp("0", q)
+                                         END; .)
+    | SetLit<st>                      (. t := st;
+                                         SemError(230);
+                                         QbeGen.CopyOp("0", q); .) .
+  SetLit <VAR t: SymTab.TypeIndex>
+                                        (. VAR first, et: SymTab.TypeIndex;
+                                             qe: QbeGen.QVal; .)
+    = "{"
+                                (. t := SymTab.SetFor(SymTab.IntType()); .)
+      [ Elem<et, qe>            (. first := et; t := SymTab.SetFor(et); .)
+        { ","
+          Elem<et, qe>          (. IF ~SymTab.SetElemCheck(first, et) THEN
+                                SemError(222) END; .) } ]
+      "}" .
+  Elem <VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR t2: SymTab.TypeIndex;
+                                             q2: QbeGen.QVal; .)
+    = Expr<t, q> [ ".."
+                Expr<t2, q2>    (. IF ~SymTab.SetElemCheck(t, t2) THEN
+                                SemError(222) END; .) ] .
+
+  GetIdent <VAR n: SymTab.Name>
+    = ident                           (. LexName(n); .) .
+
+END SimpleQ.

Test2/SimpleQ.mod

@@ -0,0 +1,315 @@
+MODULE SimpleQ;
+(* This is an example of a rudimentary main module for use with COCO/R.
+   It assumes the FileIO/Storage I/O libraries (as supplied with this
+   project) are available.
+   The auxiliary modules <Grammar>S (scanner) and <Grammar>P (parser)
+   are assumed to have been constructed with COCO/R compiler generator. *)
+
+  FROM SimpleQS IMPORT lst, src, errors, Error, CharAt;
+  FROM SimpleQP IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+    (* and any others needed *)
+
+  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("integer expected")
+        |  3: Msg("real expected")
+        |  4: Msg("string expected")
+        |  5: Msg("'MODULE' expected")
+        |  6: Msg("';' expected")
+        |  7: Msg("'.' expected")
+        |  8: Msg("'FROM' expected")
+        |  9: Msg("'IMPORT' expected")
+        | 10: Msg("',' expected")
+        | 11: Msg("'BEGIN' expected")
+        | 12: Msg("'END' expected")
+        | 13: Msg("'CONST' expected")
+        | 14: Msg("'TYPE' expected")
+        | 15: Msg("'VAR' expected")
+        | 16: Msg("'=' expected")
+        | 17: Msg("':' expected")
+        | 18: Msg("'[' expected")
+        | 19: Msg("'..' expected")
+        | 20: Msg("']' expected")
+        | 21: Msg("'(' expected")
+        | 22: Msg("')' expected")
+        | 23: Msg("'ARRAY' expected")
+        | 24: Msg("'OF' expected")
+        | 25: Msg("'RECORD' expected")
+        | 26: Msg("'SET' expected")
+        | 27: Msg("'POINTER' expected")
+        | 28: Msg("'TO' expected")
+        | 29: Msg("'EXIT' expected")
+        | 30: Msg("':=' expected")
+        | 31: Msg("'IF' expected")
+        | 32: Msg("'THEN' expected")
+        | 33: Msg("'ELSIF' expected")
+        | 34: Msg("'ELSE' expected")
+        | 35: Msg("'CASE' expected")
+        | 36: Msg("'|' expected")
+        | 37: Msg("'WHILE' expected")
+        | 38: Msg("'DO' expected")
+        | 39: Msg("'REPEAT' expected")
+        | 40: Msg("'UNTIL' expected")
+        | 41: Msg("'LOOP' expected")
+        | 42: Msg("'FOR' expected")
+        | 43: Msg("'BY' expected")
+        | 44: Msg("'WITH' expected")
+        | 45: Msg("'^' expected")
+        | 46: Msg("'#' expected")
+        | 47: Msg("'<>' expected")
+        | 48: Msg("'<' expected")
+        | 49: Msg("'<=' expected")
+        | 50: Msg("'>' expected")
+        | 51: Msg("'>=' expected")
+        | 52: Msg("'IN' expected")
+        | 53: Msg("'+' expected")
+        | 54: Msg("'-' expected")
+        | 55: Msg("'OR' expected")
+        | 56: Msg("'*' expected")
+        | 57: Msg("'/' expected")
+        | 58: Msg("'DIV' expected")
+        | 59: Msg("'MOD' expected")
+        | 60: Msg("'AND' expected")
+        | 61: Msg("'&' expected")
+        | 62: Msg("'NOT' expected")
+        | 63: Msg("'~' expected")
+        | 64: Msg("'{' expected")
+        | 65: Msg("'}' expected")
+        | 66: Msg("not expected")
+        | 67: Msg("invalid MulOp")
+        | 68: Msg("invalid Fact")
+        | 69: Msg("invalid AddOp")
+        | 70: Msg("invalid Rel")
+        | 71: Msg("invalid SimpleType")
+        | 72: Msg("invalid Type")
+        | 73: Msg("invalid Declaration")
+        | 74: Msg("invalid Import")
+        
+        (* add customized cases here *)
+        | 200: Msg("duplicate identifier")
+        | 201: Msg("undeclared identifier")
+        | 202: Msg("module name mismatch")
+        | 210: Msg("incompatible assignment")
+        | 211: Msg("arithmetic operand must be numeric")
+        | 212: Msg("boolean operand required")
+        | 213: Msg("incompatible comparison")
+        | 214: Msg("BOOLEAN condition required")
+        | 215: Msg("not a RECORD type")
+        | 216: Msg("unknown field")
+        | 217: Msg("not an ARRAY type")
+        | 218: Msg("array index must be integer")
+        | 219: Msg("not a POINTER type")
+        | 220: Msg("FOR needs integer variable and bounds")
+        | 221: Msg("not a type name")
+        | 222: Msg("set operand mismatch")
+        | 223: Msg("cyclical type definition")
+        | 224: Msg("ordinal type required")
+        | 230: Msg("qbe backend: construct not supported in scalar subset")
+        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 as complete file name by appending ext to oldName
+     Examples: (assume ext = "EXT")
+           old.any ==> old.EXT
+           old     ==> old.EXT
+     This is not a file renaming facility, merely a string manipulation
+     routine. *)
+    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");
+        (* ++++++++ Add further activities if required ++++++++++ *)
+    END;
+  END SimpleQ.

Test2/SimpleQP.def

@@ -0,0 +1,28 @@
+DEFINITION MODULE SimpleQP;
+
+(* 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 SimpleQP.

Test2/SimpleQP.mod

@@ -0,0 +1,1418 @@
+IMPLEMENTATION MODULE SimpleQP;
+
+(* Parser generated by Coco/R - assuming ISO IO library will be available. *)
+
+IMPORT SimpleQS, FileIO;
+
+IMPORT SymTab, QbeGen;
+
+
+
+CONST 
+  maxT = 66;
+  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 ..   4] 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
+      SimpleQS.Error(errNo, SimpleQS.line, SimpleQS.col, SimpleQS.pos);
+    END;
+    errDist := 0;
+  END SemError;
+
+PROCEDURE SynError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      SimpleQS.Error(errNo, SimpleQS.nextLine, SimpleQS.nextCol, SimpleQS.nextPos);
+    END;
+    errDist := 0;
+  END SynError;
+
+PROCEDURE Get;
+  VAR
+    s: ARRAY [0 .. 31] OF CHAR;
+  BEGIN
+    REPEAT
+      SimpleQS.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
+    SimpleQS.GetName(SimpleQS.pos, SimpleQS.len, Lex)
+  END LexName;
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    SimpleQS.GetString(SimpleQS.pos, SimpleQS.len, Lex)
+  END LexString;
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    SimpleQS.GetName(SimpleQS.nextPos, SimpleQS.nextLen, Lex)
+  END LookAheadName;
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    SimpleQS.GetString(SimpleQS.nextPos, SimpleQS.nextLen, Lex)
+  END LookAheadString;
+
+PROCEDURE Successful (): BOOLEAN;
+  BEGIN
+    RETURN SimpleQS.errors = 0
+  END Successful;
+
+(* ----- FORWARD not needed in multipass compilers
+
+PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
+PROCEDURE SetLit (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE MulOp (VAR op: INTEGER); FORWARD;
+PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
+PROCEDURE AddOp (VAR op: INTEGER); FORWARD;
+PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
+PROCEDURE Rel (VAR op: INTEGER); FORWARD;
+PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
+PROCEDURE Labels (sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal); FORWARD;
+PROCEDURE LabelList (sel: SymTab.TypeIndex; sq: QbeGen.QVal;
+                      VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal); FORWARD;
+PROCEDURE Case (sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal); FORWARD;
+PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+                   VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN); FORWARD;
+PROCEDURE WithStat; FORWARD;
+PROCEDURE ForStat; FORWARD;
+PROCEDURE LoopStat; FORWARD;
+PROCEDURE RepeatStat; FORWARD;
+PROCEDURE WhileStat; FORWARD;
+PROCEDURE CaseStat; FORWARD;
+PROCEDURE IfStat; FORWARD;
+PROCEDURE Assign; FORWARD;
+PROCEDURE Stat; FORWARD;
+PROCEDURE FieldIdents (rt: SymTab.TypeIndex); FORWARD;
+PROCEDURE Field (rt: SymTab.TypeIndex); FORWARD;
+PROCEDURE FieldSeq (rt: SymTab.TypeIndex); FORWARD;
+PROCEDURE Enum (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE PointerType (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE SetType (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE RecordType (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE VarIdents; FORWARD;
+PROCEDURE Type (VAR t: SymTab.TypeIndex); FORWARD;
+PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
+PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
+PROCEDURE VarDecl; FORWARD;
+PROCEDURE TypeDecl; FORWARD;
+PROCEDURE ConstDecl; FORWARD;
+PROCEDURE StatSeq; FORWARD;
+PROCEDURE Declaration; FORWARD;
+PROCEDURE ImportList; FORWARD;
+PROCEDURE Block; FORWARD;
+PROCEDURE Import; FORWARD;
+PROCEDURE GetIdent (VAR n: SymTab.Name); FORWARD;
+PROCEDURE SimpleQ; FORWARD;
+
+----- *)
+
+PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+  VAR t2: SymTab.TypeIndex;
+    q2: QbeGen.QVal;
+  BEGIN
+    Expr(t, q);
+    IF (sym = 19) THEN
+      Get;
+      Expr(t2, q2);
+      IF ~SymTab.SetElemCheck(t, t2) THEN
+      SemError(222) END;;
+    END;
+  END Elem;
+
+PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
+  VAR first, et: SymTab.TypeIndex;
+    qe: QbeGen.QVal;
+  BEGIN
+    Expect(64);
+    t := SymTab.SetFor(SymTab.IntType());;
+    IF In(symSet[1], sym) THEN
+      Elem(et, qe);
+      first := et; t := SymTab.SetFor(et);;
+      WHILE (sym = 10) DO
+        Get;
+        Elem(et, qe);
+        IF ~SymTab.SetElemCheck(first, et) THEN
+        SemError(222) END;;
+      END;
+    END;
+    Expect(65);
+  END SetLit;
+
+PROCEDURE MulOp (VAR op: INTEGER);
+  BEGIN
+    CASE sym OF
+      56 :
+        Get;
+        op := SymTab.OpTimes;;
+    | 57 :
+        Get;
+        op := SymTab.OpSlash;;
+    | 58 :
+        Get;
+        op := SymTab.OpDiv;;
+    | 59 :
+        Get;
+        op := SymTab.OpMod;;
+    | 60 :
+        Get;
+        op := SymTab.OpAnd;;
+    | 61 :
+        Get;
+        op := SymTab.OpAnd;;
+    ELSE SynError(67);
+    END;
+  END MulOp;
+
+PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+  VAR s: ARRAY [0 .. 255] OF CHAR;
+    t2, et, dt, st: SymTab.TypeIndex;
+    dk: INTEGER;
+    qd, q2: QbeGen.QVal;
+    qnF: SymTab.Name;
+    sfxF: BOOLEAN;
+  BEGIN
+    CASE sym OF
+      2 :
+        Get;
+        LexString(s);
+        QbeGen.NormInt(s, q);
+        t := SymTab.IntType();;
+    | 3 :
+        Get;
+        LexString(s);
+        QbeGen.NormReal(s, q);
+        t := SymTab.RealType();;
+    | 4 :
+        Get;
+        LexString(s);
+        IF SymTab.StrLen(s) <= 3 THEN
+          t := SymTab.CharType();
+          QbeGen.IntStr(
+            QbeGen.CharVal(s), q)
+        ELSE t := SymTab.NewStr();
+          SemError(230);
+          QbeGen.CopyOp("0", q)
+        END;;
+    | 1 :
+        Design(dt, dk, qd, qnF, sfxF);
+        t := dt;
+        QbeGen.CopyOp(qd, q);;
+    | 21 :
+        Get;
+        Expr(et, q);
+        Expect(22);
+        t := et;;
+    | 62, 63 :
+        IF (sym = 62) THEN
+          Get;
+        ELSE
+          Get;
+        END;
+        Fact(t2, q2);
+        IF SymTab.BoolCheck(t2) THEN
+          t := SymTab.BoolType()
+        ELSE SemError(212);
+          t := SymTab.InvalidType END;
+        IF t # SymTab.InvalidType THEN
+          QbeGen.NotQ(q2, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END;;
+    | 64 :
+        SetLit(st);
+        t := st;
+        SemError(230);
+        QbeGen.CopyOp("0", q);;
+    ELSE SynError(68);
+    END;
+  END Fact;
+
+PROCEDURE AddOp (VAR op: INTEGER);
+  BEGIN
+    IF (sym = 53) THEN
+      Get;
+      op := SymTab.OpAdd;;
+    ELSIF (sym = 54) THEN
+      Get;
+      op := SymTab.OpSub;;
+    ELSIF (sym = 55) THEN
+      Get;
+      op := SymTab.OpOr;;
+    ELSE SynError(69);
+    END;
+  END AddOp;
+
+PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+  VAR t2, res2: SymTab.TypeIndex;
+    op: INTEGER;
+    q2, qt: QbeGen.QVal;
+    isR: BOOLEAN;
+  BEGIN
+    Fact(t, q);
+    WHILE In(symSet[2], sym) DO
+      MulOp(op);
+      Fact(t2, q2);
+      IF op = SymTab.OpAnd THEN
+        IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+          t := SymTab.BoolType()
+        ELSE SemError(212); t := SymTab.InvalidType END;
+        IF t # SymTab.InvalidType THEN
+          QbeGen.NewTemp(qt);
+          QbeGen.Op3("and", qt, q, q2, FALSE);
+          QbeGen.CopyOp(qt, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END
+      ELSE
+        IF SymTab.ArithCheck(t, t2,
+             (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+             res2) THEN t := res2
+        ELSE SemError(211); t := SymTab.InvalidType END;
+        IF t # SymTab.InvalidType THEN
+          isR := SymTab.ClassOf(t) = SymTab.ClReal;
+          QbeGen.NewTemp(qt);
+          IF op = SymTab.OpTimes THEN
+            QbeGen.Op3("mul", qt, q, q2, isR)
+          ELSIF op = SymTab.OpSlash THEN
+            QbeGen.Op3("div", qt, q, q2, isR)
+          ELSIF op = SymTab.OpDiv THEN
+            QbeGen.Op3("div", qt, q, q2, FALSE)
+          ELSE
+            QbeGen.Op3("rem", qt, q, q2, FALSE)
+          END;
+          QbeGen.CopyOp(qt, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END
+      END;;
+    END;
+  END Term;
+
+PROCEDURE Rel (VAR op: INTEGER);
+  BEGIN
+    CASE sym OF
+      16 :
+        Get;
+        op := SymTab.OpEq;;
+    | 46 :
+        Get;
+        op := SymTab.OpNeq1;;
+    | 47 :
+        Get;
+        op := SymTab.OpNeq2;;
+    | 48 :
+        Get;
+        op := SymTab.OpLt;;
+    | 49 :
+        Get;
+        op := SymTab.OpLe;;
+    | 50 :
+        Get;
+        op := SymTab.OpGt;;
+    | 51 :
+        Get;
+        op := SymTab.OpGe;;
+    | 52 :
+        Get;
+        op := SymTab.OpIn;;
+    ELSE SynError(70);
+    END;
+  END Rel;
+
+PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+  VAR t2, res2: SymTab.TypeIndex;
+    op: INTEGER;
+    q2, qt: QbeGen.QVal;
+    neg, isR: BOOLEAN;
+  BEGIN
+    neg := FALSE;;
+    IF (sym = 53) OR (sym = 54) THEN
+      IF (sym = 53) THEN
+        Get;
+      ELSE
+        Get;
+        neg := TRUE;;
+      END;
+    END;
+    Term(t, q);
+    IF neg THEN
+    IF QbeGen.IsImm(q) THEN
+      QbeGen.NegFold(q, q)
+    ELSE QbeGen.NewTemp(qt);
+      QbeGen.NegQ(q, qt,
+        SymTab.ClassOf(t)
+        = SymTab.ClReal);
+      QbeGen.CopyOp(qt, q)
+    END
+    END;;
+    WHILE (sym = 53) OR (sym = 54) OR (sym = 55) DO
+      AddOp(op);
+      Term(t2, q2);
+      IF op = SymTab.OpOr THEN
+        IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+          t := SymTab.BoolType()
+        ELSE SemError(212); t := SymTab.InvalidType END;
+        IF t # SymTab.InvalidType THEN
+          QbeGen.NewTemp(qt);
+          QbeGen.Op3("or", qt, q, q2, FALSE);
+          QbeGen.CopyOp(qt, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END
+      ELSE
+        IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
+        ELSE SemError(211); t := SymTab.InvalidType END;
+        IF t # SymTab.InvalidType THEN
+          isR := SymTab.ClassOf(t) = SymTab.ClReal;
+          QbeGen.NewTemp(qt);
+          IF op = SymTab.OpAdd THEN
+            QbeGen.Op3("add", qt, q, q2, isR)
+          ELSE
+            QbeGen.Op3("sub", qt, q, q2, isR)
+          END;
+          QbeGen.CopyOp(qt, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END
+      END;;
+    END;
+  END SimExpr;
+
+PROCEDURE Labels (sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal);
+  VAR t, t2: SymTab.TypeIndex;
+    q, q2, qk, qg, ql, qb: QbeGen.QVal;
+    lC: QbeGen.QVal;
+    r, hasRange: BOOLEAN;
+  BEGIN
+    ConstExpr(t, q);
+    IF ~SymTab.EqCheck(t, sel) THEN
+    SemError(213) END;
+    r := (SymTab.ClassOf(sel)
+          = SymTab.ClReal)
+         & (SymTab.ClassOf(t)
+            = SymTab.ClReal);
+    hasRange := FALSE;;
+    IF (sym = 19) THEN
+      Get;
+      ConstExpr(t2, q2);
+      IF ~SymTab.EqCheck(t2, sel) THEN
+      SemError(213) END;
+      hasRange := TRUE;;
+    END;
+    IF hasRange THEN
+      QbeGen.Cmp(SymTab.OpGe,
+        sq, q, qg, r);
+      QbeGen.Cmp(SymTab.OpLe,
+        sq, q2, ql, r);
+      QbeGen.NewTemp(qb);
+      QbeGen.Op3("and", qb, qg, ql,
+        FALSE)
+    ELSE
+      QbeGen.Cmp(SymTab.OpEq,
+        sq, q, qb, r)
+    END;
+    QbeGen.NewLabel(lC);
+    QbeGen.Jnz(qb, lB, lC);
+    QbeGen.EmitLabel(lC);;
+  END Labels;
+
+PROCEDURE LabelList (sel: SymTab.TypeIndex; sq: QbeGen.QVal;
+                      VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal);
+  BEGIN
+    QbeGen.NewLabel(lB);
+    QbeGen.NewLabel(lN);;
+    Labels(sel, sq, lB);
+    WHILE (sym = 10) DO
+      Get;
+      Labels(sel, sq, lB);
+    END;
+    QbeGen.Jmp(lN);;
+  END LabelList;
+
+PROCEDURE Case (sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal);
+  VAR lB, lN: QbeGen.QVal;
+  BEGIN
+    IF In(symSet[1], sym) THEN
+      LabelList(sel, sq, lB, lN);
+      Expect(17);
+      QbeGen.EmitLabel(lB);;
+      StatSeq;
+      QbeGen.Jmp(endL);
+      QbeGen.EmitLabel(lN);;
+    END;
+  END Case;
+
+PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+                   VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN);
+  VAR n, m: SymTab.Name;
+    it: SymTab.TypeIndex;
+    qr: QbeGen.QVal;
+    cls: INTEGER;
+  BEGIN
+    GetIdent(n);
+    QbeGen.CopyOp(n, qn);
+    sfx := FALSE;
+    IF ~SymTab.Lookup(n) THEN
+      SemError(201);
+      t := SymTab.InvalidType; k := -1;
+      QbeGen.CopyOp("0", q)
+    ELSE
+      t := SymTab.SymType(n);
+      k := SymTab.SymKind(n);
+      IF k = SymTab.KindConst THEN
+        IF SymTab.Equal(n, "TRUE") THEN
+          t := SymTab.BoolType();
+          QbeGen.CopyOp("1", q)
+        ELSIF SymTab.Equal(n,
+                "FALSE") THEN
+          t := SymTab.BoolType();
+          QbeGen.CopyOp("0", q)
+        ELSE
+          cls :=
+            SymTab.ClassOf(t);
+          IF (t #
+              SymTab.InvalidType)
+             & (cls # SymTab.ClStr)
+             & ((cls = SymTab.ClInt)
+             OR (cls = SymTab.ClReal)
+             OR (cls = SymTab.ClBool)
+             OR (cls = SymTab.ClChar)
+             OR (cls
+                 = SymTab.ClEnum)) THEN
+            QbeGen.LoadVar(n,
+              cls = SymTab.ClReal, q)
+          ELSE
+            QbeGen.CopyOp("0", q)
+          END
+        END
+      ELSIF k = SymTab.KindVar THEN
+        cls := SymTab.ClassOf(t);
+        IF (cls = SymTab.ClInt)
+           OR (cls = SymTab.ClReal)
+           OR (cls = SymTab.ClBool)
+           OR (cls = SymTab.ClChar)
+           OR (cls
+               = SymTab.ClEnum) THEN
+          QbeGen.LoadVar(n,
+            cls = SymTab.ClReal, q)
+        ELSE SemError(230);
+          QbeGen.CopyOp("0", q)
+        END
+      ELSE QbeGen.CopyOp("0", q);
+        IF k = SymTab.KindField THEN
+          IF ~QbeGen.NoQbe() THEN
+            SemError(230)
+          END
+        ELSIF k
+              = SymTab.KindImport THEN
+          SemError(230)
+        END
+      END
+    END;;
+    WHILE (sym = 7) OR (sym = 18) OR (sym = 45) DO
+      IF (sym = 7) THEN
+        Get;
+        sfx := TRUE;;
+        GetIdent(m);
+        IF t = SymTab.InvalidType THEN
+        ELSIF SymTab.ClassOf(t) #
+              SymTab.ClRecord THEN
+          SemError(215);
+          t := SymTab.InvalidType
+        ELSIF ~SymTab.FieldExists(t, m) THEN
+          SemError(216);
+          t := SymTab.InvalidType
+        ELSE t := SymTab.FieldType(t, m);
+          SemError(230)
+        END;
+        QbeGen.CopyOp("0", q);;
+      ELSIF (sym = 18) THEN
+        Get;
+        sfx := TRUE;;
+        Expr(it, qr);
+        IF t = SymTab.InvalidType THEN
+        ELSIF SymTab.ClassOf(t) #
+              SymTab.ClArray THEN
+          SemError(217);
+          t := SymTab.InvalidType
+        ELSIF (it #
+               SymTab.InvalidType)
+          & ~SymTab.IsIntFamily(it) THEN
+          SemError(218);
+          t := SymTab.InvalidType
+        ELSE t :=
+          SymTab.ArrayElem(t);
+          SemError(230)
+        END;
+        QbeGen.CopyOp("0", q);;
+        WHILE (sym = 10) DO
+          Get;
+          Expr(it, qr);
+          IF (it # SymTab.InvalidType)
+          & ~SymTab.IsIntFamily(it) THEN
+          SemError(218) END;;
+        END;
+        Expect(20);
+      ELSE
+        Get;
+        sfx := TRUE;
+        IF t = SymTab.InvalidType THEN
+        ELSIF SymTab.ClassOf(t) #
+              SymTab.ClPtr THEN
+          SemError(219);
+          t := SymTab.InvalidType
+        ELSE t := SymTab.PtrBase(t);
+          SemError(230)
+        END;
+        QbeGen.CopyOp("0", q);;
+      END;
+    END;
+  END Design;
+
+PROCEDURE WithStat;
+  VAR dt: SymTab.TypeIndex;
+    dk: INTEGER;
+    dq: QbeGen.QVal;
+    qn: SymTab.Name;
+    sfx: BOOLEAN;
+    pushed: BOOLEAN;
+  BEGIN
+    Expect(44);
+    Design(dt, dk, dq, qn, sfx);
+    pushed := FALSE;
+    IF dt # SymTab.InvalidType THEN
+      pushed :=
+        SymTab.PushRecord(dt);
+      IF ~pushed THEN
+        SemError(215)
+      END
+    END;
+    IF pushed THEN
+      QbeGen.NoQbeEnter;
+      SemError(230)
+    END;;
+    Expect(38);
+    StatSeq;
+    Expect(12);
+    IF pushed THEN
+      SymTab.PopScope;
+      QbeGen.NoQbeExit
+    END;;
+  END WithStat;
+
+PROCEDURE ForStat;
+  VAR n, lv: SymTab.Name;
+    lo, hi, by: SymTab.TypeIndex;
+    qlo, qhi, qby, hiS, byS: QbeGen.QVal;
+    qt, qk: QbeGen.QVal;
+    lTop, lChk, lEnd: QbeGen.QVal;
+    neg: BOOLEAN;
+  BEGIN
+    Expect(42);
+    GetIdent(n);
+    IF ~SymTab.Lookup(n) THEN
+     SemError(201)
+    ELSIF (SymTab.SymKind(n) #
+          SymTab.KindVar)
+     & (SymTab.SymKind(n) #
+        SymTab.KindField) THEN
+     SemError(220)
+    ELSIF (SymTab.SymType(n) #
+          SymTab.InvalidType)
+     & ~SymTab.IsIntFamily(
+         SymTab.SymType(n)) THEN
+     SemError(220) END;
+     QbeGen.CopyOp(n, lv);;
+    Expect(30);
+    Expr(lo, qlo);
+    IF (lo # SymTab.InvalidType)
+    & ~SymTab.IsIntFamily(lo) THEN
+    SemError(220) END;
+    IF (lo # SymTab.InvalidType)
+       & SymTab.IsIntFamily(lo) THEN
+      QbeGen.StoreVar(lv, qlo, FALSE)
+    ELSE
+      QbeGen.StoreVar(lv, "0", FALSE)
+    END;;
+    Expect(28);
+    Expr(hi, qhi);
+    IF (hi # SymTab.InvalidType)
+    & ~SymTab.IsIntFamily(hi) THEN
+    SemError(220) END;
+    QbeGen.CopyOp(qhi, hiS);
+    QbeGen.CopyOp("1", byS);
+    neg := FALSE;
+    by := SymTab.IntType();;
+    IF (sym = 43) THEN
+      Get;
+      ConstExpr(by, qby);
+      IF (by # SymTab.InvalidType)
+      & ~SymTab.IsIntFamily(by) THEN
+      SemError(220) END;
+      IF QbeGen.IsImm(qby) THEN
+        QbeGen.CopyOp(qby, byS);
+        neg := QbeGen.IsNeg(qby)
+      ELSE SemError(230);
+        QbeGen.CopyOp("1", byS);
+        neg := FALSE
+      END;;
+    END;
+    Expect(38);
+    QbeGen.NewLabel(lTop);
+    QbeGen.NewLabel(lChk);
+    QbeGen.NewLabel(lEnd);
+    QbeGen.Jmp(lChk);
+    QbeGen.EmitLabel(lTop);;
+    StatSeq;
+    Expect(12);
+    QbeGen.LoadVar(lv, FALSE, qt);
+    QbeGen.NewTemp(qk);
+    QbeGen.Op3("add", qk, qt, byS,
+      FALSE);
+    QbeGen.StoreVar(lv, qk, FALSE);
+    QbeGen.EmitLabel(lChk);
+    QbeGen.LoadVar(lv, FALSE, qt);
+    QbeGen.NewTemp(qk);
+    IF neg THEN
+      QbeGen.Op3("csgew", qk, qt, hiS,
+        FALSE)
+    ELSE
+      QbeGen.Op3("cslew", qk, qt, hiS,
+        FALSE)
+    END;
+    QbeGen.Jnz(qk, lTop, lEnd);
+    QbeGen.EmitLabel(lEnd);;
+  END ForStat;
+
+PROCEDURE LoopStat;
+  VAR lTop, lE: QbeGen.QVal;
+  BEGIN
+    Expect(41);
+    QbeGen.NewLabel(lTop);
+    QbeGen.NewLabel(lE);
+    QbeGen.EmitLabel(lTop);
+    QbeGen.PushLoop(lE);;
+    StatSeq;
+    Expect(12);
+    QbeGen.Jmp(lTop);
+    QbeGen.EmitLabel(lE);
+    QbeGen.PopLoop;;
+  END LoopStat;
+
+PROCEDURE RepeatStat;
+  VAR t: SymTab.TypeIndex;
+    q: QbeGen.QVal;
+    lTop, lE: QbeGen.QVal;
+  BEGIN
+    Expect(39);
+    QbeGen.NewLabel(lTop);
+    QbeGen.NewLabel(lE);
+    QbeGen.EmitLabel(lTop);;
+    StatSeq;
+    Expect(40);
+    Expr(t, q);
+    IF ~SymTab.BoolCheck(t) THEN
+    SemError(214) END;
+    QbeGen.Jnz(q, lE, lTop);
+    QbeGen.EmitLabel(lE);;
+  END RepeatStat;
+
+PROCEDURE WhileStat;
+  VAR t: SymTab.TypeIndex;
+    q: QbeGen.QVal;
+    lC, lB, lE: QbeGen.QVal;
+  BEGIN
+    Expect(37);
+    QbeGen.NewLabel(lC);
+    QbeGen.NewLabel(lB);
+    QbeGen.NewLabel(lE);
+    QbeGen.EmitLabel(lC);;
+    Expr(t, q);
+    IF ~SymTab.BoolCheck(t) THEN
+    SemError(214) END;
+    QbeGen.Jnz(q, lB, lE);
+    QbeGen.EmitLabel(lB);;
+    Expect(38);
+    StatSeq;
+    Expect(12);
+    QbeGen.Jmp(lC);
+    QbeGen.EmitLabel(lE);;
+  END WhileStat;
+
+PROCEDURE CaseStat;
+  VAR st: SymTab.TypeIndex;
+    sq: QbeGen.QVal;
+    lEnd: QbeGen.QVal;
+  BEGIN
+    Expect(35);
+    Expr(st, sq);
+    Expect(24);
+    QbeGen.NewLabel(lEnd);;
+    Case(st, sq, lEnd);
+    WHILE (sym = 36) DO
+      Get;
+      Case(st, sq, lEnd);
+    END;
+    IF (sym = 34) THEN
+      Get;
+      StatSeq;
+    END;
+    Expect(12);
+    QbeGen.EmitLabel(lEnd);;
+  END CaseStat;
+
+PROCEDURE IfStat;
+  VAR t: SymTab.TypeIndex;
+    q: QbeGen.QVal;
+    lThen, lElse, lEnd: QbeGen.QVal;
+    hasElse: BOOLEAN;
+  BEGIN
+    Expect(31);
+    Expr(t, q);
+    IF ~SymTab.BoolCheck(t) THEN
+    SemError(214) END;
+    QbeGen.NewLabel(lThen);
+    QbeGen.NewLabel(lElse);
+    QbeGen.NewLabel(lEnd);
+    QbeGen.Jnz(q, lThen, lElse);
+    QbeGen.EmitLabel(lThen);
+    hasElse := FALSE;;
+    Expect(32);
+    StatSeq;
+    WHILE (sym = 33) DO
+      Get;
+      QbeGen.Jmp(lEnd);
+      QbeGen.EmitLabel(lElse);;
+      Expr(t, q);
+      IF ~SymTab.BoolCheck(t) THEN
+      SemError(214) END;
+      QbeGen.NewLabel(lThen);
+      QbeGen.NewLabel(lElse);
+      QbeGen.Jnz(q, lThen, lElse);
+      QbeGen.EmitLabel(lThen);;
+      Expect(32);
+      StatSeq;
+    END;
+    IF (sym = 34) THEN
+      Get;
+      QbeGen.Jmp(lEnd);
+      QbeGen.EmitLabel(lElse);
+      hasElse := TRUE;;
+      StatSeq;
+    END;
+    Expect(12);
+    IF ~hasElse THEN
+    QbeGen.EmitLabel(lElse)
+    END;
+    QbeGen.EmitLabel(lEnd);;
+  END IfStat;
+
+PROCEDURE Assign;
+  VAR dt, et: SymTab.TypeIndex;
+    dk: INTEGER;
+    qd, qe, qt: QbeGen.QVal;
+    qn: SymTab.Name;
+    sfx: BOOLEAN;
+    isR, conv: BOOLEAN;
+  BEGIN
+    Design(dt, dk, qd, qn, sfx);
+    Expect(30);
+    Expr(et, qe);
+    IF (dt # SymTab.InvalidType)
+    & (dk # SymTab.KindVar)
+    & (dk # SymTab.KindField)
+    & (dk # SymTab.KindImport) THEN
+    SemError(210)
+    ELSIF ~SymTab.Assignable(et, dt) THEN
+    SemError(210) END;
+    IF dk = SymTab.KindImport THEN
+    SemError(230)
+    END;
+    isR := (dt # SymTab.InvalidType)
+         & (SymTab.ClassOf(dt)
+            = SymTab.ClReal);
+    conv := isR
+          & SymTab.IsIntFamily(et);
+    IF ~sfx
+     & (dk = SymTab.KindVar) THEN
+    IF conv THEN
+      QbeGen.ConvIR(qe, qt);
+      QbeGen.StoreVar(qn, qt, TRUE)
+    ELSE
+      QbeGen.StoreVar(qn, qe, isR)
+    END
+    END;;
+  END Assign;
+
+PROCEDURE Stat;
+  VAR lx: QbeGen.QVal;
+  BEGIN
+    IF In(symSet[3], sym) THEN
+      CASE sym OF
+        1 :
+          Assign;
+      | 31 :
+          IfStat;
+      | 35 :
+          CaseStat;
+      | 37 :
+          WhileStat;
+      | 39 :
+          RepeatStat;
+      | 41 :
+          LoopStat;
+      | 42 :
+          ForStat;
+      | 44 :
+          WithStat;
+      | 29 :
+          Get;
+          IF QbeGen.TopLoop(lx) THEN
+            QbeGen.Jmp(lx)
+          ELSE SemError(230) END;;
+      END;
+    END;
+  END Stat;
+
+PROCEDURE FieldIdents (rt: SymTab.TypeIndex);
+  VAR n: SymTab.Name;
+  BEGIN
+    GetIdent(n);
+    IF ~SymTab.FieldPending(rt, n)
+    THEN SemError(200) END;
+    WHILE (sym = 10) DO
+      Get;
+      GetIdent(n);
+      IF ~SymTab.FieldPending(rt, n)
+      THEN SemError(200) END;
+    END;
+  END FieldIdents;
+
+PROCEDURE Field (rt: SymTab.TypeIndex);
+  VAR et: SymTab.TypeIndex;
+  BEGIN
+    IF (sym = 1) THEN
+      FieldIdents(rt);
+      Expect(17);
+      Type(et);
+      SymTab.FixPendingF(rt, et);;
+    END;
+  END Field;
+
+PROCEDURE FieldSeq (rt: SymTab.TypeIndex);
+  BEGIN
+    Field(rt);
+    WHILE (sym = 6) DO
+      Get;
+      Field(rt);
+    END;
+  END FieldSeq;
+
+PROCEDURE Enum (VAR t: SymTab.TypeIndex);
+  VAR n: SymTab.Name;
+    qs: QbeGen.QVal;
+    ord: INTEGER;
+  BEGIN
+    Expect(21);
+    t := SymTab.NewEnum();
+    ord := 0;;
+    GetIdent(n);
+    IF ~SymTab.Enter(n,
+      SymTab.KindConst)
+    THEN SemError(200) END;
+    SymTab.SetSymType(n, t);
+    QbeGen.IntStr(ord, qs);
+    QbeGen.DeclConst(n, qs, t);
+    INC(ord);;
+    WHILE (sym = 10) DO
+      Get;
+      GetIdent(n);
+      IF ~SymTab.Enter(n,
+        SymTab.KindConst)
+      THEN SemError(200) END;
+      SymTab.SetSymType(n, t);
+      QbeGen.IntStr(ord, qs);
+      QbeGen.DeclConst(n, qs, t);
+      INC(ord);;
+    END;
+    Expect(22);
+  END Enum;
+
+PROCEDURE PointerType (VAR t: SymTab.TypeIndex);
+  VAR b: SymTab.TypeIndex;
+  BEGIN
+    Expect(27);
+    Expect(28);
+    Type(b);
+    t := SymTab.NewPtr(b);;
+  END PointerType;
+
+PROCEDURE SetType (VAR t: SymTab.TypeIndex);
+  VAR s: SymTab.TypeIndex;
+  BEGIN
+    Expect(26);
+    Expect(24);
+    SimpleType(s);
+    IF (s # SymTab.InvalidType)
+     & (SymTab.ClassOf(s) #
+        SymTab.ClInt)
+     & (SymTab.ClassOf(s) #
+        SymTab.ClChar)
+     & (SymTab.ClassOf(s) #
+        SymTab.ClEnum) THEN
+     SemError(224) END;
+    t := SymTab.NewSet(s);;
+  END SetType;
+
+PROCEDURE RecordType (VAR t: SymTab.TypeIndex);
+  BEGIN
+    Expect(25);
+    t := SymTab.NewRecord();;
+    FieldSeq(t);
+    Expect(12);
+  END RecordType;
+
+PROCEDURE ArrayType (VAR t: SymTab.TypeIndex);
+  VAR s, s2, e: SymTab.TypeIndex;
+    qs: QbeGen.QVal;
+  BEGIN
+    Expect(23);
+    SimpleType(s);
+    IF (s # SymTab.InvalidType)
+     & (SymTab.ClassOf(s) #
+        SymTab.ClInt)
+     & (SymTab.ClassOf(s) #
+        SymTab.ClChar)
+     & (SymTab.ClassOf(s) #
+        SymTab.ClEnum) THEN
+     SemError(224) END;;
+    WHILE (sym = 10) DO
+      Get;
+      SimpleType(s2);
+      IF (s2 # SymTab.InvalidType)
+       & (SymTab.ClassOf(s2) #
+          SymTab.ClInt)
+       & (SymTab.ClassOf(s2) #
+          SymTab.ClChar)
+       & (SymTab.ClassOf(s2) #
+          SymTab.ClEnum) THEN
+       SemError(224) END;;
+    END;
+    Expect(24);
+    Type(e);
+    t := SymTab.NewArray(e);;
+  END ArrayType;
+
+PROCEDURE SimpleType (VAR t: SymTab.TypeIndex);
+  VAR t1, t2: SymTab.TypeIndex;
+    q1, q2: QbeGen.QVal;
+  BEGIN
+    IF (sym = 1) THEN
+      QualIdent(t);
+      IF (sym = 18) THEN
+        Get;
+        ConstExpr(t1, q1);
+        IF (t1 # SymTab.InvalidType)
+        & (SymTab.ClassOf(t1) #
+           SymTab.ClInt)
+        & (SymTab.ClassOf(t1) #
+           SymTab.ClChar)
+        & (SymTab.ClassOf(t1) #
+           SymTab.ClEnum) THEN
+        SemError(224) END;;
+        Expect(19);
+        ConstExpr(t2, q2);
+        IF (t2 # SymTab.InvalidType)
+        & (SymTab.ClassOf(t2) #
+           SymTab.ClInt)
+        & (SymTab.ClassOf(t2) #
+           SymTab.ClChar)
+        & (SymTab.ClassOf(t2) #
+           SymTab.ClEnum) THEN
+        SemError(224) END;;
+        Expect(20);
+        t := SymTab.NewSub(t1);;
+      END;
+    ELSIF (sym = 18) THEN
+      Get;
+      ConstExpr(t1, q1);
+      IF (t1 # SymTab.InvalidType)
+      & (SymTab.ClassOf(t1) #
+         SymTab.ClInt)
+      & (SymTab.ClassOf(t1) #
+         SymTab.ClChar)
+      & (SymTab.ClassOf(t1) #
+         SymTab.ClEnum) THEN
+      SemError(224) END;;
+      Expect(19);
+      ConstExpr(t2, q2);
+      IF (t2 # SymTab.InvalidType)
+      & (SymTab.ClassOf(t2) #
+         SymTab.ClInt)
+      & (SymTab.ClassOf(t2) #
+         SymTab.ClChar)
+      & (SymTab.ClassOf(t2) #
+         SymTab.ClEnum) THEN
+      SemError(224) END;;
+      Expect(20);
+      t := SymTab.NewSub(t1);;
+    ELSIF (sym = 21) THEN
+      Enum(t);
+    ELSE SynError(71);
+    END;
+  END SimpleType;
+
+PROCEDURE QualIdent (VAR t: SymTab.TypeIndex);
+  VAR n, m: SymTab.Name;
+  BEGIN
+    GetIdent(n);
+    IF ~SymTab.Lookup(n) THEN
+      SemError(201);
+      t := SymTab.InvalidType
+    ELSIF (SymTab.SymKind(n) #
+           SymTab.KindType)
+      & (SymTab.SymKind(n) #
+         SymTab.KindPredef)
+      & (SymTab.SymKind(n) #
+         SymTab.KindImport) THEN
+      SemError(221);
+      t := SymTab.InvalidType
+    ELSE t := SymTab.SymType(n) END;;
+    WHILE (sym = 7) DO
+      Get;
+      GetIdent(m);
+      t := SymTab.InvalidType;;
+    END;
+  END QualIdent;
+
+PROCEDURE VarIdents;
+  VAR n: SymTab.Name;
+  BEGIN
+    GetIdent(n);
+    IF ~SymTab.EnterPending(n,
+      SymTab.KindVar)
+    THEN SemError(200) END;
+    WHILE (sym = 10) DO
+      Get;
+      GetIdent(n);
+      IF ~SymTab.EnterPending(n,
+        SymTab.KindVar)
+      THEN SemError(200) END;
+    END;
+  END VarIdents;
+
+PROCEDURE Type (VAR t: SymTab.TypeIndex);
+  BEGIN
+    IF (sym = 1) OR (sym = 18) OR (sym = 21) THEN
+      SimpleType(t);
+    ELSIF (sym = 23) THEN
+      ArrayType(t);
+    ELSIF (sym = 25) THEN
+      RecordType(t);
+    ELSIF (sym = 26) THEN
+      SetType(t);
+    ELSIF (sym = 27) THEN
+      PointerType(t);
+    ELSE SynError(72);
+    END;
+  END Type;
+
+PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+  VAR t2: SymTab.TypeIndex;
+    tc, op: INTEGER;
+    q2, qk: QbeGen.QVal;
+    r: BOOLEAN;
+  BEGIN
+    SimExpr(t, q);
+    IF In(symSet[4], sym) THEN
+      Rel(op);
+      SimExpr(t2, q2);
+      IF op = SymTab.OpIn THEN
+        IF SymTab.InCheck(t, t2) THEN
+          t := SymTab.BoolType();
+          SemError(230)
+        ELSE SemError(222);
+          t := SymTab.InvalidType
+        END;
+        QbeGen.CopyOp("0", q)
+      ELSE
+        tc := SymTab.ClassOf(t);
+        IF SymTab.RelCheck(t, t2, op) THEN
+          t := SymTab.BoolType()
+        ELSE SemError(213); t := SymTab.InvalidType END;
+        IF t # SymTab.InvalidType THEN
+          r := tc = SymTab.ClReal;
+          QbeGen.Cmp(op, q, q2, qk, r);
+          QbeGen.CopyOp(qk, q)
+        ELSE QbeGen.CopyOp("0", q)
+        END
+      END;;
+    END;
+  END Expr;
+
+PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
+  BEGIN
+    Expr(t, q);
+  END ConstExpr;
+
+PROCEDURE VarDecl;
+  VAR t: SymTab.TypeIndex;
+    i: CARDINAL;
+    nm: SymTab.Name;
+    cls: INTEGER;
+  BEGIN
+    VarIdents;
+    Expect(17);
+    Type(t);
+    cls := SymTab.ClassOf(t);
+    IF (cls # SymTab.ClInt)
+       & (cls # SymTab.ClReal)
+       & (cls # SymTab.ClBool)
+       & (cls # SymTab.ClChar)
+       & (cls # SymTab.ClEnum) THEN
+      SemError(230)
+    END;
+    i := 0;
+    WHILE i < SymTab.PendCount() DO
+      SymTab.PendName(i, nm);
+      QbeGen.DeclVar(nm, t);
+      INC(i)
+    END;
+    SymTab.FixPending(t);;
+  END VarDecl;
+
+PROCEDURE TypeDecl;
+  VAR n: SymTab.Name;
+    t0, t1: SymTab.TypeIndex;
+  BEGIN
+    GetIdent(n);
+    IF ~SymTab.Enter(n, SymTab.KindType)
+    THEN SemError(200) END;
+    t0 := SymTab.NewAlias();
+    SymTab.SetSymType(n, t0);;
+    Expect(16);
+    Type(t1);
+    IF t1 = t0 THEN SemError(223);
+      SymTab.SetTarget(t0,
+        SymTab.InvalidType)
+    ELSE SymTab.SetTarget(t0, t1) END;;
+  END TypeDecl;
+
+PROCEDURE ConstDecl;
+  VAR n: SymTab.Name;
+    t: SymTab.TypeIndex;
+    qv: QbeGen.QVal;
+    cls: INTEGER;
+  BEGIN
+    GetIdent(n);
+    IF ~SymTab.Enter(n, SymTab.KindConst)
+    THEN SemError(200) END;
+    Expect(16);
+    ConstExpr(t, qv);
+    SymTab.SetSymType(n, t);
+    cls := SymTab.ClassOf(t);
+    IF cls = SymTab.ClStr THEN
+      SemError(230)
+    ELSIF ~QbeGen.IsImm(qv) THEN
+      SemError(230)
+    END;
+    QbeGen.DeclConst(n, qv, t);;
+  END ConstDecl;
+
+PROCEDURE StatSeq;
+  BEGIN
+    Stat;
+    WHILE (sym = 6) DO
+      Get;
+      Stat;
+    END;
+  END StatSeq;
+
+PROCEDURE Declaration;
+  BEGIN
+    IF (sym = 13) THEN
+      Get;
+      WHILE (sym = 1) DO
+        ConstDecl;
+        Expect(6);
+      END;
+    ELSIF (sym = 14) THEN
+      Get;
+      WHILE (sym = 1) DO
+        TypeDecl;
+        Expect(6);
+      END;
+    ELSIF (sym = 15) THEN
+      Get;
+      WHILE (sym = 1) DO
+        VarDecl;
+        Expect(6);
+      END;
+    ELSE SynError(73);
+    END;
+  END Declaration;
+
+PROCEDURE ImportList;
+  VAR n: SymTab.Name;
+  BEGIN
+    GetIdent(n);
+    IF ~SymTab.Enter(n, SymTab.KindImport)
+    THEN SemError(200) END;
+    WHILE (sym = 10) DO
+      Get;
+      GetIdent(n);
+      IF ~SymTab.Enter(n, SymTab.KindImport)
+      THEN SemError(200) END;
+    END;
+  END ImportList;
+
+PROCEDURE Block;
+  BEGIN
+    WHILE (sym = 13) OR (sym = 14) OR (sym = 15) DO
+      Declaration;
+    END;
+    IF (sym = 11) THEN
+      Get;
+      QbeGen.BeginBody;;
+      StatSeq;
+    END;
+    Expect(12);
+  END Block;
+
+PROCEDURE Import;
+  VAR n: SymTab.Name;
+  BEGIN
+    IF (sym = 8) THEN
+      Get;
+      GetIdent(n);
+      IF ~SymTab.Enter(n, SymTab.KindImport)
+      THEN SemError(200) END;
+      Expect(9);
+      ImportList;
+      Expect(6);
+    ELSIF (sym = 9) THEN
+      Get;
+      ImportList;
+      Expect(6);
+    ELSE SynError(74);
+    END;
+  END Import;
+
+PROCEDURE GetIdent (VAR n: SymTab.Name);
+  BEGIN
+    Expect(1);
+    LexName(n);;
+  END GetIdent;
+
+PROCEDURE SimpleQ;
+  VAR m1, m2: SymTab.Name;
+  BEGIN
+    Expect(5);
+    GetIdent(m1);
+    SymTab.Init; QbeGen.OpenModule(m1);
+    IF ~SymTab.Enter(m1, SymTab.KindModule)
+    THEN SemError(200) END;
+    Expect(6);
+    WHILE (sym = 8) OR (sym = 9) DO
+      Import;
+    END;
+    Block;
+    GetIdent(m2);
+    IF ~SymTab.Equal(m1, m2)
+    THEN SemError(202) END;
+    Expect(7);
+    QbeGen.EndModule;
+    SymTab.PrintTable;;
+  END SimpleQ;
+
+
+
+PROCEDURE Parse;
+  BEGIN
+    SimpleQS.Reset; Get;
+    SimpleQ;
+
+  END Parse;
+
+BEGIN
+  errDist := minErrDist;
+  symSet[ 0, 0] := BITSET{0};
+  symSet[ 0, 1] := BITSET{};
+  symSet[ 0, 2] := BITSET{};
+  symSet[ 0, 3] := BITSET{};
+  symSet[ 0, 4] := BITSET{};
+  symSet[ 1, 0] := BITSET{1, 2, 3, 4};
+  symSet[ 1, 1] := BITSET{5};
+  symSet[ 1, 2] := BITSET{};
+  symSet[ 1, 3] := BITSET{5, 6, 14, 15};
+  symSet[ 1, 4] := BITSET{0};
+  symSet[ 2, 0] := BITSET{};
+  symSet[ 2, 1] := BITSET{};
+  symSet[ 2, 2] := BITSET{};
+  symSet[ 2, 3] := BITSET{8, 9, 10, 11, 12, 13};
+  symSet[ 2, 4] := BITSET{};
+  symSet[ 3, 0] := BITSET{1};
+  symSet[ 3, 1] := BITSET{13, 15};
+  symSet[ 3, 2] := BITSET{3, 5, 7, 9, 10, 12};
+  symSet[ 3, 3] := BITSET{};
+  symSet[ 3, 4] := BITSET{};
+  symSet[ 4, 0] := BITSET{};
+  symSet[ 4, 1] := BITSET{0};
+  symSet[ 4, 2] := BITSET{14, 15};
+  symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4};
+  symSet[ 4, 4] := BITSET{};
+END SimpleQP.
+

Test2/SimpleQS.def

@@ -0,0 +1,39 @@
+DEFINITION MODULE SimpleQS;
+
+(* 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 SimpleQS.

Test2/SimpleQS.mod

@@ -0,0 +1,393 @@
+IMPLEMENTATION MODULE SimpleQS;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO, Storage;
+
+CONST
+  noSYMB  = 66; (*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
+        "A": IF Equal("AND") THEN sym := 60; 
+             ELSIF Equal("ARRAY") THEN sym := 23; 
+             END
+      | "B": IF Equal("BEGIN") THEN sym := 11; 
+             ELSIF Equal("BY") THEN sym := 43; 
+             END
+      | "C": IF Equal("CASE") THEN sym := 35; 
+             ELSIF Equal("CONST") THEN sym := 13; 
+             END
+      | "D": IF Equal("DIV") THEN sym := 58; 
+             ELSIF Equal("DO") THEN sym := 38; 
+             END
+      | "E": IF Equal("ELSE") THEN sym := 34; 
+             ELSIF Equal("ELSIF") THEN sym := 33; 
+             ELSIF Equal("END") THEN sym := 12; 
+             ELSIF Equal("EXIT") THEN sym := 29; 
+             END
+      | "F": IF Equal("FOR") THEN sym := 42; 
+             ELSIF Equal("FROM") THEN sym := 8; 
+             END
+      | "I": IF Equal("IF") THEN sym := 31; 
+             ELSIF Equal("IMPORT") THEN sym := 9; 
+             ELSIF Equal("IN") THEN sym := 52; 
+             END
+      | "L": IF Equal("LOOP") THEN sym := 41; 
+             END
+      | "M": IF Equal("MOD") THEN sym := 59; 
+             ELSIF Equal("MODULE") THEN sym := 5; 
+             END
+      | "N": IF Equal("NOT") THEN sym := 62; 
+             END
+      | "O": IF Equal("OF") THEN sym := 24; 
+             ELSIF Equal("OR") THEN sym := 55; 
+             END
+      | "P": IF Equal("POINTER") THEN sym := 27; 
+             END
+      | "R": IF Equal("RECORD") THEN sym := 25; 
+             ELSIF Equal("REPEAT") THEN sym := 39; 
+             END
+      | "S": IF Equal("SET") THEN sym := 26; 
+             END
+      | "T": IF Equal("THEN") THEN sym := 32; 
+             ELSIF Equal("TO") THEN sym := 28; 
+             ELSIF Equal("TYPE") THEN sym := 14; 
+             END
+      | "U": IF Equal("UNTIL") THEN sym := 40; 
+             END
+      | "V": IF Equal("VAR") THEN sym := 15; 
+             END
+      | "W": IF Equal("WHILE") THEN sym := 37; 
+             ELSIF Equal("WITH") THEN sym := 44; 
+             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: IF ((ch >= "0") & (ch <= "9") OR
+               (ch >= "A") & (ch <= "F")) THEN 
+            ELSIF (ch = "H") THEN state := 4; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  3: bp := bp - apx - Long1; DEC(nextLen, ORDL(apx)); NextCh; sym := 2; RETURN
+      |  4: sym := 2; RETURN
+      |  5: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSIF (ch = "E") THEN state := 6; 
+            ELSE sym := 3; RETURN
+            END;
+      |  6: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; 
+            ELSIF ((ch = "+") OR
+                  (ch = "-")) THEN state := 7; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  7: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  8: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSE sym := 3; RETURN
+            END;
+      |  9: IF ((ch <= CHR(12)) OR
+               (ch >= CHR(14)) & (ch <= "&") OR
+               (ch >= "(")) THEN 
+            ELSIF (ch = "'") THEN state := 11; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      | 10: IF ((ch <= CHR(12)) OR
+               (ch >= CHR(14)) & (ch <= "!") OR
+               (ch >= "#")) THEN 
+            ELSIF (ch = '"') THEN state := 11; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      | 11: sym := 4; RETURN
+      | 12: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSIF ((ch >= "A") & (ch <= "F")) THEN state := 2; 
+            ELSIF (ch = ".") THEN state := 13; INC(apx) 
+            ELSIF (ch = "H") THEN state := 4; 
+            ELSE sym := 2; RETURN
+            END;
+      | 13: IF ((ch >= "0") & (ch <= "9")) THEN state := 5; apx := Long0 
+            ELSIF (ch = ".") THEN state := 3; INC(apx) 
+            ELSIF (ch = "E") THEN state := 6; apx := Long0 
+            ELSE sym := 3; RETURN
+            END;
+      | 14: sym := 6; RETURN
+      | 15: IF (ch = ".") THEN state := 20; 
+            ELSE sym := 7; RETURN
+            END;
+      | 16: sym := 10; RETURN
+      | 17: sym := 16; RETURN
+      | 18: IF (ch = "=") THEN state := 24; 
+            ELSE sym := 17; RETURN
+            END;
+      | 19: sym := 18; RETURN
+      | 20: sym := 19; RETURN
+      | 21: sym := 20; RETURN
+      | 22: sym := 21; RETURN
+      | 23: sym := 22; RETURN
+      | 24: sym := 30; RETURN
+      | 25: sym := 36; RETURN
+      | 26: sym := 45; RETURN
+      | 27: sym := 46; RETURN
+      | 28: IF (ch = ">") THEN state := 29; 
+            ELSIF (ch = "=") THEN state := 30; 
+            ELSE sym := 48; RETURN
+            END;
+      | 29: sym := 47; RETURN
+      | 30: sym := 49; RETURN
+      | 31: IF (ch = "=") THEN state := 32; 
+            ELSE sym := 50; RETURN
+            END;
+      | 32: sym := 51; RETURN
+      | 33: sym := 53; RETURN
+      | 34: sym := 54; RETURN
+      | 35: sym := 56; RETURN
+      | 36: sym := 57; RETURN
+      | 37: sym := 61; RETURN
+      | 38: sym := 63; RETURN
+      | 39: sym := 64; RETURN
+      | 40: sym := 65; RETURN
+      | 41: 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] := 41; start[  1] := 42; start[  2] := 42; start[  3] := 42; 
+  start[  4] := 42; start[  5] := 42; start[  6] := 42; start[  7] := 42; 
+  start[  8] := 42; start[  9] := 42; start[ 10] := 42; start[ 11] := 42; 
+  start[ 12] := 42; start[ 13] := 42; start[ 14] := 42; start[ 15] := 42; 
+  start[ 16] := 42; start[ 17] := 42; start[ 18] := 42; start[ 19] := 42; 
+  start[ 20] := 42; start[ 21] := 42; start[ 22] := 42; start[ 23] := 42; 
+  start[ 24] := 42; start[ 25] := 42; start[ 26] := 42; start[ 27] := 42; 
+  start[ 28] := 42; start[ 29] := 42; start[ 30] := 42; start[ 31] := 42; 
+  start[ 32] := 42; start[ 33] := 42; start[ 34] := 10; start[ 35] := 27; 
+  start[ 36] := 42; start[ 37] := 42; start[ 38] := 37; start[ 39] :=  9; 
+  start[ 40] := 22; start[ 41] := 23; start[ 42] := 35; start[ 43] := 33; 
+  start[ 44] := 16; start[ 45] := 34; start[ 46] := 15; start[ 47] := 36; 
+  start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 
+  start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; 
+  start[ 56] := 12; start[ 57] := 12; start[ 58] := 18; start[ 59] := 14; 
+  start[ 60] := 28; start[ 61] := 17; start[ 62] := 31; start[ 63] := 42; 
+  start[ 64] := 42; 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] := 19; 
+  start[ 92] := 42; start[ 93] := 21; start[ 94] := 26; start[ 95] := 42; 
+  start[ 96] := 42; 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] := 39; 
+  start[124] := 25; start[125] := 40; start[126] := 38; start[127] := 42; 
+  start[128] := 42; start[129] := 42; start[130] := 42; start[131] := 42; 
+  start[132] := 42; start[133] := 42; start[134] := 42; start[135] := 42; 
+  start[136] := 42; start[137] := 42; start[138] := 42; start[139] := 42; 
+  start[140] := 42; start[141] := 42; start[142] := 42; start[143] := 42; 
+  start[144] := 42; start[145] := 42; start[146] := 42; start[147] := 42; 
+  start[148] := 42; start[149] := 42; start[150] := 42; start[151] := 42; 
+  start[152] := 42; start[153] := 42; start[154] := 42; start[155] := 42; 
+  start[156] := 42; start[157] := 42; start[158] := 42; start[159] := 42; 
+  start[160] := 42; start[161] := 42; start[162] := 42; start[163] := 42; 
+  start[164] := 42; start[165] := 42; start[166] := 42; start[167] := 42; 
+  start[168] := 42; start[169] := 42; start[170] := 42; start[171] := 42; 
+  start[172] := 42; start[173] := 42; start[174] := 42; start[175] := 42; 
+  start[176] := 42; start[177] := 42; start[178] := 42; start[179] := 42; 
+  start[180] := 42; start[181] := 42; start[182] := 42; start[183] := 42; 
+  start[184] := 42; start[185] := 42; start[186] := 42; start[187] := 42; 
+  start[188] := 42; start[189] := 42; start[190] := 42; start[191] := 42; 
+  start[192] := 42; start[193] := 42; start[194] := 42; start[195] := 42; 
+  start[196] := 42; start[197] := 42; start[198] := 42; start[199] := 42; 
+  start[200] := 42; start[201] := 42; start[202] := 42; start[203] := 42; 
+  start[204] := 42; start[205] := 42; start[206] := 42; start[207] := 42; 
+  start[208] := 42; start[209] := 42; start[210] := 42; start[211] := 42; 
+  start[212] := 42; start[213] := 42; start[214] := 42; start[215] := 42; 
+  start[216] := 42; start[217] := 42; start[218] := 42; start[219] := 42; 
+  start[220] := 42; start[221] := 42; start[222] := 42; start[223] := 42; 
+  start[224] := 42; start[225] := 42; start[226] := 42; start[227] := 42; 
+  start[228] := 42; start[229] := 42; start[230] := 42; start[231] := 42; 
+  start[232] := 42; start[233] := 42; start[234] := 42; start[235] := 42; 
+  start[236] := 42; start[237] := 42; start[238] := 42; start[239] := 42; 
+  start[240] := 42; start[241] := 42; start[242] := 42; start[243] := 42; 
+  start[244] := 42; start[245] := 42; start[246] := 42; start[247] := 42; 
+  start[248] := 42; start[249] := 42; start[250] := 42; start[251] := 42; 
+  start[252] := 42; start[253] := 42; start[254] := 42; start[255] := 42; 
+  Error := Err; lastCh := EOF;
+END SimpleQS.

Test2/SymTab.def

@@ -0,0 +1,178 @@
+DEFINITION MODULE SymTab;
+(* Symbol table with static type checking for SimpleMod2
+   (simplified Modula-2 without procedures).
+
+   - flat scopes with levels: globals at level 0, WITH statement
+     bodies push the record's fields as an inner scope (shadowing
+     allowed, duplicates within one level rejected)
+   - every symbol carries a type descriptor index (InvalidType if
+     unknown, e.g. imported names); unknown types suppress follow-on
+     errors to avoid cascades
+   - type descriptors: aliases (one per TYPE declaration, so
+     self-references such as POINTER TO Person resolve), subranges,
+     enumerations, arrays, records (with field lists), sets,
+     pointers, predefined types, string literals
+   - INTEGER, CARDINAL and subranges thereof form one lenient
+     "integer family"; mixed INTEGER/REAL arithmetic is rejected *)
+
+CONST
+  MaxSyms = 256;
+  InvalidType = -1;
+
+  (* symbol kinds *)
+  KindConst  = 0;
+  KindType   = 1;
+  KindVar    = 2;
+  KindImport = 3;
+  KindModule = 4;
+  KindPredef = 5;
+  KindField  = 6;
+
+  (* type classes returned by ClassOf *)
+  ClInvalid = 0;
+  ClInt     = 1;
+  ClReal    = 2;
+  ClChar    = 3;
+  ClBool    = 4;
+  ClEnum    = 5;
+  ClArray   = 6;
+  ClRecord  = 7;
+  ClSet     = 8;
+  ClPtr     = 9;
+  ClStr     = 10;
+
+  (* operator codes for RelCheck *)
+  OpEq = 0; OpNeq1 = 1; OpNeq2 = 2;
+  OpLt = 3; OpLe  = 4; OpGt   = 5; OpGe = 6;
+  OpIn = 7;
+  (* operator codes for AddOp / MulOp *)
+  OpAdd = 0; OpSub = 1; OpOr = 2;
+  OpTimes = 0; OpSlash = 1; OpDiv = 2; OpMod = 3; OpAnd = 4;
+
+TYPE
+  Name = ARRAY [0 .. 63] OF CHAR;
+  TypeIndex = INTEGER;
+
+(* ---------------- symbols and scopes ---------------- *)
+
+PROCEDURE Init;
+(* Clears the table and enters predefined identifiers
+   (INTEGER, CARDINAL, SHORTINT, LONGINT, REAL, LONGREAL, CHAR,
+   BOOLEAN, TRUE, FALSE, NIL). *)
+
+PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+(* Enters name at the current scope level (type InvalidType).
+   Returns FALSE on duplicate within the same level. *)
+
+PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+(* Like Enter, but remembers the entry for a later FixPending call
+   (used for VAR identifier lists whose type is parsed afterwards).
+   Returns FALSE on duplicate (entry not recorded). *)
+
+PROCEDURE FixPending (t: TypeIndex);
+(* Assigns type t to all pending entries, clears the buffer. *)
+
+PROCEDURE PendCount (): CARDINAL;
+(* Number of entries currently waiting for FixPending. *)
+
+PROCEDURE PendName (i: CARDINAL; VAR n: Name);
+(* Name of the i-th pending entry (empty string if out of range).
+   Used by the QBE backend to emit storage for VAR lists whose
+   type is parsed after the identifiers. *)
+
+PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+(* Records a field name for record descriptor rec (type fixed later
+   with FixPendingF). Returns FALSE on duplicate field. *)
+
+PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
+(* Assigns type t to pending fields owned by rec. *)
+
+PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
+(* TRUE if name is visible (innermost scope wins). *)
+
+PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
+(* Type of innermost visible entry, InvalidType if absent. *)
+
+PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
+(* Sets type of innermost visible entry. *)
+
+PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
+(* Kind of innermost visible entry, -1 if absent. *)
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
+
+PROCEDURE PushScope;
+PROCEDURE PopScope;
+(* WITH statement support: PushRecord pushes a record's fields. *)
+
+PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
+(* Pushes a scope containing t's fields (as KindField). FALSE if t
+   is not a record type (or invalid). Caller must PopScope after. *)
+
+PROCEDURE PrintTable;
+
+(* ---------------- type descriptors ---------------- *)
+
+PROCEDURE NewAlias (): TypeIndex;
+PROCEDURE NewSub (base: TypeIndex): TypeIndex;
+PROCEDURE NewEnum (): TypeIndex;
+PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
+PROCEDURE NewRecord (): TypeIndex;
+PROCEDURE NewSet (base: TypeIndex): TypeIndex;
+PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
+PROCEDURE NewStr (): TypeIndex;
+(* Fresh descriptors; base/elem may be InvalidType. InvalidType is
+   returned when the table is full. *)
+
+PROCEDURE SetTarget (t, base: TypeIndex);
+(* Sets an alias target (TYPE declaration completion). *)
+
+PROCEDURE IntType (): TypeIndex;
+PROCEDURE RealType (): TypeIndex;
+PROCEDURE CharType (): TypeIndex;
+PROCEDURE BoolType (): TypeIndex;
+
+PROCEDURE ClassOf (t: TypeIndex): INTEGER;
+(* Resolves aliases; InvalidType maps to ClInvalid. *)
+
+PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
+(* INTEGER, CARDINAL or subrange thereof (Invalid suppresses). *)
+
+PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
+(* Same resolved descriptor (Invalid suppresses). *)
+
+PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
+PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
+PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
+
+(* ---------------- predicates used by grammar checks ---------------- *)
+(* All return TRUE if either operand is InvalidType (no cascades). *)
+
+PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
+(* Assignment compatibility (210). *)
+
+PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
+                      VAR res: TypeIndex): BOOLEAN;
+(* + - * / (divmod FALSE) or DIV MOD (TRUE); res is result type (211). *)
+
+PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
+(* Unary + - (part of 211). *)
+
+PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+(* BOOLEAN required: NOT/AND/OR operands (212), conditions (214). *)
+
+PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
+(* = # <> < <= > >= IN (213/222 chosen by caller via op). *)
+
+PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
+(* = # compatibility, also reused for CASE label matching. *)
+
+PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
+PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
+PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
+(* Fresh SET OF elem descriptor for set literals. *)
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+
+END SymTab.

Test2/SymTab.mod

@@ -0,0 +1,618 @@
+IMPLEMENTATION MODULE SymTab;
+
+IMPORT FileIO;
+
+CONST
+  MaxTypes  = 256;
+  MaxFields = 512;
+  MaxPend   = 64;
+  MaxMarks  = 16;
+  ResDepth  = 64;
+
+  (* descriptor forms *)
+  FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
+  FRecord = 5; FSet = 6; FPtr = 7; FStr = 8;
+  FInt = 9; FReal = 10; FChar = 11; FBool = 12;
+
+TYPE
+  Symbol = RECORD
+    name : Name;
+    kind : INTEGER;
+    typ  : TypeIndex;
+    lev  : CARDINAL;
+  END;
+  Field = RECORD
+    name  : Name;
+    typ   : TypeIndex;
+    owner : TypeIndex;
+    next  : INTEGER;  (* index of next field of same owner, -1 = end *)
+  END;
+
+VAR
+  syms : ARRAY [0 .. MaxSyms - 1] OF Symbol;
+  nSyms : CARDINAL;
+  curLev : CARDINAL;
+  marks : ARRAY [0 .. MaxMarks - 1] OF CARDINAL;
+  mtop : CARDINAL;
+  pend : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  nPend : CARDINAL;
+  pendF : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  nPendF : CARDINAL;
+  tform : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
+  tref : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;
+  nTypes : CARDINAL;
+  fields : ARRAY [0 .. MaxFields - 1] OF Field;
+  nFields : CARDINAL;
+  dInt, dCard, dReal, dChar, dBool : TypeIndex;
+
+(* ---------------- strings ---------------- *)
+
+PROCEDURE Assign (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(dest)) & (src[i] # 0C) DO
+      dest[i] := src[i]; INC(i)
+    END;
+    dest[i] := 0C
+  END Assign;
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    LOOP
+      IF a[i] # b[i] THEN RETURN FALSE END;
+      IF a[i] = 0C THEN RETURN TRUE END;
+      INC(i)
+    END
+  END Equal;
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
+    RETURN i
+  END StrLen;
+
+(* ---------------- symbols and scopes ---------------- *)
+
+PROCEDURE Find (name: ARRAY OF CHAR): INTEGER;
+(* innermost visible index or -1 *)
+  VAR i : CARDINAL;
+  BEGIN
+    i := nSyms;
+    WHILE i > 0 DO
+      DEC(i);
+      IF Equal(syms[i].name, name) THEN RETURN VAL(INTEGER, i) END
+    END;
+    RETURN -1
+  END Find;
+
+PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): INTEGER;
+(* index or -1 when full *)
+  BEGIN
+    IF nSyms >= MaxSyms THEN RETURN -1 END;
+    Assign(syms[nSyms].name, name);
+    syms[nSyms].kind := kind;
+    syms[nSyms].typ := InvalidType;
+    syms[nSyms].lev := curLev;
+    INC(nSyms);
+    RETURN VAL(INTEGER, nSyms - 1)
+  END RawEnter;
+
+PROCEDURE DupInLevel (name: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    i := nSyms;
+    WHILE (i > 0) & (syms[i - 1].lev = curLev) DO
+      DEC(i);
+      IF Equal(syms[i].name, name) THEN RETURN TRUE END
+    END;
+    RETURN FALSE
+  END DupInLevel;
+
+PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    RETURN RawEnter(name, kind) # -1
+  END Enter;
+
+PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+  VAR idx : INTEGER;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    idx := RawEnter(name, kind);
+    IF (idx # -1) & (nPend < MaxPend) THEN
+      pend[nPend] := VAL(CARDINAL, idx); INC(nPend)
+    END;
+    RETURN idx # -1
+  END EnterPending;
+
+PROCEDURE FixPending (t: TypeIndex);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nPend DO
+      syms[pend[i]].typ := t; INC(i)
+    END;
+    nPend := 0
+  END FixPending;
+
+PROCEDURE PendCount (): CARDINAL;
+  BEGIN
+    RETURN nPend
+  END PendCount;
+
+PROCEDURE PendName (i: CARDINAL; VAR n: Name);
+  BEGIN
+    IF i < nPend THEN Assign(n, syms[pend[i]].name)
+    ELSE n[0] := 0C
+    END
+  END PendName;
+
+PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
+  VAR i : INTEGER;
+  BEGIN
+    IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN -1 END;
+    IF tform[rec] # FRecord THEN RETURN -1 END;
+    i := tref[rec];
+    WHILE i # -1 DO
+      IF Equal(fields[i].name, name) THEN RETURN i END;
+      i := fields[i].next
+    END;
+    RETURN -1
+  END FindField;
+
+PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    IF FindField(rec, name) # -1 THEN RETURN FALSE END;
+    IF nFields >= MaxFields THEN RETURN FALSE END;
+    Assign(fields[nFields].name, name);
+    fields[nFields].typ := InvalidType;
+    fields[nFields].owner := rec;
+    fields[nFields].next := tref[rec];
+    tref[rec] := VAL(INTEGER, nFields);
+    IF nPendF < MaxPend THEN
+      pendF[nPendF] := nFields; INC(nPendF)
+    END;
+    INC(nFields);
+    RETURN TRUE
+  END FieldPending;
+
+PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
+  VAR i, j : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nPendF DO
+      IF fields[pendF[i]].owner = rec THEN
+        fields[pendF[i]].typ := t;
+        (* remove by swap with last *)
+        j := nPendF - 1;
+        pendF[i] := pendF[j];
+        DEC(nPendF)
+      ELSE
+        INC(i)
+      END
+    END
+  END FixPendingF;
+
+PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN Find(name) # -1
+  END Lookup;
+
+PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN InvalidType END;
+    RETURN syms[idx].typ
+  END SymType;
+
+PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx # -1 THEN syms[idx].typ := t END
+  END SetSymType;
+
+PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN -1 END;
+    RETURN syms[idx].kind
+  END SymKind;
+
+PROCEDURE PushScope;
+  BEGIN
+    IF mtop < MaxMarks THEN marks[mtop] := nSyms; INC(mtop) END;
+    INC(curLev)
+  END PushScope;
+
+PROCEDURE PopScope;
+  BEGIN
+    IF mtop > 0 THEN DEC(mtop); nSyms := marks[mtop] END;
+    IF curLev > 0 THEN DEC(curLev) END
+  END PopScope;
+
+(* ---------------- type descriptors ---------------- *)
+
+PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
+  BEGIN
+    IF nTypes >= MaxTypes THEN RETURN InvalidType END;
+    tform[nTypes] := form;
+    tref[nTypes] := ref;
+    INC(nTypes);
+    RETURN VAL(INTEGER, nTypes - 1)
+  END NewDesc;
+
+PROCEDURE NewAlias (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FAlias, InvalidType)
+  END NewAlias;
+
+PROCEDURE NewSub (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FSub, base)
+  END NewSub;
+
+PROCEDURE NewEnum (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FEnum, InvalidType)
+  END NewEnum;
+
+PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FArray, elem)
+  END NewArray;
+
+PROCEDURE NewRecord (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FRecord, -1)
+  END NewRecord;
+
+PROCEDURE NewSet (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FSet, base)
+  END NewSet;
+
+PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FPtr, base)
+  END NewPtr;
+
+PROCEDURE NewStr (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FStr, InvalidType)
+  END NewStr;
+
+PROCEDURE SetTarget (t, base: TypeIndex);
+  BEGIN
+    IF (t >= 0) & (t < VAL(INTEGER, nTypes)) & (tform[t] = FAlias) THEN
+      tref[t] := base
+    END
+  END SetTarget;
+
+PROCEDURE Resolve (t: TypeIndex): TypeIndex;
+  VAR n : CARDINAL;
+  BEGIN
+    n := 0;
+    WHILE (n < ResDepth) & (t >= 0) & (t < VAL(INTEGER, nTypes))
+          & (tform[t] = FAlias) DO
+      t := tref[t]; INC(n)
+    END;
+    IF (t < 0) OR (t >= VAL(INTEGER, nTypes)) THEN
+      RETURN InvalidType
+    END;
+    RETURN t
+  END Resolve;
+
+PROCEDURE IntType (): TypeIndex;
+  BEGIN RETURN dInt END IntType;
+PROCEDURE RealType (): TypeIndex;
+  BEGIN RETURN dReal END RealType;
+PROCEDURE CharType (): TypeIndex;
+  BEGIN RETURN dChar END CharType;
+PROCEDURE BoolType (): TypeIndex;
+  BEGIN RETURN dBool END BoolType;
+
+PROCEDURE ClassOf (t: TypeIndex): INTEGER;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF r = InvalidType THEN RETURN ClInvalid END;
+    CASE tform[r] OF
+      FInt : RETURN ClInt
+    | FReal : RETURN ClReal
+    | FChar : RETURN ClChar
+    | FBool : RETURN ClBool
+    | FEnum : RETURN ClEnum
+    | FArray : RETURN ClArray
+    | FRecord : RETURN ClRecord
+    | FSet : RETURN ClSet
+    | FPtr : RETURN ClPtr
+    | FStr : RETURN ClStr
+    | FSub : RETURN ClassOf(tref[r])
+    ELSE RETURN ClInvalid
+    END
+  END ClassOf;
+
+PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
+  BEGIN
+    RETURN ClassOf(t) = ClInt
+  END IsIntFamily;
+
+PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (a = InvalidType) OR (b = InvalidType) THEN RETURN TRUE END;
+    RETURN Resolve(a) = Resolve(b)
+  END SameType;
+
+PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN FindField(Resolve(rec), name) # -1
+  END FieldExists;
+
+PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
+  VAR i : INTEGER;
+  BEGIN
+    i := FindField(Resolve(rec), name);
+    IF i = -1 THEN RETURN InvalidType END;
+    RETURN fields[i].typ
+  END FieldType;
+
+PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FArray) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END ArrayElem;
+
+PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FPtr) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END PtrBase;
+
+PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
+(* Pushes a scope with t's fields; caller must PopScope afterwards. *)
+  VAR r, i : INTEGER;
+  BEGIN
+    r := Resolve(t);
+    IF (r < 0) OR (tform[r] # FRecord) THEN RETURN FALSE END;
+    PushScope;
+    i := tref[r];
+    WHILE i # -1 DO
+      IF Enter(fields[i].name, KindField) THEN
+        SetSymType(fields[i].name, fields[i].typ)
+      END;
+      i := fields[i].next
+    END;
+    RETURN TRUE
+  END PushRecord;
+
+(* ---------------- predicates ---------------- *)
+
+PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
+(* base compatibility for two SET types *)
+  BEGIN
+    IF SameType(a, b) THEN RETURN TRUE END;
+    IF IsIntFamily(a) & IsIntFamily(b) THEN RETURN TRUE END;
+    IF (ClassOf(a) = ClChar) & (ClassOf(b) = ClChar) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END SetBasesOk;
+
+PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
+  VAR rs, rd : TypeIndex;
+  BEGIN
+    IF (src = InvalidType) OR (dst = InvalidType) THEN RETURN TRUE END;
+    rs := Resolve(src); rd := Resolve(dst);
+    IF rs = rd THEN RETURN TRUE END;
+    IF (rs = InvalidType) OR (rd = InvalidType) THEN RETURN TRUE END;
+    IF (tform[rs] = FSet) & (tform[rd] = FSet) THEN
+      RETURN SetBasesOk(tref[rs], tref[rd])
+    END;
+    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClInt) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClStr) & (ClassOf(dst) = ClArray) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END Assignable;
+
+PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
+                      VAR res: TypeIndex): BOOLEAN;
+  BEGIN
+    res := InvalidType;
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN
+      res := dInt; RETURN TRUE
+    END;
+    IF ~divmod & (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      res := dReal; RETURN TRUE
+    END;
+    RETURN FALSE
+  END ArithCheck;
+
+PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
+  BEGIN
+    res := InvalidType;
+    IF t = InvalidType THEN RETURN TRUE END;
+    IF IsIntFamily(t) THEN res := dInt; RETURN TRUE END;
+    IF ClassOf(t) = ClReal THEN res := dReal; RETURN TRUE END;
+    RETURN FALSE
+  END UnaryCheck;
+
+PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+  BEGIN
+    IF t = InvalidType THEN RETURN TRUE END;
+    RETURN ClassOf(t) = ClBool
+  END BoolCheck;
+
+PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
+  VAR rl, rr : TypeIndex;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF SameType(l, r) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClBool) & (ClassOf(r) = ClBool) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClStr) & (ClassOf(r) = ClStr) THEN
+      RETURN TRUE
+    END;
+    rl := Resolve(l); rr := Resolve(r);
+    IF (rl = InvalidType) OR (rr = InvalidType) THEN RETURN TRUE END;
+    IF (tform[rl] = FSet) & (tform[rr] = FSet) THEN
+      RETURN SetBasesOk(tref[rl], tref[rr])
+    END;
+    RETURN FALSE
+  END EqCheck;
+
+PROCEDURE OrdCheck (l, r: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClEnum) & SameType(l, r) THEN RETURN TRUE END;
+    RETURN FALSE
+  END OrdCheck;
+
+PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
+  VAR rs, b : TypeIndex;
+  BEGIN
+    IF (l = InvalidType) OR (set = InvalidType) THEN RETURN TRUE END;
+    rs := Resolve(set);
+    IF (rs = InvalidType) OR (tform[rs] # FSet) THEN RETURN FALSE END;
+    b := tref[rs];
+    IF SameType(l, b) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(b) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(b) = ClChar) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END InCheck;
+
+PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF op = OpIn THEN RETURN InCheck(l, r) END;
+    IF (op = OpEq) OR (op = OpNeq1) OR (op = OpNeq2) THEN
+      RETURN EqCheck(l, r)
+    END;
+    RETURN OrdCheck(l, r)
+  END RelCheck;
+
+PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (first = InvalidType) OR (elem = InvalidType) THEN
+      RETURN TRUE
+    END;
+    IF SameType(first, elem) THEN RETURN TRUE END;
+    IF IsIntFamily(first) & IsIntFamily(elem) THEN RETURN TRUE END;
+    RETURN FALSE
+  END SetElemCheck;
+
+PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
+  VAR e : TypeIndex;
+  BEGIN
+    e := Resolve(elem);
+    IF e = InvalidType THEN e := dInt END;
+    RETURN NewSet(e)
+  END SetFor;
+
+(* ---------------- init ---------------- *)
+
+PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
+  BEGIN
+    IF Enter(name, kind) THEN SetSymType(name, t) END
+  END Predef;
+
+PROCEDURE Init;
+  BEGIN
+    nSyms := 0; curLev := 0; mtop := 0;
+    nPend := 0; nPendF := 0;
+    nTypes := 0; nFields := 0;
+    dInt := NewDesc(FInt, InvalidType);
+    dCard := NewDesc(FInt, InvalidType);
+    dReal := NewDesc(FReal, InvalidType);
+    dChar := NewDesc(FChar, InvalidType);
+    dBool := NewDesc(FBool, InvalidType);
+    Predef("INTEGER", KindPredef, dInt);
+    Predef("CARDINAL", KindPredef, dCard);
+    Predef("SHORTINT", KindPredef, dInt);
+    Predef("LONGINT", KindPredef, dInt);
+    Predef("REAL", KindPredef, dReal);
+    Predef("LONGREAL", KindPredef, dReal);
+    Predef("CHAR", KindPredef, dChar);
+    Predef("BOOLEAN", KindPredef, dBool);
+    Predef("TRUE", KindConst, dBool);
+    Predef("FALSE", KindConst, dBool);
+    Predef("NIL", KindConst, InvalidType)
+  END Init;
+
+(* ---------------- listing ---------------- *)
+
+PROCEDURE WriteKind (kind: INTEGER);
+  BEGIN
+    CASE kind OF
+      KindConst  : FileIO.WriteString(FileIO.StdOut, "CONST")
+    | KindType   : FileIO.WriteString(FileIO.StdOut, "TYPE")
+    | KindVar    : FileIO.WriteString(FileIO.StdOut, "VAR")
+    | KindImport : FileIO.WriteString(FileIO.StdOut, "IMPORT")
+    | KindModule : FileIO.WriteString(FileIO.StdOut, "MODULE")
+    | KindPredef : FileIO.WriteString(FileIO.StdOut, "PREDEF")
+    | KindField  : FileIO.WriteString(FileIO.StdOut, "FIELD")
+    ELSE FileIO.WriteString(FileIO.StdOut, "???")
+    END
+  END WriteKind;
+
+PROCEDURE PrintTable;
+  VAR i : CARDINAL;
+  BEGIN
+    FileIO.WriteLn(FileIO.StdOut);
+    FileIO.WriteString(FileIO.StdOut, "--- Symbol table ---");
+    FileIO.WriteLn(FileIO.StdOut);
+    i := 0;
+    WHILE i < nSyms DO
+      FileIO.WriteString(FileIO.StdOut, "  ");
+      FileIO.WriteString(FileIO.StdOut, syms[i].name);
+      FileIO.WriteString(FileIO.StdOut, " : ");
+      WriteKind(syms[i].kind);
+      FileIO.WriteString(FileIO.StdOut, " #");
+      FileIO.WriteInt(FileIO.StdOut, syms[i].typ, 1);
+      FileIO.WriteLn(FileIO.StdOut);
+      INC(i)
+    END
+  END PrintTable;
+
+BEGIN
+  Init
+END SymTab.

Test2/build_qbe.sh

@@ -0,0 +1,119 @@
+#
+# Builds the Test2 compiler (SimpleMod2 scalar subset -> QBE backend)
+# and runs the end-to-end tests.
+# Requires GNU Modula-2 (gm2), the CR binary, qbe and cc.
+#
+# Usage: ./build_qbe.sh        (from the Test2 directory)
+#
+# Pipeline per test: SimpleQ tests/<f>.mod -> gen_qbe/<F>.ssa
+#   -> qbe -> cc -> ./<F> ; exit code must match the expectation below.
+# Test convention: a global VAR ExitCode : INTEGER selects the process
+# exit code; without it the program returns 0.
+#
+
+pass=0
+fail=0
+
+expect_run() {
+  # $1 = test file (no dir), $2 = expected exit code
+  name="$1"
+  want="$2"
+  mod="$(basename "$name" .mod)"
+  # The backend names the .ssa after the MODULE name; the newest .ssa
+  # is the one just produced (tests run sequentially, names unique).
+  out=$(./SimpleQ "tests/$name" 2>&1)
+  case "$out" in
+    *"Parsed correctly"*) ;;
+    *) echo "FAIL $name: SimpleQ rejected it: $out"; fail=$((fail+1)); return ;;
+  esac
+  ssa=$(ls -t gen_qbe/*.ssa 2>/dev/null | head -n 1)
+  if [ -z "$ssa" ]; then
+    echo "FAIL $name: no .ssa produced"; fail=$((fail+1)); return
+  fi
+  base=$(basename "$ssa" .ssa)
+  if ! qbe -o "gen_qbe/$base.s" "$ssa" 2> "gen_qbe/$base.qbeerr"; then
+    echo "FAIL $name: qbe rejected $ssa:"; cat "gen_qbe/$base.qbeerr"; fail=$((fail+1)); return
+  fi
+  if ! cc "gen_qbe/$base.s" -o "gen_qbe/$base" 2> "gen_qbe/$base.ccerr"; then
+    echo "FAIL $name: cc failed:"; cat "gen_qbe/$base.ccerr"; fail=$((fail+1)); return
+  fi
+  "gen_qbe/$base" > /dev/null 2>&1
+  got=$?
+  if [ "$got" = "$want" ]; then
+    echo "ok   $name -> exit $got"
+    pass=$((pass+1))
+  else
+    echo "FAIL $name: exit $got, expected $want"
+    fail=$((fail+1))
+  fi
+}
+
+expect_fail() {
+  # $1 = test file, $2 = message text that must appear in the .LST
+  # (listings show messages, not numeric codes)
+  name="$1"
+  want="$2"
+  out=$(./SimpleQ "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 "=== Regenerating SimpleQS / SimpleQP / SimpleQ from SimpleQ.atg ==="
+CRFRAMES="$(pwd)" ../CR -m -C SimpleQ.atg || exit 1
+
+echo "=== Deleting all o files ==="
+rm -f ./*.o
+
+echo "=== Compiling the needed modules ==="
+for m in FileIO SymTab QbeGen SimpleQS SimpleQP SimpleQ; 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 \
+    SimpleQS.o SimpleQP.o FileIO.o SymTab.o QbeGen.o SimpleQ.mod || exit 1
+
+echo "=== Phase 2: compiling main module and linking using the module list ==="
+gm2 -fiso -fuse-list=modules.lst -o SimpleQ \
+    SimpleQS.o SimpleQP.o FileIO.o SymTab.o QbeGen.o SimpleQ.mod || exit 1
+
+echo "=== SimpleQ built ==="
+
+mkdir -p gen_qbe tests
+
+echo "=== Positive tests (compile + qbe + cc + run) ==="
+expect_run q_minimal.mod 0
+expect_run q_arith.mod 7
+expect_run q_const.mod 15
+expect_run q_bool.mod 42
+expect_run q_if.mod 20
+expect_run q_case.mod 103
+expect_run q_while.mod 55
+expect_run q_repeat.mod 55
+expect_run q_loop.mod 7
+expect_run q_for.mod 85
+expect_run q_real.mod 31
+expect_run q_char.mod 97
+expect_run q_enum.mod 1
+expect_run q_full.mod 74
+
+echo "=== Negative tests (must be rejected) ==="
+expect_fail q_bad_array.mod "qbe backend"
+expect_fail q_bad_with.mod "qbe backend"
+expect_fail q_bad_set.mod "qbe backend"
+expect_fail q_bad_exit.mod "qbe backend"
+expect_fail q_bad_const.mod "qbe backend"
+expect_fail q_bad_asn.mod "incompatible assignment"
+
+echo "=== $pass passed, $fail failed ==="
+test "$fail" = 0

Test2/compiler.frm

@@ -0,0 +1,240 @@
+MODULE -->Grammar;
+(* This is an example of a rudimentary main module for use with COCO/R.
+   It assumes the FileIO/Storage I/O libraries (as supplied with this
+   project) are available.
+   The auxiliary modules <Grammar>S (scanner) and <Grammar>P (parser)
+   are assumed to have been constructed with COCO/R compiler generator. *)
+
+  FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
+  FROM -->Parser IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+    (* and any others needed *)
+
+  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 *)
+        | 200: Msg("duplicate identifier")
+        | 201: Msg("undeclared identifier")
+        | 202: Msg("module name mismatch")
+        | 210: Msg("incompatible assignment")
+        | 211: Msg("arithmetic operand must be numeric")
+        | 212: Msg("boolean operand required")
+        | 213: Msg("incompatible comparison")
+        | 214: Msg("BOOLEAN condition required")
+        | 215: Msg("not a RECORD type")
+        | 216: Msg("unknown field")
+        | 217: Msg("not an ARRAY type")
+        | 218: Msg("array index must be integer")
+        | 219: Msg("not a POINTER type")
+        | 220: Msg("FOR needs integer variable and bounds")
+        | 221: Msg("not a type name")
+        | 222: Msg("set operand mismatch")
+        | 223: Msg("cyclical type definition")
+        | 224: Msg("ordinal type required")
+        | 230: Msg("qbe backend: construct not supported in scalar subset")
+        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 as complete file name by appending ext to oldName
+     Examples: (assume ext = "EXT")
+           old.any ==> old.EXT
+           old     ==> old.EXT
+     This is not a file renaming facility, merely a string manipulation
+     routine. *)
+    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");
+        (* ++++++++ Add further activities if required ++++++++++ *)
+    END;
+  END -->Grammar.

Test2/compiler.gpm

@@ -0,0 +1,221 @@
+MODULE -->Grammar;
+(* This is an example of a rudimentary main module for use with COCO/R.
+   It assumes the FileIO/Storage I/O libraries (as supplied with this
+   project) are available.
+   The auxiliary modules <Grammar>S (scanner) and <Grammar>P (parser)
+   are assumed to have been constructed with COCO/R compiler generator. *)
+
+  FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
+  FROM -->Parser IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+    (* and any others needed *)
+
+  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 *)
+        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 AppendExtension (oldName, Ext: ARRAY OF CHAR;
+                             VAR newName: ARRAY OF CHAR);
+  (* Constructs newName as complete file name by appending ext to oldName
+     Examples: (assume ext = "EXT")
+           old.any ==> old.EXT
+           old     ==> old.EXT
+     This is not a file renaming facility, merely a string manipulation
+     routine. *)
+    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 AppendExtension;
+
+  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.err, 'No input file specified');
+      HALT
+    END;
+
+    (* open the source file - Scanner.src *)
+    FileIO.Open(src, sourceName, FALSE);
+    IF ~ FileIO.Okay THEN
+      FileIO.WriteString(FileIO.err, 'Could not open input file');
+      FileIO.WriteLn(FileIO.err);
+      HALT
+    END;
+
+    (* open the output file for the source listing - Scanner.lst *)
+    AppendExtension(sourceName, ".LST", listName);
+    FileIO.Open(lst, listName, TRUE);
+    IF ~ FileIO.Okay THEN
+      FileIO.WriteString(FileIO.err, 'Could not open listing file');
+      FileIO.WriteLn(FileIO.err);
+      (* default Scanner.lst to screen *) lst := FileIO.err;
+    END;
+
+    (* install error reporting procedure - Scanner.Error *)
+    Error := StoreError;
+
+    (* instigate the compilation - Parser.Parse *)
+    FileIO.WriteString(FileIO.err, 'Parsing'); FileIO.WriteLn(FileIO.err);
+    Parse;
+
+    (* generate the source listing on lst file *)
+    PrintListing;
+    IF lst # FileIO.err THEN FileIO.Close(lst) END;
+    
+    (* examine the outcome *)
+    IF NOT Successful()
+      THEN
+        FileIO.WriteString(FileIO.err, 'Incorrect source');
+      ELSE
+        FileIO.WriteString(FileIO.err, 'Parsed correctly');
+        (* ++++++++ Add further activities if required ++++++++++ *)
+    END;
+  END -->Grammar.

Test2/gen_qbe/QArith.ssa

@@ -0,0 +1,28 @@
+# QBE IR generated by the SimpleQ backend
+
+data $x = { w 0 }
+data $y = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  %t1 =w mul 2, 3
+  %t2 =w add 1, %t1
+  %t3 =w div 4, 2
+  %t4 =w sub %t2, %t3
+  storew %t4, $x
+  %t5 =w loadw $y
+  %t6 =w loadw $x
+  %t7 =w add %t6, 10
+  %t8 =w mul %t7, 2
+  %t9 =w rem %t8, 7
+  storew %t9, $y
+  %t10 =w loadw $ExitCode
+  %t11 =w loadw $x
+  %t12 =w loadw $y
+  %t13 =w add %t11, %t12
+  storew %t13, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QBadArr.ssa

@@ -0,0 +1,12 @@
+# QBE IR generated by the SimpleQ backend
+
+data $a = { w 0 }
+data $x = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  storew 1, $x
+  %t1 =w loadw $x
+  ret 0
+}

Test2/gen_qbe/QBadAsn.ssa

@@ -0,0 +1,14 @@
+# QBE IR generated by the SimpleQ backend
+
+data $x = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  storew d_3.14, $x
+  %t1 =w loadw $ExitCode
+  storew 0, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QBadConst.ssa

@@ -0,0 +1,16 @@
+# QBE IR generated by the SimpleQ backend
+
+data $A = { w 10 }
+  %t0 =w loadw $A
+  %t1 =w add %t0, 1
+data $B = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t2 =w loadw $ExitCode
+  %t3 =w loadw $A
+  storew %t3, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QBadExit.ssa

@@ -0,0 +1,11 @@
+# QBE IR generated by the SimpleQ backend
+
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $ExitCode
+  storew 1, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QBadSet.ssa

@@ -0,0 +1,12 @@
+# QBE IR generated by the SimpleQ backend
+
+data $s = { w 0 }
+data $x = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  storew 1, $x
+  storew 0, $s
+  ret 0
+}

Test2/gen_qbe/QBadWith.ssa

@@ -0,0 +1,11 @@
+# QBE IR generated by the SimpleQ backend
+
+data $p = { w 0 }
+data $n = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $n
+  storew 1, $n
+  ret 0
+}

Test2/gen_qbe/QBool.ssa

@@ -0,0 +1,44 @@
+# QBE IR generated by the SimpleQ backend
+
+data $a = { w 0 }
+data $b = { w 0 }
+data $x = { w 0 }
+data $y = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  storew 5, $x
+  %t1 =w loadw $y
+  storew 10, $y
+  %t2 =w loadw $a
+  %t3 =w loadw $x
+  %t4 =w loadw $y
+  %t5 =w csltw %t3, %t4
+  %t6 =w loadw $x
+  %t7 =w cnew %t6, 0
+  %t8 =w and %t5, %t7
+  storew %t8, $a
+  %t9 =w loadw $b
+  %t10 =w loadw $a
+  %t11 =w xor 1, %t10
+  %t12 =w loadw $x
+  %t13 =w ceqw %t12, 5
+  %t14 =w or %t11, %t13
+  storew %t14, $b
+  %t15 =w loadw $a
+  %t16 =w loadw $b
+  %t17 =w and %t15, %t16
+  jnz %t17, @L0, @L1
+@L0
+  %t18 =w loadw $ExitCode
+  storew 42, $ExitCode
+  jmp @L2
+@L1
+  %t19 =w loadw $ExitCode
+  storew 1, $ExitCode
+@L2
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QCase.ssa

@@ -0,0 +1,66 @@
+# QBE IR generated by the SimpleQ backend
+
+data $x = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  storew 7, $x
+  %t1 =w loadw $x
+  %t2 =w ceqw %t1, 1
+  jnz %t2, @L1, @L3
+@L3
+  %t3 =w ceqw %t1, 2
+  jnz %t3, @L1, @L4
+@L4
+  jmp @L2
+@L1
+  %t4 =w loadw $ExitCode
+  storew 1, $ExitCode
+  jmp @L0
+@L2
+  %t5 =w csgew %t1, 3
+  %t6 =w cslew %t1, 6
+  %t7 =w and %t5, %t6
+  jnz %t7, @L5, @L7
+@L7
+  jmp @L6
+@L5
+  %t8 =w loadw $ExitCode
+  storew 2, $ExitCode
+  jmp @L0
+@L6
+  %t9 =w csgew %t1, 7
+  %t10 =w cslew %t1, 10
+  %t11 =w and %t9, %t10
+  jnz %t11, @L8, @L10
+@L10
+  jmp @L9
+@L8
+  %t12 =w loadw $ExitCode
+  storew 3, $ExitCode
+  jmp @L0
+@L9
+  %t13 =w loadw $ExitCode
+  storew 9, $ExitCode
+@L0
+  %t14 =w loadw $x
+  %t15 =w add %t14, 1
+  %t16 =w ceqw %t15, 8
+  jnz %t16, @L12, @L14
+@L14
+  jmp @L13
+@L12
+  %t17 =w loadw $ExitCode
+  %t18 =w loadw $ExitCode
+  %t19 =w add %t18, 100
+  storew %t19, $ExitCode
+  jmp @L11
+@L13
+  %t20 =w loadw $ExitCode
+  storew 0, $ExitCode
+@L11
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QChar.ssa

@@ -0,0 +1,27 @@
+# QBE IR generated by the SimpleQ backend
+
+data $c = { w 0 }
+data $d = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $c
+  storew 97, $c
+  %t1 =w loadw $d
+  storew 98, $d
+  %t2 =w loadw $c
+  %t3 =w loadw $d
+  %t4 =w csltw %t2, %t3
+  jnz %t4, @L0, @L1
+@L0
+  %t5 =w loadw $ExitCode
+  storew 97, $ExitCode
+  jmp @L2
+@L1
+  %t6 =w loadw $ExitCode
+  storew 98, $ExitCode
+@L2
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QConst.ssa

@@ -0,0 +1,19 @@
+# QBE IR generated by the SimpleQ backend
+
+data $Max = { w 10 }
+data $Neg = { w -5 }
+data $Hex = { w 10 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $ExitCode
+  %t1 =w loadw $Max
+  %t2 =w loadw $Neg
+  %t3 =w add %t1, %t2
+  %t4 =w loadw $Hex
+  %t5 =w add %t3, %t4
+  storew %t5, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QEnum.ssa

@@ -0,0 +1,50 @@
+# QBE IR generated by the SimpleQ backend
+
+data $red = { w 0 }
+data $green = { w 1 }
+data $blue = { w 2 }
+data $c = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $c
+  %t1 =w loadw $green
+  storew %t1, $c
+  %t2 =w loadw $c
+  %t3 =w loadw $red
+  %t4 =w ceqw %t2, %t3
+  jnz %t4, @L1, @L3
+@L3
+  jmp @L2
+@L1
+  %t5 =w loadw $ExitCode
+  storew 0, $ExitCode
+  jmp @L0
+@L2
+  %t6 =w loadw $green
+  %t7 =w ceqw %t2, %t6
+  jnz %t7, @L4, @L6
+@L6
+  jmp @L5
+@L4
+  %t8 =w loadw $ExitCode
+  storew 1, $ExitCode
+  jmp @L0
+@L5
+  %t9 =w loadw $blue
+  %t10 =w ceqw %t2, %t9
+  jnz %t10, @L7, @L9
+@L9
+  jmp @L8
+@L7
+  %t11 =w loadw $ExitCode
+  storew 2, $ExitCode
+  jmp @L0
+@L8
+  %t12 =w loadw $ExitCode
+  storew 9, $ExitCode
+@L0
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QFor.ssa

@@ -0,0 +1,48 @@
+# QBE IR generated by the SimpleQ backend
+
+data $k = { w 0 }
+data $s = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $s
+  storew 0, $s
+  storew 1, $k
+  jmp @L1
+@L0
+  %t1 =w loadw $s
+  %t2 =w loadw $s
+  %t3 =w loadw $k
+  %t4 =w add %t2, %t3
+  storew %t4, $s
+  %t5 =w loadw $k
+  %t6 =w add %t5, 1
+  storew %t6, $k
+@L1
+  %t7 =w loadw $k
+  %t8 =w cslew %t7, 10
+  jnz %t8, @L0, @L2
+@L2
+  storew 10, $k
+  jmp @L4
+@L3
+  %t9 =w loadw $s
+  %t10 =w loadw $s
+  %t11 =w loadw $k
+  %t12 =w add %t10, %t11
+  storew %t12, $s
+  %t13 =w loadw $k
+  %t14 =w add %t13, -2
+  storew %t14, $k
+@L4
+  %t15 =w loadw $k
+  %t16 =w csgew %t15, 1
+  jnz %t16, @L3, @L5
+@L5
+  %t17 =w loadw $ExitCode
+  %t18 =w loadw $s
+  storew %t18, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QFull.ssa

@@ -0,0 +1,95 @@
+# QBE IR generated by the SimpleQ backend
+
+data $Limit = { w 20 }
+data $k = { w 0 }
+data $n = { w 0 }
+data $s = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $n
+  storew 0, $n
+  %t1 =w loadw $s
+  storew 0, $s
+  storew 1, $k
+  jmp @L1
+@L0
+  %t2 =w loadw $s
+  %t3 =w loadw $s
+  %t4 =w loadw $k
+  %t5 =w add %t3, %t4
+  storew %t5, $s
+  %t6 =w loadw $k
+  %t7 =w add %t6, 1
+  storew %t7, $k
+@L1
+  %t8 =w loadw $k
+  %t9 =w cslew %t8, 10
+  jnz %t9, @L0, @L2
+@L2
+  %t10 =w loadw $n
+  %t11 =w loadw $s
+  %t12 =w loadw $Limit
+  %t13 =w rem %t11, %t12
+  storew %t13, $n
+@L3
+  %t14 =w loadw $n
+  %t15 =w csltw %t14, 0
+  jnz %t15, @L4, @L5
+@L4
+  %t16 =w loadw $n
+  %t17 =w loadw $n
+  %t18 =w add %t17, 1
+  storew %t18, $n
+  jmp @L3
+@L5
+@L6
+  %t19 =w loadw $n
+  %t20 =w loadw $n
+  %t21 =w add %t20, 1
+  storew %t21, $n
+  %t22 =w loadw $n
+  %t23 =w csgew %t22, 17
+  jnz %t23, @L7, @L6
+@L7
+@L8
+  %t24 =w loadw $n
+  %t25 =w csgtw %t24, 100
+  jnz %t25, @L10, @L11
+@L10
+  jmp @L9
+@L11
+@L12
+  %t26 =w loadw $n
+  %t27 =w loadw $n
+  %t28 =w add %t27, 1
+  storew %t28, $n
+  %t29 =w loadw $n
+  %t30 =w csgew %t29, 19
+  jnz %t30, @L13, @L14
+@L13
+  jmp @L9
+@L14
+@L15
+  jmp @L8
+@L9
+  %t31 =w loadw $n
+  %t32 =w ceqw %t31, 19
+  jnz %t32, @L17, @L19
+@L19
+  jmp @L18
+@L17
+  %t33 =w loadw $ExitCode
+  %t34 =w loadw $s
+  %t35 =w loadw $n
+  %t36 =w add %t34, %t35
+  storew %t36, $ExitCode
+  jmp @L16
+@L18
+  %t37 =w loadw $ExitCode
+  storew 0, $ExitCode
+@L16
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QIf.ssa

@@ -0,0 +1,39 @@
+# QBE IR generated by the SimpleQ backend
+
+data $x = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $x
+  storew 2, $x
+  %t1 =w loadw $x
+  %t2 =w ceqw %t1, 1
+  jnz %t2, @L0, @L1
+@L0
+  %t3 =w loadw $ExitCode
+  storew 10, $ExitCode
+  jmp @L2
+@L1
+  %t4 =w loadw $x
+  %t5 =w ceqw %t4, 2
+  jnz %t5, @L3, @L4
+@L3
+  %t6 =w loadw $ExitCode
+  storew 20, $ExitCode
+  jmp @L2
+@L4
+  %t7 =w loadw $ExitCode
+  storew 30, $ExitCode
+@L2
+  %t8 =w loadw $x
+  %t9 =w cnew %t8, 2
+  jnz %t9, @L5, @L6
+@L5
+  %t10 =w loadw $ExitCode
+  storew 99, $ExitCode
+@L6
+@L7
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QLoop.ssa

@@ -0,0 +1,29 @@
+# QBE IR generated by the SimpleQ backend
+
+data $i = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $i
+  storew 0, $i
+@L0
+  %t1 =w loadw $i
+  %t2 =w loadw $i
+  %t3 =w add %t2, 1
+  storew %t3, $i
+  %t4 =w loadw $i
+  %t5 =w csgew %t4, 7
+  jnz %t5, @L2, @L3
+@L2
+  jmp @L1
+@L3
+@L4
+  jmp @L0
+@L1
+  %t6 =w loadw $ExitCode
+  %t7 =w loadw $i
+  storew %t7, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QMin.ssa

@@ -0,0 +1,7 @@
+# QBE IR generated by the SimpleQ backend
+
+
+export function w $main() {
+@start
+  ret 0
+}

Test2/gen_qbe/QReal.ssa

@@ -0,0 +1,51 @@
+# QBE IR generated by the SimpleQ backend
+
+data $Pi = { d 0 }
+data $r = { d 0 }
+data $s = { d 0 }
+data $x = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =d copy d_2.5
+  stored %t0, $Pi
+  %t1 =w loadw $x
+  storew 3, $x
+  %t2 =d loadd $r
+  %t3 =w loadw $x
+  %t4 =d swtof %t3
+  stored %t4, $r
+  %t5 =d loadd $s
+  %t6 =d mul d_3.5, d_2.0
+  stored %t6, $s
+  %t7 =d loadd $r
+  %t8 =d loadd $r
+  %t9 =d loadd $Pi
+  %t10 =d add %t8, %t9
+  stored %t10, $r
+  %t11 =d loadd $s
+  %t12 =d loadd $r
+  %t13 =w cgtd %t11, %t12
+  jnz %t13, @L0, @L1
+@L0
+  %t14 =w loadw $ExitCode
+  storew 11, $ExitCode
+  jmp @L2
+@L1
+  %t15 =w loadw $ExitCode
+  storew 12, $ExitCode
+@L2
+  %t16 =d loadd $s
+  %t17 =w ceqd %t16, d_7.0
+  jnz %t17, @L3, @L4
+@L3
+  %t18 =w loadw $ExitCode
+  %t19 =w loadw $ExitCode
+  %t20 =w add %t19, 20
+  storew %t20, $ExitCode
+@L4
+@L5
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QRepeat.ssa

@@ -0,0 +1,32 @@
+# QBE IR generated by the SimpleQ backend
+
+data $i = { w 0 }
+data $s = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $i
+  storew 0, $i
+  %t1 =w loadw $s
+  storew 0, $s
+@L0
+  %t2 =w loadw $i
+  %t3 =w loadw $i
+  %t4 =w add %t3, 1
+  storew %t4, $i
+  %t5 =w loadw $s
+  %t6 =w loadw $s
+  %t7 =w loadw $i
+  %t8 =w add %t6, %t7
+  storew %t8, $s
+  %t9 =w loadw $i
+  %t10 =w csgew %t9, 10
+  jnz %t10, @L1, @L0
+@L1
+  %t11 =w loadw $ExitCode
+  %t12 =w loadw $s
+  storew %t12, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/gen_qbe/QWhile.ssa

@@ -0,0 +1,34 @@
+# QBE IR generated by the SimpleQ backend
+
+data $i = { w 0 }
+data $s = { w 0 }
+data $ExitCode = { w 0 }
+
+export function w $main() {
+@start
+  %t0 =w loadw $i
+  storew 1, $i
+  %t1 =w loadw $s
+  storew 0, $s
+@L0
+  %t2 =w loadw $i
+  %t3 =w cslew %t2, 10
+  jnz %t3, @L1, @L2
+@L1
+  %t4 =w loadw $s
+  %t5 =w loadw $s
+  %t6 =w loadw $i
+  %t7 =w add %t5, %t6
+  storew %t7, $s
+  %t8 =w loadw $i
+  %t9 =w loadw $i
+  %t10 =w add %t9, 1
+  storew %t10, $i
+  jmp @L0
+@L2
+  %t11 =w loadw $ExitCode
+  %t12 =w loadw $s
+  storew %t12, $ExitCode
+  %ec =w loadw $ExitCode
+  ret %ec
+}

Test2/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.

Test2/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.

Test2/summary.md

@@ -0,0 +1,106 @@
+# Test2 — SimpleMod2 with QBE backend — session summary
+
+Scalar-subset Modula-2 compiler: `SimpleQ.atg` (Coco/R) + `SymTab`
+(type checking, reused from Test1) + new `QbeGen` backend emitting
+QBE SSA to `gen_qbe/<Module>.ssa`, assembled with `qbe` and linked
+with `cc`. All work lives in `Test2/`, binary `Test2/SimpleQ`.
+
+## 1. Scope (user choice: scalar subset + full SSA→run pipeline)
+
+Full SimpleMod2 syntax parses and type-checks with Test1's exact
+codes (200/201/202, 210–224). Only scalar data is lowered:
+
+- INTEGER / CARDINAL / SHORTINT / LONGINT / BOOLEAN / CHAR /
+  enumerations → QBE `w`; REAL / LONGREAL → QBE `d` (widened).
+- Everything else parses but gets error 230
+  ("qbe backend: construct not supported in scalar subset"):
+  ARRAY / RECORD / SET / POINTER variables, string variables, WITH,
+  IN, set literals, non-literal CONST expressions and BY steps,
+  EXIT outside LOOP, imported names used as values.
+
+Test convention (the language has no I/O): a global
+`VAR ExitCode : INTEGER` makes generated `main` return its value;
+otherwise the program returns 0.
+
+## 2. Files
+
+- `SimpleQ.atg` (856 lines) — grammar; single-pass QBE emission.
+  Every expression synthesizes a QBE operand (immediate like `42`,
+  `-5`, `d_3.14` or fresh `%tN`); statements emit jumps/labels.
+  Code emits only on type-correct subtrees, so backend 230s never
+  cascade with type errors.
+- `QbeGen.def/.mod` (120/448 lines) — SSA writer: `data` globals,
+  `export function w $main`, temporaries (`%tN`), labels (`@LN`),
+  `ceqw/cnew/csltw/cslew/csgtw/csgew` + `ceqd/cned/cltd/cled/cgtd/cged`,
+  `swtof` for INTEGER→REAL assignment, loop-exit stack, CASE as
+  compare-chains, `NoQbe` guard (single 230 for WITH bodies).
+- `SymTab.def/.mod` — Test1 copy + 2 accessors (`PendCount`,
+  `PendName`) so VAR-list storage is emitted before `FixPending`.
+- `FileIO`, `scanner.frm`, `parser.frm`, `compiler.frm` (+230 text),
+  `compiler.gpm` — copied from Test1.
+- `build_qbe.sh` — regenerates (`CRFRAMES=. ../CR -m -C SimpleQ.atg`),
+  compiles with `gm2 -fiso`, links via the two-phase module-list
+  workaround, then runs the suite: `SimpleQ → qbe → cc → execute`,
+  checking exit codes; negatives must be rejected with the right message.
+- `tests/` — 14 positive + 6 negative `.mod` sources (with `.LST`
+  listings); `gen_qbe/` — backend output (`.ssa`, plus `.s`,
+  binaries and empty `.qbeerr`/`.ccerr` logs from the last run).
+
+## 3. Test results — 20/20 (verified 2026-09-14)
+
+| test | exit | covers |
+| ---- | ---: | ------ |
+| q_minimal | 0 | empty body, default `ret 0` |
+| q_arith | 7 | `+ - * DIV MOD`, precedence, parens |
+| q_const | 15 | CONST, unary minus, hex `0AH` |
+| q_bool | 42 | AND/OR/NOT, comparisons |
+| q_if | 20 | IF/ELSIF/ELSE, empty-IF fallthrough |
+| q_case | 103 | labels, ranges, ELSE, expr selector |
+| q_while | 55 | WHILE sum 1..10 |
+| q_repeat | 55 | REPEAT..UNTIL |
+| q_loop | 7 | LOOP + EXIT |
+| q_for | 85 | FOR, `BY -2` negative step |
+| q_real | 31 | REAL arith, int→real assign, real CONST (runtime init) |
+| q_char | 97 | CHAR literals/comparison |
+| q_enum | 1 | enum ordinals, CASE on enum |
+| q_full | 74 | combined demo (FOR/MOD/WHILE/REPEAT/LOOP/CASE) |
+| q_bad_array | rej/230 | ARRAY var + indexing |
+| q_bad_with | rej/230 | RECORD var + WITH (single 230) |
+| q_bad_set | rej/230 | SET var + set literal |
+| q_bad_exit | rej/230 | EXIT outside LOOP |
+| q_bad_const | rej/230 | non-literal CONST (`B = A + 1`) |
+| q_bad_asn | rej/210 | REAL→INTEGER (type parity with Test1) |
+
+Ad-hoc edge probe also verified: unary-minus temps (`-y`, `-r`),
+empty FOR (`5 TO 1` skipped), boolean CASE, `10H`, nested LOOP/EXIT
+(inner EXIT targets inner loop), AND-ed WHILE-style conditions.
+
+## 4. Bugs found and fixed this session
+
+1. `IntStr`/`NegFold` wrote the string terminator one past the end
+   (double `Len()` evaluation) → random garbage bytes in `.ssa`.
+2. `LabelList` took body/next labels as value params, so `NewLabel`
+   results were lost → garbage labels. Made them `VAR`.
+3. `LoopStat` missed the back-edge `jmp` → loop body ran once.
+4. This qbe accepts only integer literals in `data` (`d 0` ok,
+   `d 1.5` rejected) → non-zero REAL consts emit `d 0` plus a
+   runtime `copy` flushed at function start (`BeginBody`).
+
+## 5. Known limits
+
+- No mixed INTEGER/REAL arithmetic (Test1 rule; `r*2.0 + x` is a
+  211 error — convert via assignment first).
+- `DIV`/`MOD` truncate toward zero (C/QBE semantics, not Modula-2 floor).
+- Assignment targets emit a dead load before the store (valid QBE,
+  minor inefficiency from always-loading designators).
+- Multi-dimensional arrays check every index but track one element
+  type (inherited Test1 rule); unsupported anyway (230).
+
+## 6. Rebuild / run
+
+- Full suite: `./build_qbe.sh` (from `Test2/`).
+- Single file: `./SimpleQ tests/<file>.mod` (listing next to the
+  source, SSA in `gen_qbe/`), then
+  `qbe -o gen_qbe/<M>.s gen_qbe/<M>.ssa && cc gen_qbe/<M>.s -o gen_qbe/<M> && gen_qbe/<M>; echo $?`.
+- Requires: `CR` binary (repo root, `./build.sh`), `gm2 -fiso`,
+  `qbe`, `cc`.

Test2/tests/q_arith.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QArith;
+    2  VAR x, y : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 1 + 2 * 3 - 4 DIV 2;
+    5    y := (x + 10) * 2 MOD 7;
+    6    ExitCode := x + y
+    7  END QArith.
+
+    0 errors
+
+

Test2/tests/q_arith.mod

@@ -0,0 +1,7 @@
+MODULE QArith;
+VAR x, y : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 1 + 2 * 3 - 4 DIV 2;
+  y := (x + 10) * 2 MOD 7;
+  ExitCode := x + y
+END QArith.

Test2/tests/q_bad_array.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE QBadArr;
+    2  VAR a : ARRAY [1 .. 10] OF INTEGER; x : INTEGER;
+*****                             ^ qbe backend: construct not supported in scalar subset
+    3  BEGIN
+    4    x := 1;
+    5    a[x] := 5
+*****    ^ qbe backend: construct not supported in scalar subset
+*****      ^ qbe backend: construct not supported in scalar subset
+    6  END QBadArr.
+
+    3 errors
+
+

Test2/tests/q_bad_array.mod

@@ -0,0 +1,6 @@
+MODULE QBadArr;
+VAR a : ARRAY [1 .. 10] OF INTEGER; x : INTEGER;
+BEGIN
+  x := 1;
+  a[x] := 5
+END QBadArr.

Test2/tests/q_bad_asn.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QBadAsn;
+    2  VAR x : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 3.14;
+*****         ^ incompatible assignment
+    5    ExitCode := 0
+    6  END QBadAsn.
+
+    1 error
+
+

Test2/tests/q_bad_asn.mod

@@ -0,0 +1,6 @@
+MODULE QBadAsn;
+VAR x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 3.14;
+  ExitCode := 0
+END QBadAsn.

Test2/tests/q_bad_const.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QBadConst;
+    2  CONST A = 10; B = A + 1;
+*****                        ^ qbe backend: construct not supported in scalar subset
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := A
+    6  END QBadConst.
+
+    1 error
+
+

Test2/tests/q_bad_const.mod

@@ -0,0 +1,6 @@
+MODULE QBadConst;
+CONST A = 10; B = A + 1;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := A
+END QBadConst.

Test2/tests/q_bad_exit.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QBadExit;
+    2  VAR ExitCode : INTEGER;
+    3  BEGIN
+    4    ExitCode := 1;
+    5    EXIT
+*****    ^ qbe backend: construct not supported in scalar subset
+    6  END QBadExit.
+
+    1 error
+
+

Test2/tests/q_bad_exit.mod

@@ -0,0 +1,6 @@
+MODULE QBadExit;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := 1;
+  EXIT
+END QBadExit.

Test2/tests/q_bad_set.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE QBadSet;
+    2  VAR s : SET OF [0 .. 7]; x : INTEGER;
+*****                        ^ qbe backend: construct not supported in scalar subset
+    3  BEGIN
+    4    x := 1;
+    5    s := {1, 2, 3}
+*****    ^ qbe backend: construct not supported in scalar subset
+*****                 ^ qbe backend: construct not supported in scalar subset
+    6  END QBadSet.
+
+    3 errors
+
+

Test2/tests/q_bad_set.mod

@@ -0,0 +1,6 @@
+MODULE QBadSet;
+VAR s : SET OF [0 .. 7]; x : INTEGER;
+BEGIN
+  x := 1;
+  s := {1, 2, 3}
+END QBadSet.

Test2/tests/q_bad_with.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE QBadWith;
+    2  TYPE Point = RECORD x, y : INTEGER END;
+    3  VAR p : Point; n : INTEGER;
+*****          ^ qbe backend: construct not supported in scalar subset
+    4  BEGIN
+    5    n := 1;
+    6    WITH p DO x := 2 END
+*****         ^ qbe backend: construct not supported in scalar subset
+    7  END QBadWith.
+
+    2 errors
+
+

Test2/tests/q_bad_with.mod

@@ -0,0 +1,7 @@
+MODULE QBadWith;
+TYPE Point = RECORD x, y : INTEGER END;
+VAR p : Point; n : INTEGER;
+BEGIN
+  n := 1;
+  WITH p DO x := 2 END
+END QBadWith.

Test2/tests/q_bool.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE QBool;
+    2  VAR a, b : BOOLEAN; x, y : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 5; y := 10;
+    5    a := (x < y) AND (x # 0);
+    6    b := (NOT a) OR (x = 5);
+    7    IF a AND b THEN ExitCode := 42 ELSE ExitCode := 1 END
+    8  END QBool.
+
+    0 errors
+
+

Test2/tests/q_bool.mod

@@ -0,0 +1,8 @@
+MODULE QBool;
+VAR a, b : BOOLEAN; x, y : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 5; y := 10;
+  a := (x < y) AND (x # 0);
+  b := (NOT a) OR (x = 5);
+  IF a AND b THEN ExitCode := 42 ELSE ExitCode := 1 END
+END QBool.

Test2/tests/q_case.LST

@@ -0,0 +1,21 @@
+Listing:
+
+    1  MODULE QCase;
+    2  VAR x : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 7;
+    5    CASE x OF
+    6      1, 2 : ExitCode := 1
+    7    | 3 .. 6 : ExitCode := 2
+    8    | 7 .. 10 : ExitCode := 3
+    9    ELSE ExitCode := 9
+   10    END;
+   11    CASE x + 1 OF
+   12      8 : ExitCode := ExitCode + 100
+   13    ELSE ExitCode := 0
+   14    END
+   15  END QCase.
+
+    0 errors
+
+

Test2/tests/q_case.mod

@@ -0,0 +1,15 @@
+MODULE QCase;
+VAR x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 7;
+  CASE x OF
+    1, 2 : ExitCode := 1
+  | 3 .. 6 : ExitCode := 2
+  | 7 .. 10 : ExitCode := 3
+  ELSE ExitCode := 9
+  END;
+  CASE x + 1 OF
+    8 : ExitCode := ExitCode + 100
+  ELSE ExitCode := 0
+  END
+END QCase.

Test2/tests/q_char.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QChar;
+    2  VAR c, d : CHAR; ExitCode : INTEGER;
+    3  BEGIN
+    4    c := 'a';
+    5    d := 'b';
+    6    IF c < d THEN ExitCode := 97 ELSE ExitCode := 98 END
+    7  END QChar.
+
+    0 errors
+
+

Test2/tests/q_char.mod

@@ -0,0 +1,7 @@
+MODULE QChar;
+VAR c, d : CHAR; ExitCode : INTEGER;
+BEGIN
+  c := 'a';
+  d := 'b';
+  IF c < d THEN ExitCode := 97 ELSE ExitCode := 98 END
+END QChar.

Test2/tests/q_const.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE QConst;
+    2  CONST Max = 10; Neg = -5; Hex = 0AH;
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := Max + Neg + Hex
+    6  END QConst.
+
+    0 errors
+
+

Test2/tests/q_const.mod

@@ -0,0 +1,6 @@
+MODULE QConst;
+CONST Max = 10; Neg = -5; Hex = 0AH;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := Max + Neg + Hex
+END QConst.

Test2/tests/q_enum.LST

@@ -0,0 +1,18 @@
+Listing:
+
+    1  MODULE QEnum;
+    2  TYPE Color = (red, green, blue);
+    3  VAR c : Color; ExitCode : INTEGER;
+    4  BEGIN
+    5    c := green;
+    6    CASE c OF
+    7      red : ExitCode := 0
+    8    | green : ExitCode := 1
+    9    | blue : ExitCode := 2
+   10    ELSE ExitCode := 9
+   11    END
+   12  END QEnum.
+
+    0 errors
+
+

Test2/tests/q_enum.mod

@@ -0,0 +1,12 @@
+MODULE QEnum;
+TYPE Color = (red, green, blue);
+VAR c : Color; ExitCode : INTEGER;
+BEGIN
+  c := green;
+  CASE c OF
+    red : ExitCode := 0
+  | green : ExitCode := 1
+  | blue : ExitCode := 2
+  ELSE ExitCode := 9
+  END
+END QEnum.

Test2/tests/q_for.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE QFor;
+    2  VAR k, s : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    s := 0;
+    5    FOR k := 1 TO 10 DO s := s + k END;
+    6    FOR k := 10 TO 1 BY -2 DO s := s + k END;
+    7    ExitCode := s
+    8  END QFor.
+
+    0 errors
+
+

Test2/tests/q_for.mod

@@ -0,0 +1,8 @@
+MODULE QFor;
+VAR k, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  s := 0;
+  FOR k := 1 TO 10 DO s := s + k END;
+  FOR k := 10 TO 1 BY -2 DO s := s + k END;
+  ExitCode := s
+END QFor.

Test2/tests/q_full.LST

@@ -0,0 +1,21 @@
+Listing:
+
+    1  MODULE QFull;
+    2  CONST Limit = 20;
+    3  VAR k, n, s : INTEGER; ExitCode : INTEGER;
+    4  BEGIN
+    5    n := 0; s := 0;
+    6    FOR k := 1 TO 10 DO s := s + k END;
+    7    n := s MOD Limit;
+    8    WHILE n < 0 DO n := n + 1 END;
+    9    REPEAT n := n + 1 UNTIL n >= 17;
+   10    LOOP IF n > 100 THEN EXIT END; n := n + 1; IF n >= 19 THEN EXIT END END;
+   11    CASE n OF
+   12      19 : ExitCode := s + n
+   13    ELSE ExitCode := 0
+   14    END
+   15  END QFull.
+
+    0 errors
+
+

Test2/tests/q_full.mod

@@ -0,0 +1,15 @@
+MODULE QFull;
+CONST Limit = 20;
+VAR k, n, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  n := 0; s := 0;
+  FOR k := 1 TO 10 DO s := s + k END;
+  n := s MOD Limit;
+  WHILE n < 0 DO n := n + 1 END;
+  REPEAT n := n + 1 UNTIL n >= 17;
+  LOOP IF n > 100 THEN EXIT END; n := n + 1; IF n >= 19 THEN EXIT END END;
+  CASE n OF
+    19 : ExitCode := s + n
+  ELSE ExitCode := 0
+  END
+END QFull.

Test2/tests/q_if.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE QIf;
+    2  VAR x : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 2;
+    5    IF x = 1 THEN ExitCode := 10
+    6    ELSIF x = 2 THEN ExitCode := 20
+    7    ELSE ExitCode := 30 END;
+    8    IF x # 2 THEN ExitCode := 99 END
+    9  END QIf.
+
+    0 errors
+
+

Test2/tests/q_if.mod

@@ -0,0 +1,9 @@
+MODULE QIf;
+VAR x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 2;
+  IF x = 1 THEN ExitCode := 10
+  ELSIF x = 2 THEN ExitCode := 20
+  ELSE ExitCode := 30 END;
+  IF x # 2 THEN ExitCode := 99 END
+END QIf.

Test2/tests/q_loop.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE QLoop;
+    2  VAR i : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    i := 0;
+    5    LOOP
+    6      i := i + 1;
+    7      IF i >= 7 THEN EXIT END
+    8    END;
+    9    ExitCode := i
+   10  END QLoop.
+
+    0 errors
+
+

Test2/tests/q_loop.mod

@@ -0,0 +1,10 @@
+MODULE QLoop;
+VAR i : INTEGER; ExitCode : INTEGER;
+BEGIN
+  i := 0;
+  LOOP
+    i := i + 1;
+    IF i >= 7 THEN EXIT END
+  END;
+  ExitCode := i
+END QLoop.

Test2/tests/q_minimal.LST

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

Test2/tests/q_minimal.mod

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

Test2/tests/q_real.LST

@@ -0,0 +1,17 @@
+Listing:
+
+    1  MODULE QReal;
+    2  CONST Pi = 2.5;
+    3  VAR r, s : REAL; x : INTEGER; ExitCode : INTEGER;
+    4  BEGIN
+    5    x := 3;
+    6    r := x;
+    7    s := 3.5 * 2.0;
+    8    r := r + Pi;
+    9    IF s > r THEN ExitCode := 11 ELSE ExitCode := 12 END;
+   10    IF s = 7.0 THEN ExitCode := ExitCode + 20 END
+   11  END QReal.
+
+    0 errors
+
+

Test2/tests/q_real.mod

@@ -0,0 +1,11 @@
+MODULE QReal;
+CONST Pi = 2.5;
+VAR r, s : REAL; x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 3;
+  r := x;
+  s := 3.5 * 2.0;
+  r := r + Pi;
+  IF s > r THEN ExitCode := 11 ELSE ExitCode := 12 END;
+  IF s = 7.0 THEN ExitCode := ExitCode + 20 END
+END QReal.

Test2/tests/q_repeat.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QRepeat;
+    2  VAR i, s : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    i := 0; s := 0;
+    5    REPEAT i := i + 1; s := s + i UNTIL i >= 10;
+    6    ExitCode := s
+    7  END QRepeat.
+
+    0 errors
+
+

Test2/tests/q_repeat.mod

@@ -0,0 +1,7 @@
+MODULE QRepeat;
+VAR i, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  i := 0; s := 0;
+  REPEAT i := i + 1; s := s + i UNTIL i >= 10;
+  ExitCode := s
+END QRepeat.

Test2/tests/q_while.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE QWhile;
+    2  VAR i, s : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    i := 1; s := 0;
+    5    WHILE i <= 10 DO s := s + i; i := i + 1 END;
+    6    ExitCode := s
+    7  END QWhile.
+
+    0 errors
+
+

Test2/tests/q_while.mod

@@ -0,0 +1,7 @@
+MODULE QWhile;
+VAR i, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  i := 1; s := 0;
+  WHILE i <= 10 DO s := s + i; i := i + 1 END;
+  ExitCode := s
+END QWhile.