Linker: write a real DOS .COM, and verify the bytes independently

The compiler now produces a whole image, so there is nothing to relocate.
Linking means: pad the file so the data area exists, and write it as a .COM.

Why padding is needed at all, which is the non-obvious part: the globals live
at Compiler.DataBase = rtSz + 1000H, which for a small program is ~4 KiB past
the last code byte.  They are read and written by absolute address, so those
bytes have to be in the file - a .COM shorter than the data area leaves the
first read of a global reading whatever the loader left there.  The gap is
zero-filled, which is also what makes it safe: a .COM's stack lives at the TOP
of the segment (DOS gives SS=SP=CS:FFFE), so code and data both have to stay
well below it.

Linker.def/-mod expose LinkSize and WriteCom.  WriteCom unlinks a partial
file on any error, so a half-written .COM can never be mistaken for a good one.

tests/ComTest.mod links every fixture and reads each .COM back, reporting the
file size, the image size, the data size, and the number of non-zero bytes in
the code/data gap.  tests/run_com_tests.sh then re-verifies the bytes with a
Python pass that RESTATES the layout constants (rtSz=385, dataBase=rtSz+1000H,
initmem's first 8 bytes) instead of asking the code under test what the answer
is - ComTest computes its expectations from the same Compiler state it is
testing, so a compiler bug would be invisible to it.  It checks the runtime's
first bytes, the file size against dataBase+data, a fully zero gap, and all
four program-header words.

Result: 24 .COM files linked, all 24 pass the independent check.

The checker is verified non-vacuous by deliberately breaking the code twice:

  * padByte := 0FFH instead of 0  -> 24/24 fail, ~4050 non-zero gap bytes
  * pc := 0 instead of pc := rt   -> 24/24 fail, and the failure names the
    real cause ("runtime not at offset 0, first bytes 01 00 3A 00 ...") rather
    than just a symptom.  Note that ComTest ITSELF still reported
    nonzeroInGap=0 in that second case, because a short image leaves a short
    gap: the independent pass is what caught it, which is the argument for
    having one.

Two bugs found by running, both silent:

- Linker.ZCopy's first formal was `dst : ARRAY OF CHAR` with no VAR.  A
  non-VAR open array is a COPY, so every write landed in the copy and
  WriteCom then created a file named after whatever garbage was in the
  caller's buffer.  The symptom was a 4485-byte file named "END" - adjacent
  string data - with the right size and the right contents in the wrong file.
  tests/OpenArrTest.mod measures the three variants (VAR open array writes
  back, non-VAR does not, fixed-array VAR does) so the rule is recorded as a
  run rather than as a belief.

- The first version of the independent checker was itself wrong twice, in
  ways that would have made it either useless or falsely red: it looked for
  the .COM under the full source path when ComTest writes by basename, and it
  compared hdrCS against rtSz+image when `image` already includes the runtime
  - counting it twice.  It also contained a tautology
  (`RTSZ + image != DATAB - 0x1000 + image` with an empty body) which is
  always false and asserted nothing; removed rather than left to look like a
  check.

gm2 notes hit: a .def present means the .mod needs IMPLEMENTATION; ISO will not
assign the ZType to an array (hence a scalar padByte, since an uninitialised
filler byte would be a global starting as garbage); and the missing-semicolon
trap again, this time after dst [j + 2] := "O".

Still not executable.  CmdCompile does not call WriteCom, CmdRun is a stub,
and no 8086 executor on this machine has yet proved trustworthy.  The .COM
files are structurally correct and nothing has run one.

shell/Linker.def

@@ -0,0 +1,21 @@
+DEFINITION MODULE Linker ;
+
+(* Linker and .COM writer.
+
+   The compiler already emits a whole image - the runtime at offset 0, the
+   program after it - so there is nothing to relocate.  "Linking" means
+   padding the file so the program's data area exists, and writing it as a
+   DOS .COM, which loads at CS:0100. *)
+
+FROM SYSTEM IMPORT BYTE ;
+
+PROCEDURE LinkSize () : CARDINAL ;
+(* Size the .COM must be: the image padded out to cover the whole data area.
+   Usually larger than Compiler.ImageBytes, because the data base is a fixed
+   4 KiB above the code. *)
+
+PROCEDURE WriteCom (path : ARRAY OF CHAR) : BOOLEAN ;
+(* Write the linked image to `path`.  FALSE on failure, and the partial file
+   is removed so it cannot be mistaken for a good one. *)
+
+END Linker.

shell/Linker.mod

@@ -0,0 +1,139 @@
+IMPLEMENTATION MODULE Linker ;
+
+(* Linker and .COM writer for TP3-compiled programs.
+
+   The compiler has already produced the whole image - Runtime is copied to
+   offset 0 of the code buffer and the program follows it, so every address in
+   the image is already absolute (see Compiler.Inittur).  There is therefore
+   no relocation to do: "linking" here means
+
+     1. pad the image so the data area exists, and
+     2. write it out as a DOS .COM file.
+
+   Why padding is needed at all: a .COM file is loaded at CS:0100 with the
+   whole 64 KiB segment available, but the program's globals live at
+   Compiler.DataBase = rtSz + 1000H, which for a small program is far past
+   the last code byte.  Those globals are read and written by absolute
+   address, so the bytes have to be present in the file.  The gap between
+   code and data is zero-filled, which is also what makes it safe: a .COM's
+   stack lives at the TOP of the segment (DOS gives a .COM SS=SP=CS:FFFE), so
+   code and data both have to stay well below it.  A 4 KiB gap keeps them
+   apart for programs up to 4 KiB of code, which is the documented limit.
+
+   Faithfulness note: the original did this in the compiler's overlay loader
+   (TPSRC7 opendest) and wrote a .COM from a different buffer layout with a
+   larger header served by the overlay segment.  Our header is our own - see
+   Runtime.EmitInitMem - and the file layout is the same idea, smaller. *)
+
+FROM SYSTEM IMPORT BYTE, ADR ;
+
+FROM Posix IMPORT open, write, close, unlink ;
+
+FROM Compiler IMPORT ImageBytes, ImageByteAt, DataBase, DataBytes ;
+
+CONST
+   O_WRONLY = 1 ;
+   O_CREAT  = 64 ;
+   O_TRUNC  = 512 ;
+
+VAR
+   padByte : BYTE ;             (* the filler for the code/data gap *)
+
+PROCEDURE DropCh (v : CHAR) ;
+BEGIN
+END DropCh ;
+
+PROCEDURE DropB (v : BOOLEAN) ;
+BEGIN
+END DropB ;
+
+PROCEDURE DropC (v : CARDINAL) ;
+BEGIN
+END DropC ;
+
+PROCEDURE ZCopy (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
+(* Copy into a NUL-terminated buffer.  The C bindings take a plain ADDRESS, so
+   the string must be terminated in OUR buffer - passing the caller's
+   unbounded array straight through would pass a pointer to whatever followed
+   it.
+
+   The VAR is load-bearing, and was found by running: without it the formal is
+   a COPY, the writes land in the copy, and the caller writes to whatever
+   garbage was in its buffer.  The symptom was a .COM file named "END" -
+   adjacent string data - created with the right size and the right contents
+   in the wrong file.  tests/OpenArrTest.mod measures the three variants. *)
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
+      dst [i] := src [i] ;
+      INC (i)
+   END ;
+   dst [i] := 0C
+END ZCopy ;
+
+PROCEDURE LinkSize () : CARDINAL ;
+(* Size of the linked file in bytes: the image, padded out to cover the whole
+   data area.  This is what a .COM must be, and it is larger than
+   Compiler.ImageBytes whenever the program declares no globals, because the
+   data base is a fixed 4 KiB above the code. *)
+BEGIN
+   IF DataBase () + DataBytes () > ImageBytes () THEN
+      RETURN DataBase () + DataBytes ()
+   END ;
+   RETURN ImageBytes ()
+END LinkSize ;
+
+PROCEDURE MakePad () ;
+BEGIN
+   (* A local array is not required to be zeroed, and relying on it would be
+      a silent-corruption bug: an uninitialised pad byte would appear in the
+      middle of a program's data area.  ISO will not let an array be assigned
+      the ZType, so the filler is a single explicit BYTE. *)
+   padByte := 0
+END MakePad ;
+
+PROCEDURE WriteCom (path : ARRAY OF CHAR) : BOOLEAN ;
+(* Write the linked image to `path` as a DOS .COM.  Returns TRUE on success;
+   on failure the file is removed, so a half-written .COM is never left
+   behind to be mistaken for a good one. *)
+VAR fd : INTEGER ;
+    n  : LONGINT ;
+    i, total, chunk : CARDINAL ;
+    buf : ARRAY [0..255] OF BYTE ;
+    z   : ARRAY [0..511] OF CHAR ;
+BEGIN
+   MakePad ;
+   ZCopy (z, path) ;
+   total := LinkSize () ;
+   fd := open (ADR (z), O_WRONLY + O_CREAT + O_TRUNC, 420) ;
+   IF fd < 0 THEN
+      RETURN FALSE
+   END ;
+   i := 0 ;
+   WHILE i < total DO
+      chunk := 0 ;
+      WHILE (chunk < 256) AND (i + chunk < total) DO
+         IF i + chunk < ImageBytes () THEN
+            buf [chunk] := ImageByteAt (i + chunk)
+         ELSE
+            buf [chunk] := padByte            (* the gap before the data *)
+         END ;
+         INC (chunk)
+      END ;
+      n := write (fd, ADR (buf), chunk) ;
+      IF n # VAL (LONGINT, chunk) THEN
+         DropC (VAL (CARDINAL, close (fd))) ;
+         DropB (unlink (ADR (z)) = 0) ;
+         RETURN FALSE
+      END ;
+      i := i + chunk
+   END ;
+   IF close (fd) # 0 THEN
+      DropB (unlink (ADR (z)) = 0) ;
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END WriteCom ;
+
+END Linker.

shell/tests/ComTest.mod

@@ -0,0 +1,366 @@
+MODULE ComTest ;
+
+(* Builds the linked .COM for fixtures and checks it, so the linker is tested
+   by running it rather than by "it compiled".
+
+   Reads fixture paths from stdin like CompileTest, and for each one prints
+
+       <path>  OK  com=<bytes>  image=<bytes>  data=<bytes>
+
+   plus, under @hex, the first bytes and the bytes around the code/data
+   boundary - the two places where a linker bug would show up.
+
+   What is actually being asserted, and why these bytes:
+
+     * the file must be LinkSize bytes, i.e. padded past the code to cover
+       the data area.  A .COM shorter than the data area leaves the globals
+       outside the file, so the first read of a global reads whatever the
+       loader happened to leave there.
+
+     * the file's byte 0 must be the runtime's first byte (8B C0 = MOV AX,AX,
+       the head of initmem).  If it is not, the runtime was not prepended and
+       every CALL target is wrong.
+
+     * the bytes from ImageBytes to the end must be ZERO.  That gap is what
+       the program's globals live in, so an uninitialised filler byte would
+       be a global that starts as garbage.
+
+   The @hex dump is the last line of defence: it is what caught the header
+   words being written with a nibble shift instead of a byte shift. *)
+
+FROM Posix IMPORT read, write, open, close ;
+FROM TextBuf IMPORT TextLimit, Clear, Length, CharAt, InsertCh ;
+FROM Compiler IMPORT Compile, CodeBytes, DataBytes, ImageBytes, ImageByteAt, DataBase ;
+FROM Linker IMPORT LinkSize, WriteCom ;
+FROM SYSTEM IMPORT ADR, BYTE ;
+
+CONST
+   STDIN = 0 ;
+   STDOUT = 1 ;
+   O_RDONLY = 0 ;
+   O_RDONLY_RB = 0 ;
+
+TYPE
+   PathBuf = ARRAY [0..511] OF CHAR ;
+
+VAR
+   lineBuf  : ARRAY [0..255] OF CHAR ;
+   pathCopy : PathBuf ;
+   outPath  : PathBuf ;
+   hexMode  : BOOLEAN ;
+   hexOn    : BOOLEAN ;
+
+PROCEDURE PutCh (ch : CHAR) ;
+VAR n : LONGINT ;
+BEGIN
+   n := write (STDOUT, ADR (ch), 1)
+END PutCh ;
+
+PROCEDURE PutStr (s : ARRAY OF CHAR) ;
+VAR i : CARDINAL ; n : LONGINT ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
+      n := write (STDOUT, ADR (s [i]), 1) ;
+      INC (i)
+   END
+END PutStr ;
+
+PROCEDURE PutCard (n : CARDINAL) ;
+VAR dig : ARRAY [0..9] OF CHAR ; i : CARDINAL ;
+BEGIN
+   IF n = 0 THEN
+      PutCh ("0")
+   ELSE
+      i := 0 ;
+      WHILE n > 0 DO
+         dig [i] := CHR (ORD ("0") + (n MOD 10)) ;
+         n := n DIV 10 ;
+         INC (i)
+      END ;
+      WHILE i > 0 DO
+         DEC (i) ;
+         PutCh (dig [i])
+      END
+   END
+END PutCard ;
+
+PROCEDURE NL ;
+BEGIN
+   PutCh (CHR (13)) ; PutCh (CHR (10))
+END NL ;
+
+PROCEDURE Hex (b : BYTE ; VAR out : ARRAY OF CHAR) ;
+VAR d : CARDINAL ;
+BEGIN
+   d := VAL (CARDINAL, b) DIV 16 ;
+   IF d < 10 THEN
+      out [0] := CHR (ORD ("0") + d)
+   ELSE
+      out [0] := CHR (ORD ("A") + d - 10)
+   END ;
+   d := VAL (CARDINAL, b) MOD 16 ;
+   IF d < 10 THEN
+      out [1] := CHR (ORD ("0") + d)
+   ELSE
+      out [1] := CHR (ORD ("A") + d - 10)
+   END
+END Hex ;
+
+PROCEDURE PutHexNib (d : CARDINAL) ;
+VAR c : CHAR ;
+BEGIN
+   IF d < 10 THEN
+      c := CHR (ORD ("0") + d)
+   ELSE
+      c := CHR (ORD ("A") + d - 10)
+   END ;
+   PutCh (c)
+END PutHexNib ;
+
+PROCEDURE PutCardHex4 (n : CARDINAL) ;
+VAR d : CARDINAL ;
+BEGIN
+   d := 4096 ;
+   WHILE d > 0 DO
+      PutHexNib ((n DIV d) MOD 16) ;
+      d := d DIV 16
+   END ;
+   PutStr (":  ")
+END PutCardHex4 ;
+
+PROCEDURE StrCopy (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (dst)) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
+      dst [i] := src [i] ;
+      INC (i)
+   END ;
+   IF i <= HIGH (dst) THEN
+      dst [i] := 0C
+   END
+END StrCopy ;
+
+PROCEDURE AppStr (VAR dst : ARRAY OF CHAR ; s : ARRAY OF CHAR ) ;
+VAR i, j : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (dst)) AND (dst [i] # 0C) DO
+      INC (i)
+   END ;
+   j := 0 ;
+   WHILE (j <= HIGH (s)) AND (s [j] # 0C) AND (i <= HIGH (dst)) DO
+      dst [i] := s [j] ;
+      INC (i) ; INC (j)
+   END ;
+   IF i <= HIGH (dst) THEN
+      dst [i] := 0C
+   END
+END AppStr ;
+
+PROCEDURE ReadLineStr (VAR s : ARRAY OF CHAR) : BOOLEAN ;
+VAR ch : CHAR ; n : LONGINT ; i : CARDINAL ;
+BEGIN
+   i := 0 ; s [0] := 0C ;
+   LOOP
+      n := read (STDIN, ADR (ch), 1) ;
+      IF n # 1 THEN
+         IF i = 0 THEN RETURN FALSE END ;
+         s [i] := 0C ; RETURN TRUE
+      END ;
+      IF (ch = CHR (10)) OR (ch = CHR (13)) THEN
+         IF i = 0 THEN RETURN FALSE END ;
+         s [i] := 0C ; RETURN TRUE
+      END ;
+      IF i < HIGH (s) THEN
+         s [i] := ch ; INC (i)
+      END
+   END
+END ReadLineStr ;
+
+PROCEDURE LoadFile (p : ARRAY OF CHAR) : BOOLEAN ;
+(* same CR/LF normalisation as the shell's LoadWorkFile *)
+VAR fd : INTEGER ; k : LONGINT ; b : BYTE ; prevCR : BOOLEAN ;
+    z : ARRAY [0..511] OF CHAR ;
+BEGIN
+   StrCopy (z, p) ;
+   fd := open (ADR (z), O_RDONLY, 0) ;
+   IF fd < 0 THEN
+      RETURN FALSE
+   END ;
+   Clear ;
+   prevCR := FALSE ;
+   LOOP
+      IF Length () >= TextLimit THEN EXIT END ;
+      k := read (fd, ADR (b), 1) ;
+      IF k # 1 THEN EXIT END ;
+      IF b = 26 THEN
+         EXIT
+      ELSIF b = 10 THEN
+         IF NOT prevCR THEN InsertCh (Length (), CHR (13)) END ;
+         prevCR := FALSE
+      ELSIF b = 13 THEN
+         InsertCh (Length (), CHR (13)) ;
+         prevCR := TRUE
+      ELSE
+         InsertCh (Length (), CHR (ORD (b))) ;
+         prevCR := FALSE
+      END
+   END ;
+   k := close (fd) ;
+   RETURN TRUE
+END LoadFile ;
+
+(* ---- reading the .COM back ---------------------------------------- *)
+
+VAR
+   fbuf  : ARRAY [0..65535] OF BYTE ;
+   fsize : CARDINAL ;
+
+PROCEDURE ReadCom (p : ARRAY OF CHAR) : BOOLEAN ;
+VAR fd : INTEGER ; k : LONGINT ; z : ARRAY [0..511] OF CHAR ;
+BEGIN
+   StrCopy (z, p) ;
+   fd := open (ADR (z), O_RDONLY, 0) ;
+   IF fd < 0 THEN
+      RETURN FALSE
+   END ;
+   fsize := 0 ;
+   LOOP
+      IF fsize > 65535 THEN EXIT END ;
+      k := read (fd, ADR (fbuf [fsize]), 65535 - fsize) ;
+      IF k <= 0 THEN EXIT END ;
+      fsize := fsize + VAL (CARDINAL, k)
+   END ;
+   k := close (fd) ;
+   RETURN TRUE
+END ReadCom ;
+
+PROCEDURE DumpAt (at, cnt : CARDINAL) ;
+VAR i, n : CARDINAL ; hx : ARRAY [0..1] OF CHAR ;
+BEGIN
+   PutStr ("        " ) ;
+   PutCardHex4 (at) ;
+   n := 0 ;
+   WHILE (n < cnt) AND (at + n < fsize) DO
+      Hex (fbuf [at + n], hx) ;
+      PutCh (hx [0]) ; PutCh (hx [1]) ; PutCh (" ") ;
+      INC (n)
+   END ;
+   NL
+END DumpAt ;
+
+(* Count non-zero bytes in [a,b) - the gap between the code and the data must
+   be entirely zero, or a program's globals start as garbage. *)
+PROCEDURE NonZero (a, b : CARDINAL) : CARDINAL ;
+VAR i, k : CARDINAL ;
+BEGIN
+   k := 0 ; i := a ;
+   WHILE (i < b) AND (i < fsize) DO
+      IF fbuf [i] # 0 THEN
+         k := k + 1
+      END ;
+      INC (i)
+   END ;
+   RETURN k
+END NonZero ;
+
+PROCEDURE BaseName (src : PathBuf ; VAR dst : PathBuf) ;
+(* the fixture's own name, so the .COM lands beside us as NAME.COM rather
+   than trying to graft a directory onto the source path.
+
+   FIXED array formals, not open ones: with `VAR dst : ARRAY OF CHAR` the
+   write did not reach the caller's buffer at all, so the .COM was written to
+   a file named after whatever garbage was in the destination - literally
+   "END", taken from adjacent string data.  An open-array VAR formal is not
+   worth the subtlety in a test harness. *)
+VAR i, j, last : CARDINAL ;
+BEGIN
+   i := 0 ; j := 0 ; last := 0 ;
+   WHILE (i <= HIGH (src)) AND (src [i] # 0C) DO
+      IF src [i] = "/" THEN
+         last := i + 1
+      END ;
+      INC (i)
+   END ;
+   i := last ;
+   WHILE (i <= HIGH (src)) AND (src [i] # 0C) AND (j <= HIGH (dst)) DO
+      dst [j] := src [i] ;
+      INC (i) ; INC (j)
+   END ;
+   (* drop the .pas and add .COM *)
+   IF j > 4 THEN
+      IF (dst [j - 4] = ".") AND (dst [j - 3] = "p") AND (dst [j - 2] = "a")
+         AND (dst [j - 1] = "s") THEN
+         j := j - 4
+      END
+   END ;
+   IF j + 4 <= HIGH (dst) THEN
+      dst [j] := "." ; dst [j + 1] := "C" ; dst [j + 2] := "O" ;
+      dst [j + 3] := "M" ; dst [j + 4] := 0C
+   END
+END BaseName ;
+
+PROCEDURE IsHexCmd () : BOOLEAN ;
+VAR i : CARDINAL ;
+BEGIN
+   IF lineBuf [0] # "@" THEN RETURN FALSE END ;
+   i := 0 ;
+   WHILE (i <= HIGH (lineBuf)) AND (lineBuf [i] # 0C) DO INC (i) END ;
+   IF i # 4 THEN RETURN FALSE END ;
+   RETURN (lineBuf [1] = "h") AND (lineBuf [2] = "e") AND (lineBuf [3] = "x")
+END IsHexCmd ;
+
+VAR
+   errNo, errPos : CARDINAL ;
+   ok : BOOLEAN ;
+   zout : PathBuf ;
+   nz : CARDINAL ;
+
+BEGIN
+   PutStr ("FIXTURE  RESULT") ;
+   NL ;
+   WHILE ReadLineStr (lineBuf) DO
+      IF IsHexCmd () THEN
+         hexOn := TRUE
+      ELSE
+         StrCopy (pathCopy, lineBuf) ;
+         IF LoadFile (pathCopy) THEN
+            ok := Compile (errNo, errPos) ;
+            IF ok THEN
+               BaseName (pathCopy, zout) ;
+               IF WriteCom (zout) THEN
+                  IF ReadCom (zout) THEN
+                     nz := NonZero (ImageBytes (), fsize) ;
+                     PutStr (lineBuf) ;
+                     PutStr ("  OK  com=") ;
+                     PutCard (fsize) ;
+                     PutStr (" image=") ;
+                     PutCard (ImageBytes ()) ;
+                     PutStr (" data=") ;
+                     PutCard (DataBytes ()) ;
+                     PutStr (" nonzeroInGap=") ;
+                     PutCard (nz) ;
+                     NL ;
+                     IF hexOn THEN
+                        DumpAt (0, 16) ;              (* runtime head *)
+                        DumpAt (ImageBytes () - 16, 16) ;  (* code tail *)
+                        DumpAt (ImageBytes (), 16)     (* the gap *)
+                     END
+                  ELSE
+                     PutStr (lineBuf) ; PutStr ("  CANNOT READ BACK") ; NL
+                  END
+               ELSE
+                  PutStr (lineBuf) ; PutStr ("  WRITE_COM_FAILED") ; NL
+               END
+            ELSE
+               PutStr (lineBuf) ; PutStr ("  ERROR ") ;
+               PutCard (errNo) ; PutStr (" at pos ") ; PutCard (errPos) ; NL
+            END
+         ELSE
+            PutStr (lineBuf) ; PutStr ("  CANNOT OPEN") ; NL
+         END
+      END
+   END
+END ComTest.

shell/tests/OpenArrTest.mod

@@ -0,0 +1,90 @@
+MODULE OpenArrTest ;
+
+(* Minimal probe: do open-array formals actually propagate writes back to the
+   caller's buffer under gm2 -fiso?  Linker.WriteCom builds its path with
+   ZCopy(dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) and the file it created
+   was named "END" - i.e. the destination buffer was never written.  Before
+   working around it, measure it.
+
+   Prints what each variant leaves in its buffer, so the answer is a run and
+   not an opinion. *)
+
+FROM Posix IMPORT write ;
+FROM SYSTEM IMPORT ADR ;
+
+PROCEDURE PutStr (s : ARRAY OF CHAR) ;
+VAR i : CARDINAL ; n : LONGINT ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
+      n := write (1, ADR (s [i]), 1) ;
+      INC (i)
+   END
+END PutStr ;
+
+PROCEDURE NL ;
+VAR n : LONGINT ; c : ARRAY [0..1] OF CHAR ;
+BEGIN
+   c [0] := CHR (13) ; c [1] := CHR (10) ;
+   n := write (1, ADR (c), 2)
+END NL ;
+
+(* open array, value formal *)
+PROCEDURE FillOpen (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
+      dst [i] := src [i] ;
+      INC (i)
+   END ;
+   dst [i] := 0C
+END FillOpen ;
+
+(* open array, no VAR - forces a copy, so writes cannot escape *)
+PROCEDURE FillOpenVal (dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
+      dst [i] := src [i] ;
+      INC (i)
+   END ;
+   dst [i] := 0C
+END FillOpenVal ;
+
+TYPE
+   Buf = ARRAY [0..63] OF CHAR ;
+
+(* fixed array, VAR formal *)
+PROCEDURE FillFixed (VAR dst : Buf ; src : Buf) ;
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
+      dst [i] := src [i] ;
+      INC (i)
+   END ;
+   dst [i] := 0C
+END FillFixed ;
+
+VAR
+   a, b, c : Buf ;
+   src     : Buf ;
+
+BEGIN
+   (* seed src *)
+   src [0] := "A" ; src [1] := "B" ; src [2] := "C" ; src [3] := 0C ;
+
+   a := "XXXXXXXXXXXXXXXX" ;
+   FillOpen (a, src) ;
+   PutStr ("FillOpen   (VAR dst : ARRAY OF CHAR) -> [") ; PutStr (a) ; PutStr ("]") ; NL ;
+
+   b := "XXXXXXXXXXXXXXXX" ;
+   FillOpenVal (b, src) ;
+   PutStr ("FillOpenVal(dst  : ARRAY OF CHAR) -> [") ; PutStr (b) ; PutStr ("]") ; NL ;
+
+   c := "XXXXXXXXXXXXXXXX" ;
+   FillFixed (c, src) ;
+   PutStr ("FillFixed  (VAR dst : Buf)       -> [") ; PutStr (c) ; PutStr ("]") ; NL
+END OpenArrTest.

shell/tests/run_com_tests.sh

@@ -0,0 +1,139 @@
+#!/bin/bash
+# Build and run the .COM linker harness (tests/ComTest.mod), then verify every
+# .COM it produced with an INDEPENDENT checker.
+#
+# The independent pass matters: ComTest computes the expectations from the same
+# Compiler state it is testing, so a bug in the compiler would be invisible to
+# it.  The Python pass re-derives what the file must contain - the runtime's
+# first bytes, a zero gap, a size that covers the data area - from the
+# constants only, and cross-checks.
+set -u
+D=/home/eric/Projets/Projets-Modula2/MyWork/TP3-comp/shell
+GM2=/home/eric/bin/Modula2/Gm2/bin/gm2
+cd "$D" || exit 9
+FLAGS="-fiso"
+
+echo "== support modules =="
+[ -f Posix.o ] || cc -c Posix.c || exit 1
+for m in TextBuf Compiler Runtime Linker; do
+   $GM2 $FLAGS -c $m.mod >/tmp/cm_c_$m 2>&1 \
+      || { echo "COMPILE_FAIL $m"; grep -m5 "error:" /tmp/cm_c_$m; exit 1; }
+done
+$GM2 $FLAGS -c tests/ComTest.mod >/tmp/cm_c_ComTest 2>&1 \
+   || { echo "COMPILE_FAIL ComTest"; grep -m5 "error:" /tmp/cm_c_ComTest; exit 1; }
+
+rm -f tests/ct.lst comtest
+$GM2 $FLAGS -fgen-module-list=tests/ct.lst -o /dev/null \
+    tests/ComTest.mod TextBuf.o Posix.o Compiler.o Runtime.o Linker.o \
+    >/tmp/cm_p1 2>&1
+p1=$?
+$GM2 $FLAGS -fuse-list=tests/ct.lst -o comtest \
+    tests/ComTest.mod TextBuf.o Posix.o Compiler.o Runtime.o Linker.o \
+    >/tmp/cm_p2 2>&1
+p2=$?
+if [ $p2 -ne 0 ]; then
+   echo "LINK_FAIL p1_rc=$p1 p2_rc=$p2"
+   grep -E "error:|undefined" /tmp/cm_p2 | head -10
+   exit 1
+fi
+echo "comtest built (p1_rc=$p1, phase 1 rc=1 is the expected rollup)"
+
+# .COM files are written beside the harness, so run it in a scratch dir
+OUT=$(mktemp -d) || exit 9
+trap 'rm -rf "$OUT"' EXIT
+cd "$OUT" || exit 9
+
+ls "$D"/tests/fixtures/*.pas | "$D"/comtest > "$OUT/raw.txt" 2>&1
+sed 's/^.*fixtures\///' "$OUT/raw.txt"
+
+echo "----------------------------------------------------------------"
+nok=$(grep -c "  OK  com=" "$OUT/raw.txt")
+nerr=$(grep -c "  ERROR " "$OUT/raw.txt")
+nbad=$(grep -cE "WRITE_COM_FAILED|CANNOT" "$OUT/raw.txt")
+echo "linked: $nok .COM files, $nerr fixtures rejected at compile time, $nbad harness failures"
+
+if [ "$nbad" -ne 0 ]; then
+   echo "RESULT: FAIL (harness could not link every compiling fixture)"
+   exit 1
+fi
+
+# ---- independent verification of the bytes on disk ------------------------
+python3 - "$OUT" <<'PYEOF'
+import sys, os, re, glob
+out = sys.argv[1]
+
+# Compiler layout constants, restated here on purpose: the checker must not
+# ask the code under test what the answer is.
+RTSZ  = 385                    # Runtime.RT_Size()
+DATAB = RTSZ + 0x1000         # Compiler: data base = rtSz + 1000H
+# initmem: MOV AX,AX / MOV DX,[SI+4] / MOV CX,[SI+8]
+HEAD  = '8B C0 8B 54 04 8B 4C 08'
+
+raw = open(os.path.join(out, 'raw.txt')).read()
+rows = re.findall(r'(\S+\.pas)\s+OK\s+com=(\d+)\s+image=(\d+)\s+data=(\d+)\s+nonzeroInGap=(\d+)', raw)
+if not rows:
+    print('RESULT: FAIL (no linked fixtures found in output)')
+    sys.exit(1)
+
+bad = 0
+for name, com, image, data, nzg in rows:
+    com, image, data, nzg = int(com), int(image), int(data), int(nzg)
+    # ComTest writes the .COM by BASENAME beside itself (it cannot graft a
+    # directory onto a source path), so the checker must look for the bare
+    # name, not the full source path the fixture was read from.
+    path = os.path.join(out, os.path.basename(name)[:-4] + '.COM')
+    errs = []
+    if not os.path.exists(path):
+        errs.append('no .COM file')
+        d = b''
+    else:
+        d = open(path, 'rb').read()
+
+    if d[:8].hex(' ').upper() != HEAD:
+        errs.append('runtime not at offset 0 (first bytes %s)' % d[:8].hex(' ').upper())
+    if len(d) != com:
+        errs.append('file is %d bytes, harness said %d' % (len(d), com))
+    if DATAB + data != len(d):
+        errs.append('size %d != dataBase+data %d' % (len(d), DATAB + data))
+    # the gap between the image and the data area must be entirely zero
+    gap = d[image:DATAB]
+    if any(gap):
+        errs.append('%d non-zero bytes in the code/data gap' % sum(1 for b in gap if b))
+    if nzg != 0:
+        errs.append('harness itself reported %d non-zero gap bytes' % nzg)
+    # the program must start exactly where the runtime ends
+    if image < RTSZ:
+        errs.append('image %d shorter than the runtime %d' % (image, RTSZ))
+    # the program header sits at offset rtSz, and its words must describe the
+    # image that is actually in the file
+    if len(d) > RTSZ + 8:
+        hdr = d[RTSZ:RTSZ+16]
+        flag = int.from_bytes(hdr[0:2], 'little')
+        cs   = int.from_bytes(hdr[2:4], 'little')
+        ds   = int.from_bytes(hdr[4:6], 'little')
+        heap = int.from_bytes(hdr[6:8], 'little')
+        if flag != 1:
+            errs.append('hdrFlag=%d' % flag)
+        # hdrCS is pc, the end of the code, and the harness's `image` is
+        # rtSz + code ALREADY - so the two are the same number.  Adding
+        # RTSZ here counted the runtime twice.
+        if cs != image:
+            errs.append('hdrCS=%d, want %d (end of image)' % (cs, image))
+        if ds != DATAB:
+            errs.append('hdrDS=%d, want %d' % (ds, DATAB))
+        if heap != DATAB + data:
+            errs.append('hdrHeap=%d, want %d' % (heap, DATAB + data))
+
+    if errs:
+        bad += 1
+        print('  %-24s FAIL  %s' % (os.path.basename(name)[:-4], '; '.join(errs)))
+    else:
+        print('  %-24s PASS  %d bytes' % (os.path.basename(name)[:-4], com))
+
+print('----------------------------------------------------------------')
+print('independent .COM check: %d checked, %d failed' % (len(rows), bad))
+sys.exit(1 if bad else 0)
+PYEOF
+rc=$?
+[ "$rc" -eq 0 ] || exit 1
+echo "RESULT: ALL PASS"