TP3/shell/tests/Exec86Run.mod

MODULE Exec86Run ;

(* Exec86Run -- run one .COM under the Exec86 interpreter and report what
   happened, so that a Python harness can compare it against qemu.

   stdin is: one line naming the .COM, then everything else is the guest's
   input.  That line is read a byte at a time through the raw read(), not
   through any buffered reader, because the guest reads fd 0 itself: a stdio
   buffer that had already swallowed the first few input bytes would look
   exactly like a program that parses its input wrongly, and that is the
   kind of failure that gets blamed on the code under test.

   stdout belongs to the guest and is never written to here.

   stderr carries exactly one line

      exec86: status=<0|1|2> exit=<n> steps=<n>

   where 0 = halted through INT 21h AH=4Ch, 1 = fault (its diagnostic is on
   stderr just before this line), 2 = the runaway step limit.  The harness
   asserts on that line rather than on the process exit code: the guest is
   free to exit with 126, and an exit code that cannot tell "the program
   returned 126" from "the interpreter broke" would be an assertion with a
   hole in it.  The process exit code is set to agree anyway - the guest's
   own code when status is 0, 126 on a fault, 127 on the step limit - so
   that running this by hand in a shell still says something useful.

   The input is delivered on fd 0 rather than through the memory descriptor
   bootcom.s uses (INLEN at 2000h, INBUF at 2004h).  The two are the same
   machine as far as a guest can tell: bootcom returns the descriptor's bytes
   in order and then 1Ah for ever, and fd 0 returns the same bytes in order
   and then read() = 0, which is turned into 1Ah for ever by the same
   clause.  They agree exactly when the pipe holds exactly the fixture's
   .in file, which is what the harness feeds.  Writing that down because
   "we feed it differently and it still matched" is precisely the kind of
   agreement that stops holding the day someone appends a newline. *)

FROM Posix IMPORT read, write, open, close ;
FROM Exec86 IMPORT Clear86, Poke86, Run86 ;
FROM SYSTEM IMPORT ADR, BYTE ;

CONST
   STDIN  = 0 ;
   STDERR = 2 ;
   O_RDONLY = 0 ;
   LoadAt = 100H ;            (* DOS's .COM entry point, same as bootcom's *)

VAR
   path  : ARRAY [0..511] OF CHAR ;
   fbuf  : ARRAY [0..65535] OF BYTE ;
   fsize : CARDINAL ;


PROCEDURE PutS (s : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
    n : LONGINT ;
    c : CHAR ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      c := s [i] ;
      n := write (STDERR, ADR (c), 1) ;
      i := i + 1
   END
END PutS ;

PROCEDURE PutCh (c : CHAR) ;
VAR n : LONGINT ;
BEGIN
   n := write (STDERR, ADR (c), 1)
END PutCh ;

PROCEDURE PutLong (n : LONGCARD) ;
(* Long enough for LONGCARD itself, though the only value printed with it is
   the step count, which the runaway cap already bounds below CARDINAL's
   maximum.  Printed anyway rather than narrowed with VAL, because narrowing
   a counter is how a count that has grown past its type stops being a count. *)
VAR dig : ARRAY [0..20] OF CHAR ;
    i : CARDINAL ;
    v : LONGCARD ;
BEGIN
   i := 20 ;
   dig [20] := 0C ;
   v := n ;
   REPEAT
      i := i - 1 ;
      dig [i] := CHR (ORD ('0') + VAL (CARDINAL, v MOD VAL (LONGCARD, 10))) ;
      v := v DIV VAL (LONGCARD, 10)
   UNTIL v = 0 ;
   (* digits occupy i..19 with the most significant first, and dig[20] was
      set only so that the arithmetic above cannot walk off the end. *)
   WHILE i <= 19 DO
      PutCh (dig [i]) ;
      i := i + 1
   END
END PutLong ;

PROCEDURE PutN (v : CARDINAL) ;
VAR dig : ARRAY [0..10] OF CHAR ;
    i, x : CARDINAL ;
    n : LONGINT ;
    c : CHAR ;
BEGIN
   i := 10 ;
   dig [10] := 0C ;
   x := v ;
   REPEAT
      i := i - 1 ;
      dig [i] := CHR (ORD ('0') + x MOD 10) ;
      x := x DIV 10
   UNTIL x = 0 ;
   x := i ;
   WHILE x <= 9 DO
      c := dig [x] ;
      n := write (STDERR, ADR (c), 1) ;
      x := x + 1
   END
END PutN ;

PROCEDURE Terminate (code : CARDINAL) ;
BEGIN
   HALT (code)
END Terminate ;

PROCEDURE Die (msg : ARRAY OF CHAR; code : CARDINAL) ;
BEGIN
   PutS ("exec86run: ") ;
   PutS (msg) ;
   PutCh (CHR (10)) ;
   Terminate (code)
END Die ;

PROCEDURE ReadPathLine () : BOOLEAN ;
(* Reads the first line of stdin into `path', one byte at a time through
   read().  Returns FALSE at end of input with nothing read. *)
VAR ch : CHAR ;
    n : LONGINT ;
    i : CARDINAL ;
BEGIN
   i := 0 ;
   LOOP
      n := read (STDIN, ADR (ch), 1) ;
      IF n # 1 THEN
         path [i] := 0C ;
         RETURN i > 0
      END ;
      IF (ch = CHR (10)) OR (ch = CHR (13)) THEN
         path [i] := 0C ;
         RETURN TRUE
      END ;
      IF i < HIGH (path) - 1 THEN
         path [i] := ch ;
         i := i + 1
      END
   END
END ReadPathLine ;

PROCEDURE ReadCom () : BOOLEAN ;
VAR fd, k : LONGINT ;
    z : ARRAY [0..511] OF CHAR ;
    i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (path)) AND (i < HIGH (z)) AND (path [i] # 0C) DO
      z [i] := path [i] ;
      i := i + 1
   END ;
   z [i] := 0C ;
   fd := open (ADR (z), O_RDONLY, 0) ;
   IF fd < 0 THEN
      RETURN FALSE
   END ;
   fsize := 0 ;
   LOOP
      IF fsize >= 65536 THEN EXIT END ;
      k := read (fd, ADR (fbuf [fsize]), VAL (LONGCARD, 65536 - fsize)) ;
      IF k <= 0 THEN EXIT END ;
      fsize := fsize + VAL (CARDINAL, k)
   END ;
   k := close (fd) ;
   RETURN TRUE
END ReadCom ;

VAR
   exitCode : CARDINAL ;
   steps    : LONGCARD ;
   ix, st   : CARDINAL ;

BEGIN
   IF NOT ReadPathLine () THEN
      Die ("no .COM path on stdin", 125)
   END ;
   IF NOT ReadCom () THEN
      Die ("cannot open the .COM", 125)
   END ;
   IF fsize = 0 THEN
      Die ("the .COM is empty", 125)
   END ;
   IF fsize > 65536 - LoadAt THEN
      Die ("the .COM does not fit below 10000h", 125)
   END ;

   Clear86 ;
   ix := 0 ;
   WHILE ix < fsize DO
      Poke86 (LoadAt + ix, ORD (fbuf [ix])) ;
      ix := ix + 1
   END ;

   st := Run86 (exitCode, steps) ;

   PutS ("exec86: status=") ;
   PutN (st) ;
   PutS (" exit=") ;
   PutN (exitCode) ;
   PutS (" steps=") ;
   PutLong (steps) ;
   PutCh (CHR (10)) ;

   IF st = 0 THEN
      Terminate (exitCode)
   ELSIF st = 1 THEN
      Terminate (126)
   ELSE
      Terminate (127)
   END
END Exec86Run.