v3 step 1 — minimal integer pipeline to QBE (5/5 tests green)

compiler/.gitignore

@@ -0,0 +1,10 @@
+*.o
+M2
+src/M2S.*
+src/M2P.*
+src/M2.mod
+src/M2.err
+src/modules.lst
+src/*.LST
+tests/*.LST
+gen_ssa/

compiler/build.sh

@@ -0,0 +1,39 @@
+#!/bin/sh
+#
+# Builds the V3 M2 compiler (step 1: minimal integer pipeline to QBE).
+# Requires GNU Modula-2 (gm2 -fiso) and the Coco/R CR binary.
+#
+# Usage: ./build.sh   (from the compiler directory)
+#
+# All sources live in src/ (grammar, frames, FileIO, SymTab, QbeGen,
+# generated scanner/parser/driver). Objects land in the cwd; the
+# binary links to ./M2. Generated .ssa goes to gen_ssa/.
+#
+# Pipeline: src/M2.atg -> src/M2S/M2P/M2 (.mod)
+#           -> gm2 -fiso -I src -> ./M2
+#           -> ./M2 tests/foo.mod -> gen_ssa/FOO.ssa -> qbe -> cc
+
+CRBIN="${CRBIN:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+
+echo "=== Regenerating M2S / M2P / M2 from M2.atg ==="
+cd src || exit 1
+CRFRAMES="$(pwd)" "$CRBIN" -m -C M2.atg || exit 1
+cd ..
+
+mkdir -p gen_ssa
+
+echo "=== Compiling ==="
+rm -f ./*.o
+for m in FileIO SymTab QbeGen M2S M2P M2; do
+  gm2 -fiso -I src -c "src/$m.mod" || exit 1
+done
+
+echo "=== Phase 1: generating the module list ==="
+gm2 -fiso -I src -fgen-module-list=src/modules.lst -o /dev/null \
+    M2S.o M2P.o FileIO.o SymTab.o QbeGen.o src/M2.mod || exit 1
+
+echo "=== Phase 2: compiling main module and linking ==="
+gm2 -fiso -I src -fuse-list=src/modules.lst -o M2 \
+    M2S.o M2P.o FileIO.o SymTab.o QbeGen.o src/M2.mod || exit 1
+
+echo "=== M2 built ==="

compiler/run_tests.sh

@@ -0,0 +1,55 @@
+#!/bin/sh
+# Step-1 regression: M2 -> gen_ssa/*.ssa -> qbe -> cc -> exit code.
+# Usage: ./run_tests.sh   (from the compiler directory)
+pass=0; fail=0
+
+modof() {
+  sed -n 's/^MODULE \([A-Za-z][A-Za-z0-9]*\).*/\1/p' "tests/$1" | head -n 1
+}
+
+expect_run() {
+  # $1 = test file (no dir), $2 = expected exit code
+  name="$1"; want="$2"; mod=$(modof "$name")
+  rm -f "gen_ssa/$mod.ssa" "gen_ssa/$mod.s" "gen_ssa/$mod"
+  if ./M2 "tests/$name" 2>&1 | grep -q "Parsed correctly"; then :; else
+    fail=$((fail+1)); echo "FAIL(run): $name rejected"; return
+  fi
+  if [ ! -f "gen_ssa/$mod.ssa" ]; then
+    fail=$((fail+1)); echo "FAIL(run): $name no gen_ssa/$mod.ssa"; return
+  fi
+  if ! qbe -o "gen_ssa/$mod.s" "gen_ssa/$mod.ssa" 2> "gen_ssa/$mod.qbeerr"; then
+    fail=$((fail+1)); echo "FAIL(run): $name qbe:"; cat "gen_ssa/$mod.qbeerr"; return
+  fi
+  if ! cc "gen_ssa/$mod.s" -o "gen_ssa/$mod" 2> "gen_ssa/$mod.ccerr"; then
+    fail=$((fail+1)); echo "FAIL(run): $name cc:"; cat "gen_ssa/$mod.ccerr"; return
+  fi
+  timeout 10 "gen_ssa/$mod" > /dev/null 2>&1; got=$?
+  if [ "$got" = "$want" ]; then
+    pass=$((pass+1)); echo "PASS(run): $name -> $got"
+  else
+    fail=$((fail+1)); echo "FAIL(run): $name got $got want $want"
+  fi
+}
+
+expect_fail() {
+  # $1 = test file, $2 = message text expected in the .LST
+  name="$1"; want="$2"
+  if ./M2 "tests/$name" 2>&1 | grep -q "Incorrect source"; then :; else
+    fail=$((fail+1)); echo "FAIL(fail): $name accepted"; return
+  fi
+  lst="tests/$(basename "$name" .mod).LST"
+  if grep -q "$want" "$lst" 2>/dev/null; then
+    pass=$((pass+1)); echo "PASS(fail): $name [$want]"
+  else
+    fail=$((fail+1)); echo "FAIL(fail): [$want] not found in $lst"
+  fi
+}
+
+mkdir -p gen_ssa
+expect_run t_minimal.mod 0
+expect_run t_exit.mod 7
+expect_run t_arith.mod 25
+expect_fail t_bad_undecl.mod "undeclared identifier"
+expect_fail t_bad_mismatch.mod "module name mismatch"
+echo "--- $pass passed, $fail failed ---"
+[ "$fail" -eq 0 ]

compiler/src/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.

compiler/src/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.

compiler/src/M2.atg

@@ -0,0 +1,269 @@
+COMPILER M2
+(* Step 1 — minimal integer pipeline (m2compiler-V3).
+   Subset: program MODULE + CONST (literal) + VAR INTEGER +
+   assignment + integer expressions (+ - * DIV MOD, leading sign,
+   parens). Fresh QBE backend (QbeGen) to gen_ssa/<Module>.ssa;
+   assemble with qbe, link with cc.
+
+   Test convention: a global VAR ExitCode : INTEGER makes generated
+   $main return its value as the process exit code, else return 0.
+
+   Semantic errors reuse the V1/V2/Test2 family: 200 duplicate,
+   201 undeclared, 202 module name mismatch, 210 bad assignment,
+   211 bad arithmetic, 221 not a type, 230 construct not supported
+   in step 1 (REAL/STRING literals, non-INTEGER VAR types,
+   non-literal CONST expressions, imported names as values).
+   Full language arrives in later steps; the 230s mark its edge. *)
+
+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 { hexDigit } "H" .
+  real    = digit { digit } "." { digit } .
+  string  = "'" { noQuote1 } "'"
+          | '"' { noQuote2 } '"' .
+
+PRODUCTIONS
+  M2                                    (. VAR m1, m2: SymTab.Name; .)
+    = "MODULE"
+      GetIdent<m1>                      (. SymTab.Init; QbeGen.OpenModule(m1);
+                                           IF ~SymTab.Enter(m1,
+                                              SymTab.KindModule) THEN
+                                             SemError(200) END; .)
+      ";"
+      { ConstBlock | VarBlock }
+      [ "BEGIN"                         (. QbeGen.BeginBody; .)
+        [ StatSeq ] ]
+      "END"
+      GetIdent<m2>                      (. IF ~SymTab.Equal(m1, m2) THEN
+                                             SemError(202) END; .)
+      "."                               (. QbeGen.EndModule;
+                                           SymTab.PrintTable; .) .
+  ConstBlock
+    = "CONST" { ConstDecl ";" } .
+  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; .)
+      "="
+      Expr<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); .) .
+  VarBlock
+    = "VAR" { VarDecl ";" } .
+  VarDecl                               (. VAR n, nm: SymTab.Name;
+                                             t: SymTab.TypeIndex;
+                                             i: CARDINAL;
+                                             cls: INTEGER; .)
+    = VarIdents ":"
+      GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+                                             SemError(201);
+                                             t := SymTab.InvalidType
+                                           ELSIF (SymTab.SymKind(n) #
+                                                  SymTab.KindType)
+                                              & (SymTab.SymKind(n) #
+                                                 SymTab.KindPredef) THEN
+                                             SemError(221);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.SymType(n)
+                                           END;
+                                           cls := SymTab.ClassOf(t);
+                                           IF (t # SymTab.InvalidType)
+                                              & (cls # SymTab.ClInt) 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; .) } .
+  StatSeq
+    = Statement { ";" Statement } .
+  Statement
+    = Assign .
+  Assign                                (. VAR dt, et: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             qd, qe: QbeGen.QVal;
+                                             qn: SymTab.Name; .)
+    = Design<dt, dk, qd, qn> ":="
+      Expr<et, qe>                      (. IF (dt # SymTab.InvalidType)
+                                           & (dk # SymTab.KindVar) THEN
+                                           SemError(210)
+                                         ELSIF ~SymTab.Assignable(et,
+                                                  dt) THEN
+                                           SemError(210) END;
+                                         IF (dk = SymTab.KindVar)
+                                            & (dt # SymTab.InvalidType)
+                                            & (et # SymTab.InvalidType) THEN
+                                           QbeGen.StoreVar(qn, qe, FALSE)
+                                         END; .) .
+  (* Designator, step-1 form: scalar variables and constants only.
+     No suffixes (field/index/deref are syntax errors in step 1). *)
+  Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+         VAR q: QbeGen.QVal; VAR qn: SymTab.Name>
+                                        (. VAR n: SymTab.Name;
+                                             cls: INTEGER; .)
+    = GetIdent<n>                       (. QbeGen.CopyOp(n, qn);
+                                           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.ClInt) THEN
+                                                   QbeGen.LoadVar(n,
+                                                     FALSE, q)
+                                                 ELSE
+                                                   QbeGen.CopyOp("0", q)
+                                                 END
+                                               END
+                                             ELSIF k = SymTab.KindVar THEN
+                                               cls :=
+                                                 SymTab.ClassOf(t);
+                                               IF cls = SymTab.ClInt THEN
+                                                 QbeGen.LoadVar(n,
+                                                   FALSE, q)
+                                               ELSE SemError(230);
+                                                 QbeGen.CopyOp("0", q)
+                                               END
+                                             ELSE QbeGen.CopyOp("0", q);
+                                               IF k = SymTab.KindImport THEN
+                                                 SemError(230)
+                                               END
+                                             END
+                                           END; .) .
+  Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+    = SimExpr<t, q> .
+  SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR t2, res2: SymTab.TypeIndex;
+                                             op: INTEGER;
+                                             q2, qt: QbeGen.QVal;
+                                             neg: 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, FALSE);
+                                             QbeGen.CopyOp(qt, q)
+                                           END
+                                         END; .)
+      { AddOp<op> Term<t2, q2>
+        (. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
+             t := res2
+           ELSE SemError(211); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             QbeGen.NewTemp(qt);
+             IF op = SymTab.OpAdd THEN
+               QbeGen.Op3("add", qt, q, q2, FALSE)
+             ELSE
+               QbeGen.Op3("sub", qt, q, q2, FALSE)
+             END;
+             QbeGen.CopyOp(qt, q)
+           ELSE QbeGen.CopyOp("0", q)
+           END; .) } .
+  AddOp<VAR op: INTEGER>
+    = "+"                               (. op := SymTab.OpAdd; .)
+    | "-"                               (. op := SymTab.OpSub; .) .
+  Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR t2, res2: SymTab.TypeIndex;
+                                             op: INTEGER;
+                                             q2, qt: QbeGen.QVal; .)
+    = Fact<t, q> { MulOp<op> Fact<t2, q2>
+      (. 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
+           QbeGen.NewTemp(qt);
+           IF op = SymTab.OpTimes THEN
+             QbeGen.Op3("mul", qt, q, q2, FALSE)
+           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; .) } .
+  MulOp<VAR op: INTEGER>
+    = "*"                               (. op := SymTab.OpTimes; .)
+    | "DIV"                             (. op := SymTab.OpDiv; .)
+    | "MOD"                             (. op := SymTab.OpMod; .) .
+  Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+                                        (. VAR s: ARRAY [0 .. 255] OF CHAR;
+                                             et, dt: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             qd: QbeGen.QVal;
+                                             qn: SymTab.Name; .)
+    = integer                           (. LexString(s);
+                                           QbeGen.NormInt(s, q);
+                                           t := SymTab.IntType(); .)
+    | real                              (. LexString(s);
+                                           t := SymTab.RealType();
+                                           SemError(230);
+                                           QbeGen.CopyOp("0", q); .)
+    | 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, qn>            (. t := dt;
+                                           QbeGen.CopyOp(qd, q); .)
+    | "(" Expr<et, q> ")"               (. t := et; .) .
+  GetIdent<VAR n: SymTab.Name>
+    = ident                             (. LexName(n); .) .
+
+END M2.

compiler/src/M2.lst

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

compiler/src/QbeGen.def

@@ -0,0 +1,67 @@
+DEFINITION MODULE QbeGen;
+(* Fresh QBE backend for m2compiler-V3, Step 1: minimal integer pipeline.
+
+   Emits QBE SSA text to "gen_ssa/<Module>.ssa" (run the M2 driver from
+   compiler/). Step-1 subset: INTEGER globals/CONSTs, integer
+   expressions (+ - * DIV MOD, leading sign, parens), assignment.
+   Every expression synthesizes a QBE operand in q (immediate like
+   "42"/"-5" or fresh "%tN"); invalid types synthesize "0" so the
+   .ssa stays assembleable.
+
+   Test convention: a global VAR ExitCode : INTEGER makes generated
+   $main return its value as the process exit code, else return 0. *)
+
+TYPE
+  QVal = ARRAY [0 .. 63] OF CHAR;
+
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
+(* Opens gen_ssa/<name>.ssa, resets counters. *)
+
+PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
+(* Emits "data $name = { w 0 }". t is a SymTab.TypeIndex (reserved
+   for later steps; step 1 only sees INTEGER). *)
+
+PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
+(* Emits "data $name = { w val }" for literal val, else a 0
+   placeholder (caller reports 230). *)
+
+PROCEDURE BeginBody;
+(* Emits "export function w $main() {@start" (once). *)
+
+PROCEDURE EndModule;
+(* Return sequence (via ExitCode when present), close file. *)
+
+PROCEDURE NewTemp (VAR t: QVal);
+(* Fresh "%tN" operand (deterministic counter: fixpoint-safe). *)
+
+PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
+(* q := fresh temp holding $name (isReal reserved; step 1: FALSE). *)
+
+PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
+(* "storew q, $name" (isReal reserved; step 1: FALSE). *)
+
+PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
+               isReal: BOOLEAN);
+(* "res =w mn l, r" with mn = add/sub/mul/div/rem. *)
+
+PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
+(* q := fresh temp holding "-a". a and q must differ. *)
+
+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);
+(* "0FFH" -> "255"; plain decimals copied through. *)
+
+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 unary minus into a literal ("5" -> "-5"). Safe for same var. *)
+
+PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
+(* TRUE for literal operands (not %temporaries). *)
+
+PROCEDURE Remark (s: ARRAY OF CHAR);
+(* Emits a "# s" comment line. *)
+
+END QbeGen.

compiler/src/QbeGen.mod

@@ -0,0 +1,277 @@
+IMPLEMENTATION MODULE QbeGen;
+
+IMPORT FileIO, SymTab;
+
+VAR
+  out    : FileIO.File;
+  opened : BOOLEAN;
+  inBody : BOOLEAN;
+  nTemp  : CARDINAL;
+
+(* ---------------- 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 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 : 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
+    ELSE
+      Cpy(q, "-");
+      App(q, tmp)
+    END
+  END NegFold;
+
+PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    IF Len(s) = 0 THEN RETURN FALSE END;
+    RETURN ((s[0] >= "0") & (s[0] <= "9")) OR (s[0] = "-")
+  END IsImm;
+
+(* ---------------- module / data section ---------------- *)
+
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
+  VAR fname : ARRAY [0 .. 127] OF CHAR;
+  BEGIN
+    fname[0] := 0C;
+    App(fname, "gen_ssa/");
+    App(fname, name);
+    App(fname, ".ssa");
+    FileIO.Open(out, fname, TRUE);
+    opened := FileIO.Okay;
+    inBody := FALSE;
+    nTemp := 0;
+    WL("# QBE IR generated by the V3 step-1 backend");
+    WL("")
+  END OpenModule;
+
+PROCEDURE DataLine (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
+  BEGIN
+    IF ~opened THEN RETURN END;
+    W("data $"); W(name);
+    W(" = { w ");
+    W(init);
+    WL(" }")
+  END DataLine;
+
+PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
+  BEGIN
+    (* Step 1 only sees INTEGER; t is reserved for later steps. *)
+    DataLine(name, "0")
+  END DeclVar;
+
+PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
+  BEGIN
+    IF (SymTab.ClassOf(t) = SymTab.ClStr) OR ~IsImm(val) THEN
+      DataLine(name, "0")
+    ELSE
+      DataLine(name, val)
+    END
+  END DeclConst;
+
+(* ---------------- function body ---------------- *)
+
+PROCEDURE BeginBody;
+  BEGIN
+    IF ~opened OR inBody THEN RETURN END;
+    WL("");
+    WL("export function w $main() {");
+    WL("@start");
+    inBody := TRUE
+  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 and operators ---------------- *)
+
+PROCEDURE NewTemp (VAR t: QVal);
+  BEGIN
+    Cpy(t, "%t");
+    AppNum(t, nTemp);
+    INC(nTemp)
+  END NewTemp;
+
+PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
+  BEGIN
+    (* isReal reserved for step 2+; step 1 always passes FALSE. *)
+    NewTemp(q);
+    W("  "); W(q);
+    W(" =w loadw $");
+    WL(name)
+  END LoadVar;
+
+PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
+  BEGIN
+    W("  storew ");
+    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);
+    W(" =w ");
+    W(mn); W(" "); W(l); W(", "); WL(r)
+  END Op3;
+
+PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
+  BEGIN
+    NewTemp(q);
+    Op3("sub", q, "0", a, FALSE)
+  END NegQ;
+
+PROCEDURE Remark (s: ARRAY OF CHAR);
+  BEGIN
+    W("# "); WL(s)
+  END Remark;
+
+BEGIN
+  opened := FALSE;
+  inBody := FALSE;
+  nTemp := 0
+END QbeGen.

compiler/src/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.

compiler/src/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.

compiler/src/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("not supported in step 1 (integers only)")
+        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.

compiler/src/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.

compiler/src/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.

compiler/tests/t_arith.mod

@@ -0,0 +1,6 @@
+MODULE TArith;
+CONST C = 10;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := C + 3 * 4 - 10 DIV 3 + 10H - C
+END TArith.

compiler/tests/t_bad_mismatch.mod

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

compiler/tests/t_bad_undecl.mod

@@ -0,0 +1,4 @@
+MODULE TBadUndecl;
+BEGIN
+  ExitCode := 1
+END TBadUndecl.

compiler/tests/t_exit.mod

@@ -0,0 +1,5 @@
+MODULE TExit;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := 7
+END TExit.

compiler/tests/t_minimal.mod

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

docs/plan.md

@@ -0,0 +1,136 @@
+# m2compiler-V3 — Actual Plan (locked 2026-09-19)
+
+Modern Modula-2 syntax, Coco/R frontend, fresh QBE backend, Blaise-style
+phased process, self-hosting with byte-identical `.ssa` fixpoint.
+
+## 1. Toolchain and dialect
+
+- Frontend: Coco/R (`M2.atg` → scanner/parser/driver), `gm2 -fiso`,
+  `CR -m -C` regeneration, two-phase `gm2 -fgen-module-list` link
+  (proven in V1/V2/Test2).
+- Backend: fresh `QbeGen` emitting QBE SSA text (`.ssa`), then
+  `qbe -o .s` + `cc` link + execute. System `qbe` pinned in
+  `vendor/qbe-pin.txt`.
+- Modern syntax base: PIM4/ISO core + Kowarsch/Redux cleanups —
+  `#` only (no `<>`), `NOT/AND/OR` only (no `~/&`), no `B/C` octal
+  literals, `H` hex kept, unary minus takes a Factor. Evolved from
+  V2 `M2comp.atg` (1290 lines), not pasted verbatim.
+- Test convention (from Test2): global `VAR ExitCode : INTEGER`
+  selects process exit code; otherwise return 0.
+
+## 2. Directory tree (Blaise-adapted)
+
+Blaise (`graemeg/blaise`) uses `compiler/`, `runtime/`, `stdlib/`,
+`tools/migration-analyser/`, `vendor/qbe/`, `docs/`, per-module
+`target/`. V3 port:
+
+```text
+m2compiler-V3/
+  README.md  build.sh  run_tests.sh
+  compiler/src/      M2.atg, compiler.frm, parser.frm, scanner.frm,
+                     FileIO, SymTab, AST, QbeGen, generated M2S/M2P/M2 (gitignored)
+  compiler/tests/    accept / reject (.LST) / run (exit-code) tests
+  runtime/syslib/    SYSTEM, Storage, SysIO, SysClock, Trap, Utf8
+                     always-linked, self-hostable, NO gm2-only imports
+  stdlib/            Strings, TextIO (+U*), WholeIO, Math, Files
+                     opt-in via IMPORT, classic DEFINITION+OPAQUE,
+                     Benjamin-R10 semantics, classic syntax only
+  tools/redux-check/ modern-syntax enforcement helper
+  vendor/qbe-pin.txt
+  bootstrap/         stage1/ (gm2-built), stage2/, stage3/ (V3-built),
+                     fixpoint.sh (rebuild 2x, diff -r *.ssa)
+  docs/              plan.md (this file), spec.md, blaise-phases-map.md,
+                     summary_stepN.md
+```
+
+Build outputs (`.o`, `.ssa`, `.s`, binaries) are never committed.
+
+## 3. Library spec (Benjamin, classic form)
+
+- Semantics follow `Benjamin/Actual/m2bsk-master/r10/stdlib/*.if`
+  (+ blueprints/templates as semantic reference) and `PDFs-master/`.
+- Syntax is classic `DEFINITION/IMPLEMENTATION` + `OPAQUE` only.
+  Explicitly OUT: `INTERFACE MODULE`, `[ProtoX]/[TMIN]` attributes,
+  `PROCEDURE [+]` operator overloads, `.bp/.gen.if` templates.
+- `runtime/syslib` vs `stdlib/` split: syslib is always linked and
+  trivially compilable; stdlib is opt-in via `IMPORT`.
+
+## 4. Phased roadmap
+
+| Step | Goal | Acceptance |
+|------|------|------------|
+| 1 pipeline | minimal `M2.atg` + fresh `QbeGen` hello → `.ssa` → `qbe → cc → run` | 3 run tests |
+| 2 scalars | scalar type system, SymTab errors 200–224 + 230/232/233 (+234 unicode) | ~20 tests |
+| 3 composites | length-prefixed arrays/records/sets/pointers (§5) | layout tests green |
+| 4 modules/procs | DEFINITION/IMPLEMENTATION, opaque `TYPE T;`, nested/display, separate compilation | ADT tests (V2 goal_step8 scope) |
+| 5 stdlib | Strings/TextIO/WholeIO/Math/Files per Benjamin | I/O + file tests |
+| 6 harden | CASE/WITH/LOOP/EXIT/FOR-BY, conversions, traps | full-suite green |
+| 7 syslib port | rewrite FileIO on SysIO+Storage only; ban `Environment, FileSysOp, TextIO, RawIO, WholeIO, IOChan, SysClock, ProgramArgs` via `grep` gate | compiler sources syslib-clean; Stage1 still gm2-built |
+| 8 fixpoint | `bootstrap/fixpoint.sh`: Stage1→Stage2→Stage3, `diff -r` all `.ssa` byte-identical, suite green on all stages | SELF-HOSTED |
+
+Full-language-first: the compiler itself may use the full language;
+self-hosting is the last phase. Hygiene from step 1: deterministic
+`%tN/@LN` counters, sorted symbol emission, no timestamps/paths in
+`.ssa`; restricted `SYSTEM` use (`ADR/TSIZE/BYTE` only).
+
+## 5. Memory rule — length-prefixed arrays & strings (LOCKED)
+
+- Every `ARRAY` value: bytes `0..7` = `LONGCARD` element count
+  (`HIGH-LOW+1`), QBE `l`; bytes `8..` = packed elements.
+- Applies to ALL arrays including fixed `ARRAY [lo..hi]` (bounds still
+  checked statically AND stored at runtime). 8 bytes overhead/array.
+- Multi-dim: each level has its own header (recursive).
+- Records: field offsets include headers (`8 + count*elemSize`).
+- `SYSTEM.TSIZE` on arrays includes the header.
+- Open formal `ARRAY OF T`: single `l` descriptor pointer; callee reads
+  count via `loadl`. No hidden length parameter.
+- Whole-array `:=` requires equal counts, else `Trap.RangeFault`
+  (no silent truncation — safety-perimeter principle).
+- Index `a[i]`: `base + 8 + (i-lo)*elemSize` + runtime `i < lo+count` check.
+- `HIGH(a)`/`LEN(a)`: static for fixed, header read for open.
+- String = `ARRAY OF CHAR` with this header; literals emitted as
+  `data $n = { l count, b ... }`. No trailing NUL; C boundary via
+  `SysIO.ExportCStr` copy.
+- `SYSTEM.BYTE` buffers (`FileIO`, `SymTab.Name`) conform automatically.
+
+## 6. Unicode — UCHAR / UString (LOCKED)
+
+- `UCHAR`: 32-bit codepoint `0..1114111` (QBE `w`). `CHAR` unchanged
+  (8-bit, `0..255`). Distinct types, no implicit mixing.
+- UString = `LONGCARD count (codepoints)` + `count × l codepoints`
+  (prior header rule, element = UCHAR, 4 bytes each).
+- Source files are UTF-8. Identifiers stay ASCII. Coco/R captures
+  literal bytes; `LexUString` action strict-RFC3629-decodes
+  (no overlongs/surrogates/`>10FFFF`/truncation).
+- Literals: `U'..'` / `U".."`; single codepoint `U'a'` → UCHAR,
+  longer/empty → UString. `'a'` ≠ `U'a'`.
+- Invalid UTF-8 in literal → hard lex error `234`, in `.LST`, no `.ssa`.
+- Conversions: `UCHR(c:CHAR):UCHAR` safe; `CHR8(u:UCHAR):CHAR` traps
+  unless `u ≤ 255`; `ORD` 8-bit; new `UORD(u):LONGCARD`.
+- `runtime/syslib/Utf8` (`decode/Encode`, `MaxUTF8Length=4`,
+  `MaxCodePoint=1114111`, cf. Benjamin `Utf8.def`): shared by the
+  lexer (decode) and output libs (encode).
+- `TextIO.UWriteChar/UWriteString/UWriteLn`: encode to UTF-8, emit via
+  `SysIO` byte descriptors. Raw `WriteChar` stays byte-oriented.
+
+## 7. Interactive ATG order (next)
+
+1. `COMPILER M2` header + `CHARACTERS/IGNORE/COMMENTS/TOKENS`
+   (incl. `ustring`, grown `LexString` buffer).
+2. Module / Definition / Implementation / Import (+ opaque hook).
+3. `CONST/TYPE/VAR/ProcHeading` + error codes (200–234).
+4. Types (scalars → UCHAR → composites → proc types).
+5. Statements (IF/CASE/WHILE/REPEAT/LOOP/EXIT/FOR/WITH/RETURN).
+6. Expressions (precedence, `IN`, set/pointer/UCHAR ops).
+7. Action wiring (`SymTab/AST/QbeGen` hooks) + `compiler.frm` driver.
+
+Each section: proposed snippet → user approve/tweak → append to
+`compiler/src/M2.atg` → `CR -m -C` syntax check before moving on.
+Per-section self-host question: "can this cover the compiler's own
+source idioms?".
+
+## 8. Open points for build time
+
+- Exact `U'..'` vs `U".."` spelling confirmation during §1.
+- `stdlib` Phase-5 subset order: `SYSTEM+Strings+TextIO` first?
+- `Trap` exit-code conventions for run tests.

docs/summary_step1.md

@@ -0,0 +1,43 @@
+# V3 step 1 — minimal integer pipeline (done 2026-09-19)
+
+End-to-end: Modula-2 source → Coco/R frontend → SymTab checks →
+fresh QbeGen → `gen_ssa/<Mod>.ssa` → `qbe` → `cc` → native binary
+returning `ExitCode`. Blaise Phase-1 equivalent (bootstrap pipeline).
+
+## Subset
+
+`MODULE` + `CONST` (signed literal) + `VAR .. : INTEGER` +
+assignment + integer expressions (`+ - * DIV MOD`, leading sign,
+parens, `H` hex). Errors: 200/201/202/210/211/221 + step-1 230s
+(REAL/STRING literals, non-INTEGER VAR type, non-literal CONST,
+imported names as values). Grammar is LL(1)-clean
+(`Compilation completed. No errors detected.`); one conflict found
+and fixed during the step (trailing `;` in StatSeq).
+
+## Files
+
+- `compiler/src/M2.atg` (fresh, ~250 lines) — the interactive artefact.
+- `compiler/src/QbeGen.def/.mod` (fresh) — Test2-compatible signatures
+  (`LoadVar/StoreVar/Op3/NegQ` keep `isReal` params) so step 2 grows
+  without ATG rewrites. Deterministic `%tN` counters (fixpoint-safe).
+- Reused proven: `FileIO`, `SymTab` (full Test2 copies),
+  `scanner/parser/compiler.frm` (230 text retargeted to step 1).
+- `compiler/build.sh`, `compiler/run_tests.sh`, 5 tests.
+
+## Results — 5/5
+
+3 run (`t_minimal`→0, `t_exit`→7, `t_arith`→25: precedence, DIV
+truncation, hex `10H`=16, CONST loads) + 2 reject (201 undeclared,
+202 name mismatch). Verified `TArith.ssa` by hand.
+
+## Known step-1 limits (each a later step)
+
+- Assignment targets emit a dead load before the store (valid QBE,
+  inherited Test2 inefficiency).
+- `DIV`/`MOD` are truncating (C/QBE semantics, not Modula-2 floor).
+- No `TYPE`, no procedures, no composites, no `U`-literals —
+  all syntax errors today, 230s where tokens exist (real/string).
+- `gen_ssa/` binaries/logs are build outputs (gitignored).
+
+Next: step 2 (scalar type system: REAL/BOOLEAN/CHAR/enum, relations,
+`IF/WHILE`) reusing the same harness.

docs/summary_step2.md

@@ -0,0 +1,26 @@
+# V3 step 2 — scalar type system (planned)
+
+Status: not started. Blaise Phase-2 equivalent (type system).
+
+## Scope
+
+- Types: `REAL` (QBE `d`), `BOOLEAN` (+ `NOT/AND/OR`), `CHAR`,
+  enumerations; `CARDINAL` family via SymTab integer family.
+- Relations (`= # < <= > >=`) → QBE `ceqw/cnew/csltw/...` + `jnz`;
+  `IF/ELSIF/ELSE`, `WHILE` (labels via `NewLabel/EmitLabel/Jmp/Jnz`
+  added to QbeGen).
+- Mixed INTEGER/REAL rules (Test1 parity: INTEGER assigns to REAL
+  via `swtof`, no mixed arithmetic), 212/213/214 errors.
+- `H` hex + `0x` prefix decision (Redux option) recorded here.
+
+## Acceptance (planned)
+
+- ~15 run tests (bool logic, real arith + conversions, char/enum,
+  IF/WHILE nesting) + reject tests (212/213/214); full suite green.
+- Grammar stays LL(1)-clean; `.ssa` deterministic.
+
+## Files (planned)
+
+- `compiler/src/M2.atg` § types/statements/expressions growth.
+- `compiler/src/QbeGen` + comparison/branch emission.
+- `compiler/tests/` additions; this file filled in on landing.

docs/summary_step3.md

@@ -0,0 +1,29 @@
+# V3 step 3 — composites with length-prefixed layout (planned)
+
+Status: not started.
+
+## Scope (locked memory rule)
+
+Every `ARRAY` = inline `LONGCARD` element count + packed elements;
+all arrays incl. fixed; each multi-dim level has its own header;
+records include headers in field offsets; `SYSTEM.TSIZE` covers
+the header; open formals = single descriptor pointer.
+
+- `ARRAY [lo..hi]`, multi-dim, `RECORD`, `SET`, `POINTER`,
+  `NIL`, whole-array `:=` (equal counts else `Trap.RangeFault`),
+  `HIGH/LEN` (static for fixed, header read for open),
+  index lowering `base+8+(i-lo)*elemSize` + bounds check.
+- `SymTab`: `ElemSize` replaces slot counting; `TypeSlots` retired.
+- `Trap` module introduced (range/NIL faults).
+
+## Acceptance (planned)
+
+Layout tests (§5 of plan.md: fixed header bytes, nested headers,
+record offsets, open-formal HIGH, mismatched-assign trap,
+`SYSTEM.BYTE` I/O round-trip); suite green.
+
+## Files (planned)
+
+- `compiler/src/M2.atg` § types growth; `QbeGen` aggregate emission
+  (`data $n = { l count, ... }`); `runtime/syslib/Trap`.
+- This file filled in on landing.

docs/summary_step4.md

@@ -0,0 +1,25 @@
+# V3 step 4 — procedures, modules, separate compilation (planned)
+
+Status: not started. Blaise multi-file equivalent.
+
+## Scope
+
+- `PROCEDURE` (value/`VAR` params, function results, recursion,
+  nested procedures with display), `RETURN` (232), `EXIT`/`LOOP`,
+  `REPEAT`, `FOR..BY`, `CASE`, `WITH`.
+- `DEFINITION/IMPLEMENTATION` split, opaque `TYPE T;` + completion
+  (V2 goal_step8 scope: usable only behind pointers/`VAR` formals
+  outside the implementation), `IMPORT` name resolution (233).
+- Procedure-type variables deferred to step 6 unless trivial.
+
+## Acceptance (planned)
+
+- ADT tests (counter/stack: New/Free/Use/Count ExitCodes) + rejection
+  tests (client `VAR x:T`, field access, value param, opaque result,
+  completion mismatch); suite green.
+
+## Files (planned)
+
+- `compiler/src/M2.atg` § declarations/statements; `SymTab` scopes;
+  `QbeGen` call frames (C-ABI: first 6 int args regs via QBE auto).
+- This file filled in on landing.

docs/summary_step5.md

@@ -0,0 +1,25 @@
+# V3 step 5 — Benjamin stdlib, classic form (planned)
+
+Status: not started. Blaise RTL/StdLib equivalent.
+
+## Scope
+
+Semantics per `Benjamin/Actual/m2bsk-master/r10/stdlib/*.if`,
+syntax classic `DEFINITION/IMPLEMENTATION` + `OPAQUE` only
+(no `INTERFACE MODULE`, no operator procedures, no blueprints):
+
+- `Strings` (Length/Assign/Extract/Concat/Compare over headers),
+  `TextIO` (+ `UWriteChar/UWriteString/UWriteLn`),
+  `WholeIO`, `Math` (→ libc), `Files` (over `SysIO`).
+- `SysIO.ExportCStr` for the NUL-at-boundary rule.
+
+## Acceptance (planned)
+
+- I/O + file round-trip tests (output bytes compared, not just
+  exit codes); `UWriteString` output byte-identical to source
+  UTF-8 literal; suite green.
+
+## Files (planned)
+
+- `stdlib/*`; `compiler/tests/` I/O tests.
+- This file filled in on landing.

docs/summary_step6.md

@@ -0,0 +1,26 @@
+# V3 step 6 — QBE harden + unicode (planned)
+
+Status: not started.
+
+## Scope
+
+- Close every construct gap between "test language" and "compiler
+  language": procedure types + indirect calls (needs QBE `call`
+  through register + frame design spike first), `LONGINT` quads,
+  set ops full lowering, `WITH`-field `VAR` actuals.
+- Unicode (locked): `UCHAR` 32-bit codepoint, UString =
+  `LONGCARD` count + codepoints, `U'..'/U".."` literals,
+  strict-RFC3629 `LexUString` (bad bytes → lex error 234),
+  `UCHR/CHR8/UORD`, `Utf8` syslib shared by lexer + output libs.
+
+## Acceptance (planned)
+
+- `U'é'`→`w 233`, overlong/surrogate/`>10FFFF`/truncated → 234,
+  `CHR8(U'€')` traps, UString index/assign/HIGH = array rules,
+  round-trip byte-identity; suite green.
+
+## Files (planned)
+
+- `compiler/src/M2.atg` (`ustring` token, grown `LexString` buffer);
+  `runtime/syslib/Utf8`; `QbeGen` UString `data` emission.
+- This file filled in on landing.

docs/summary_step7.md

@@ -0,0 +1,25 @@
+# V3 step 7 — syslib port (planned, required for self-hosting)
+
+Status: not started.
+
+## Scope
+
+- Rewrite compiler-owned `FileIO` on `SysIO+Storage` only; ban
+  gm2-only imports (`Environment, FileSysOp, TextIO, RawIO,
+  WholeIO, IOChan, SysClock, ProgramArgs`) from ALL compiler
+  sources; `grep` gate in `run_tests.sh` fails the suite on any
+  occurrence.
+- `runtime/syslib`: `SYSTEM` (ADR/TSIZE/BYTE), `Storage`
+  (malloc/free), `SysIO` (open/read/write/argv/exit),
+  `SysClock` stub, `Trap`, `Utf8`.
+- Stage1 remains gm2-built, but sources are syslib-clean.
+
+## Acceptance (planned)
+
+- Full suite green with syslib-only sources; `grep` gate clean.
+
+## Files (planned)
+
+- `runtime/syslib/*`; ported `compiler/src/FileIO`;
+  `bootstrap/stage1/` notes.
+- This file filled in on landing.

docs/summary_step8.md

@@ -0,0 +1,22 @@
+# V3 step 8 — self-hosting fixpoint (planned, done criterion)
+
+Status: not started.
+
+## Scope
+
+- `bootstrap/fixpoint.sh`: Stage1 (gm2-built M2) compiles all
+  compiler+syslib sources → Stage2 binary; Stage2 recompiles →
+  Stage3; `diff -r` all generated `.ssa` must be byte-identical;
+  full suite green on all three stages.
+- Preconditions: deterministic emission (sorted symbols, stable
+  `%tN/@LN`, no timestamps/paths), hygiene rules from step 1.
+
+## Acceptance (planned)
+
+- Stage2 vs Stage3 `.ssa` byte-identical; 3-stage suite green.
+  → SELF-HOSTED. Later (deferred): debug line-maps, LSP/tools.
+
+## Files (planned)
+
+- `bootstrap/fixpoint.sh`, `stage1/2/3/` (gitignored binaries).
+- This file filled in on landing.

vendor/qbe-pin.txt

@@ -0,0 +1,11 @@
+# Pinned backend toolchain (step 1, 2026-09-19)
+
+- qbe: /usr/local/bin/qbe, default target amd64_sysv
+  (`qbe -h` offers amd64_sysv/amd64_apple/arm64/arm64_apple/rv64)
+- cc: Debian 14.2.0-19 (assembler+linker for qbe output)
+- gm2 (host compiler): GCC 16.0.1 experimental 20260325, flags `-fiso`
+- Coco/R: CR V1.53 (Pat Terry, 2002), flags `-m -C`, `CRFRAMES=src/`
+
+Re-verify with: `qbe -h`, `cc --version`, `gm2 --version`.
+Self-host fixpoint (step 8) is defined over `.ssa` bytes; any qbe/cc
+upgrade must keep the full suite green before updating this pin.