Sfoglia il codice sorgente

Compiler: add the standard procedure table, and fix a rel16 off-by-2

Adds DefBuiltins: WRITE, WRITELN, READ, READLN and HALT as KBuiltin
symbols.  Before this the symbol table held six types and two constants
but no procedures at all, so WRITELN failed Statmnt's Search and every
program that printed anything died with error 41 on the '(' after the
call name.

They are KBuiltin rather than KProc because they are not called
generically.  The original (TPSRC8 pwriteln / pwrloop / prdtyped) does
not hand the runtime a descriptor: it inspects each argument's class and
emits a different call per type, so formatting is fixed at compile time
and the runtime only ever sees a value.  IoCall mirrors that, one call
per argument then a final call for the line break:

  writeln(1)     MOV AX,1 ; PUSH AX ; CALL 20H ; ADD SP,2 ; CALL 40H
  writeln('a')   MOV AX,'a' ; PUSH AX ; CALL 28H ; ADD SP,2 ; CALL 40H
  readln(x)      LEA AX,[0104] ; PUSH AX ; CALL 48H ; ADD SP,2 ; CALL 60H

READ/READLN push the address, not the value, so the runtime can store:
new EmPushVarAddr emits 8D 46 disp / 8D 06 off.  A non-variable
argument is ETypeErr (56), as in TP3.

Codegen bug found by dumping the image, not by size: EmCall, EmJmpNear
and EmJcc computed rel16 as "target - pc" at a point where pc already
points past the opcode and at the displacement field.  The instruction
does not end until pc+2, and x86 measures rel16 from the end of the
instruction, so every resolved-immediately branch and jump landed 2
bytes past its target.  ResolvePatches, on the forward-patched path,
already had it right (target - (place + 2)) - which is why forward gotos
looked fine and backward ones did not.  All three now use pc + 2.
Verified on t10_while: the JZ forward patch lands after the loop and the
JMP back-edge now lands exactly on the loop head.

Also: ERes grew a "chr" flag, because RdConst reports a 1-character
literal as TScalar (its char code 97) and only longer literals as
TString.  That is right for "c := 'a'" but made writeln('a') emit the
integer writer, so it compiled cleanly and printed 97 - a green test
lying, which is worse than a failure.  ParseAtom now marks the literal
and IoCall picks the char entry.

Fixture matrix: 16 of 22 compile, up from 1.  The 6 failures are 5
ENoLib (multi-char string literals, arrays) - the string runtime, real,
set, record and file are all still unimplemented - and uierror, which is
deliberately a syntax error.  uitest.py moved to that fixture so the UI
test's expected error number and position no longer drift as the library
grows; 10/10 still pass.

New: Compiler.CodeByteAt plus an "@dump" line in the CompileTest harness,
to hex-dump the emitted 8086 image.  This is what exposed the off-by-2
and is the only way to check code generation directly rather than
inferring it from code sizes.

Honest limits: the runtime blob, the linker that rebases the TU_*
entries, and CmdRun are all still pending, so a compiled image still
cannot be executed.
Eric Streit 2 settimane fa
parent
commit
ed450d6e33

+ 110 - 18
TP3-COMPILER.md

@@ -113,11 +113,20 @@ cd shell && tests/run_compile_tests.sh            # all fixtures
 cd shell && tests/run_compile_tests.sh /some/dir  # another fixture set
 ```
 
-Current matrix (15 fixtures) -- **8 compile, up from 1**:
+```
+cd shell && tests/run_compile_tests.sh            # all fixtures
+cd shell && tests/run_compile_tests.sh /some/dir  # another fixture set
+```
+
+Current matrix (22 fixtures) -- **16 compile, up from 1** (the empty
+program) when this work started:
 
 | fixture | result |
 |---|---|
 | `t01_minimal` `program t01; begin end.` | OK code=26 |
+| `t04_var` var decl + assignment + `writeln(x)` | OK code=45 |
+| `t06_two_args` `writeln('a','b')` | OK code=49 |
+| `t07_big` 10 assignments + `writeln(x)` | OK code=99 |
 | `t08_const` const decls, `'A'` char const | OK code=32 |
 | `t09_if` if/then/else | OK code=64 |
 | `t10_while` while | OK code=72 |
@@ -125,8 +134,39 @@ Current matrix (15 fixtures) -- **8 compile, up from 1**:
 | `t12_repeat` repeat/until | OK code=69 |
 | `t13_proc` procedure + value parameter | OK code=50 |
 | `t15_label` label + goto | OK code=35 |
-| `t02`, `t03`, `t04`, `t05`, `t06`, `t07` (any use of `writeln`) | ERROR 41 |
+| `t16_str1` `writeln('a')` (1-char literal) | OK code=39 |
+| `t18_writeln_bare` `writeln` with no parens | OK code=29 |
+| `t19_int1` `writeln(1)` | OK code=39 |
+| `t20_str3` `writeln('a','b','c')` | OK code=59 |
+| `t21_mixed` `writeln(1,'a',2)` | OK code=59 |
+| `t02`, `t03`, `t05`, `t17` multi-char string literal | ERROR 102 (`ENoLib`) |
 | `t14_types` `array [1..5] of integer` | ERROR 102 (`ENoLib`) |
+| `uierror` deliberate `x := 1 + ;` | ERROR 41 (used by `uitest.py`) |
+
+`code=` is the emitted image size in bytes; 26 is just the prologue, so
+these are real code sizes, not placeholders.
+
+### Hex-dumping the emitted image
+
+A line reading `@dump` on stdin switches on a hex dump of the emitted 8086
+code (via the new `Compiler.CodeByteAt`), which is how the `rel16` off-by-2
+below was found -- sizes alone could never have shown it:
+
+```
+cd shell
+printf '@dump\ntests/fixtures/t19_int1.pas\n' | ./compiletest
+```
+
+```
+00000000:  01 00 02 00 10 00 00 00 00 00 10 00 00 00 00 00
+00000100:  E8 F5 FF 8B EC B8 01 00 50 E8 04 00 83 C4 02 E8
+00000200:  1E 00 33 C0 E8 E9 FF
+```
+
+which reads: header words (CS=1, DS=0x10 = 256/16, 16 open files),
+`CALL 8H` (initmem), `MOV BP,SP`, `MOV AX,1`, `PUSH AX`,
+`CALL 20H` (WrInt), `ADD SP,2`, `CALL 40H` (WrLn), `XOR AX,AX`,
+`CALL 10H` (ProgEnd).
 
 ### `uitest.py` -- shell/editor behaviour that only exists interactively
 
@@ -134,8 +174,12 @@ Drives a real pty (`ptyharness.py` supplies read-until-quiet, key sending
 and a small VT100 emulator) and asserts the TP3 **compile-error jump**:
 `W` load -> `C` compile -> `ESC` -> the editor opens with the cursor exactly
 on the error position -> `Ctrl-K D` back to the menu -> `Q` exit 0.
-10/10 pass on `t02_writeln.pas`, and the reported error is 41 -- i.e. the
-`errNo` self-assignment fix is now proven through the real UI.
+10/10 pass on `uierror.pas`, and the reported error is 41 -- i.e. the
+`errNo` self-assignment fix is now proven through the real UI.  The
+fixture carries a deliberate *syntax* error (`x := 1 + ;` -> error 41 at
+line 9, column 12) rather than a missing library feature, on purpose: the
+latter move as the compiler grows, and a UI test whose expectations drift
+with it stops being a test.
 
 The jump mirrors original TP3 `kcwait` + `editor2`
 (`Resources/turbopascal3source/TP3/TPSRC5:333-336` and `:919`):
@@ -148,22 +192,70 @@ The jump mirrors original TP3 `kcwait` + `editor2`
 Note `LoadWorkFile` ends with a `Pause`, so a driver must send one filler
 key after the path; skipping it desynchronises every later keypress.
 
-## Known gap: no standard procedure library
+## Standard procedures (the builtin table)
 
 `Inittur` defines six predefined *types* (INTEGER/BYTE/CHAR/BOOLEAN/REAL/
-STRING), TRUE/FALSE and two temporaries -- and **zero procedures**.  So
-`WRITELN` is never in the symbol table, the `ELSE` branch of `Statmnt` fails
-its `Search`, and every program that prints anything dies with `EUnknown`
-(41) on the `(` after the call name.  That is why 6 of the 15 fixtures still
-fail, and it is the next milestone.  `EmCallMost` already has the right
-shape: a `KProc` symbol with `defnd := TRUE` and `goPos` = runtime entry
-emits a direct near call.  The runtime entries `TU_InitMem=8H`,
-`TU_ProgEnd=10H`, `TU_StackChk=18H` are image-base offsets, i.e. the runtime
-blob is meant to be prepended at link time by the not-yet-written linker.
-`CmdRun`, the interpreter, is likewise still a stub.
-
-`ENoLib` (102) is the deliberate "not implemented yet" path for
-real/set/record/file/string and for any type wider than 2 bytes.
+STRING), TRUE/FALSE and two temporaries, plus now five **procedures** via
+`DefBuiltins`: WRITE, WRITELN, READ, READLN, HALT.  Before this, `WRITELN`
+was simply absent from the symbol table, `Statmnt`'s identifier branch
+failed its `Search`, and every program that printed anything died with
+`EUnknown` (41) on the `(` after the call name.
+
+They are tagged `KBuiltin`, not `KProc`, because they are not called
+generically.  TP3 (TPSRC8 `pwriteln` / `pwrloop` / `prdtyped`) does **not**
+hand the runtime a descriptor: it inspects each argument's class and emits a
+*different call per type*, so the formatting is fixed at compile time and the
+runtime only ever sees a value.  `IoCall` mirrors that:
+
+```
+writeln(1)      ->  MOV AX,1 ; PUSH AX ; CALL 20H ; ADD SP,2 ; CALL 40H
+writeln('a')    ->  MOV AX,'a' ; PUSH AX ; CALL 28H ; ADD SP,2 ; CALL 40H
+writeln(1,'a')  ->  ... CALL 20H ... CALL 28H ... CALL 40H
+readln(x)       ->  LEA AX,[0104] ; PUSH AX ; CALL 48H ; ADD SP,2 ; CALL 60H
+```
+
+`TU_WrInt/Char/Bool/Real`, `TU_WrLn`, `TU_RdInt/Char/Bool`, `TU_RdLn` and
+`TU_Halt` are new image-base entry constants continuing the existing `TU_*`
+space (`TU_InitMem=8H`, `TU_ProgEnd=10H`, `TU_StackChk=18H`).  READ/READLN
+push the *address* of the variable (new `EmPushVarAddr`: `8D 46 disp` /
+`8D 06 off`) so the runtime can store; a non-variable argument is `ETypeErr`
+(56), as in TP3.
+
+A **single-character** literal needed care.  `RdConst` reports `'a'` as
+`TScalar` (its char code 97) and only longer literals as `TString`.  That is
+right for `c := 'a'` but would make `writeln('a')` print **97**, so
+`ERes` grew a `chr` flag, set in `ParseAtom` and honoured in `IoCall`, which
+then picks the char entry.  Without it `writeln('a')` compiled cleanly and
+printed the wrong thing -- a green test lying, which is worse than a failure.
+
+Still pending, and deliberately reported rather than faked: the **runtime
+blob** itself (`CmdRun`, the interpreter, and the linker that rebases these
+entry offsets by the runtime's size) and the **string** runtime, so
+multi-character literals still raise `ENoLib` (102).  `ENoLib` is also the
+path for real/set/record/file and for any type wider than 2 bytes.
+
+## Codegen bug: every direct CALL/JMP was 2 bytes long
+
+Found by dumping the emitted image, not by size.  `EmCall`, `EmJmpNear` and
+`EmJcc` computed their `rel16` as
+
+```
+rel := (target + 10000H - pc) MOD 10000H
+```
+
+but at that point `pc` already points *past the opcode and at the
+displacement field* -- the instruction does not end until `pc + 2`, and
+x86 measures `rel16` from the end of the instruction.  So every
+resolved-immediately branch and jump landed 2 bytes past its target.
+`ResolvePatches`, used for the *forward* patched path, already had it right
+(`target - (place + 2)`), which is why forward gotos looked fine and
+backward ones did not.  All three now use `pc + 2`.
+
+This was silently harmless so far only because nothing executes the image
+yet.  Verified on `t10_while`: the `JZ` forward patch lands on the
+instruction after the loop, and the `JMP` back-edge now lands exactly on the
+loop head instead of 2 bytes into it.
+
 
 ## gm2 pitfall: `EXIT` inside the program-header `WHILE` crashes pass 3
 

+ 6 - 0
shell/Compiler.def

@@ -11,6 +11,8 @@ DEFINITION MODULE Compiler ;
    The shell (CmdCompile) will call Compile, then jump the editor to
    errPos on failure - exactly like the original errexit + editor2 path. *)
 
+FROM SYSTEM IMPORT BYTE ;
+
 PROCEDURE Compile (VAR errNo, errPos : CARDINAL) : BOOLEAN ;
 (* Compile the current TextBuf as a Pascal program.  Returns TRUE on
    success (sizes available via CodeBytes / DataBytes).  On failure
@@ -23,4 +25,8 @@ PROCEDURE CodeBytes () : CARDINAL ;
 PROCEDURE DataBytes () : CARDINAL ;
 (* emitted data size in bytes *)
 
+PROCEDURE CodeByteAt (i : CARDINAL) : BYTE ;
+(* i-th byte of the emitted image (0 past the end), so tests can check the
+   generated 8086 code itself and not only its size *)
+
 END Compiler.

+ 213 - 7
shell/Compiler.mod

@@ -26,12 +26,22 @@ IMPLEMENTATION MODULE Compiler ;
    CALL initmem, MOV BP,SP, then generated code).  Forward labels and
    forward procedure calls resolve through a patch list (ptc records).
 
-   Working subset (v0.3): integer/char/boolean/byte scalars, constants
+   Working subset (v0.4): integer/char/boolean/byte scalars, constants
    with folding, globals, locals, value parameters, procedures and
    scalar-result functions, ARRAY[const..const] with constant indexing,
-   control flow, GOTO/EXIT.  Real/set/record/file and string runtime
-   raise Err (ENoLib) pending the future runtime library - matching the
-   original's "not implemented" error path. *)
+   control flow, GOTO/EXIT, and the standard procedures WRITE, WRITELN,
+   READ, READLN, HALT (DefBuiltins + IoCall).
+
+   The standard procedures are dispatched per argument, as the original
+   does (TPSRC8 pwriteln/pwrloop inspects each argument's class and emits
+   a different call per type), so the runtime is handed a value and never
+   a descriptor.
+
+   Still not implemented: real/set/record/file and the string runtime
+   raise Err (ENoLib) - the original's "not implemented" path.  The
+   runtime blob itself, the linker that rebases the TU_* entry offsets
+   by the runtime's size, and CmdRun (the interpreter) are still pending,
+   so a compiled image cannot be executed yet. *)
 
 FROM TextBuf IMPORT Length, CharAt ;
 
@@ -57,6 +67,11 @@ CONST
    (* symbol kinds *)
    KLabel   = 100H ;  KConst  = 200H ;  KType   = 300H ;
    KVar     = 400H ;  KProc   = 500H ;  KFunc   = 600H ;
+   KBuiltin = 700H ;         (* standard procedure, see BI_* below *)
+
+   (* which standard procedure a KBuiltin symbol denotes *)
+   BI_Write   = 0 ;  BI_WriteLn = 1 ;  BI_Read  = 2 ;
+   BI_ReadLn  = 3 ;  BI_Halt    = 4 ;
 
    (* keyword tokens *)
    TkNone = 0 ;   TkProgram = 1 ;  TkBegin  = 2 ;  TkEnd = 3 ;
@@ -76,6 +91,15 @@ CONST
    TU_ProgEnd  = 10H ;
    TU_StackChk = 18H ;
 
+   (* Standard-procedure runtime entries.  TP3 does NOT pass a descriptor:
+      TPSRC8 pwriteln/pwrloop inspects each argument's class in CL and emits
+      a *different* call per type, so the type is fixed at compile time and
+      the runtime needs only the value.  Mirrored here. *)
+   TU_WrInt    = 20H ;  TU_WrChar   = 28H ;  TU_WrBool   = 30H ;
+   TU_WrReal   = 38H ;  TU_WrLn     = 40H ;
+   TU_RdInt    = 48H ;  TU_RdChar   = 50H ;  TU_RdBool   = 58H ;
+   TU_RdLn     = 60H ;  TU_Halt     = 68H ;
+
    (* TP3 error numbers *)
    ENoSemi    = 1 ;  EPointExp  = 10 ;  ESimpType  = 30 ;
    EUnknown   = 41 ; EConstRange = 45 ; EMemOvf    = 98 ;
@@ -126,6 +150,7 @@ TYPE
          imm  : LONGINT ;
          idx  : CARDINAL ;
          boff : CARDINAL ;          (* constant fold-in for subscripts *)
+         chr  : BOOLEAN ;           (* single-quoted literal, e.g. 'a' *)
       END ;
 
    DirRec = RECORD  rng, chk : BOOLEAN  END ;
@@ -356,7 +381,12 @@ BEGIN
       AddPatch (pc - 2, 0) ;
       RETURN p
    END ;
-   rel := (target + 10000H - pc) MOD 10000H ;
+   (* rel16 is measured from the END of the instruction.  Here pc already
+      points past the opcode(s) and at the displacement field, so the
+      instruction ends at pc+2 - the same convention ResolvePatches uses
+      with "place + 2".  Omitting the +2 lands every direct call/jump 2 bytes
+      past its target. *)
+   rel := (target + 10000H - (pc + 2)) MOD 10000H ;
    Eword (rel) ;
    RETURN 0
 END EmCall ;
@@ -372,7 +402,7 @@ BEGIN
       AddPatch (pc - 2, 0) ;
       RETURN p
    END ;
-   rel := (target + 10000H - pc) MOD 10000H ;
+   rel := (target + 10000H - (pc + 2)) MOD 10000H ;   (* see EmCall *)
    Eword (rel) ;
    RETURN 0
 END EmJmpNear ;
@@ -389,7 +419,7 @@ BEGIN
       AddPatch (pc - 2, 0) ;
       RETURN p
    END ;
-   rel := (target + 10000H - pc) MOD 10000H ;
+   rel := (target + 10000H - (pc + 2)) MOD 10000H ;   (* see EmCall *)
    Eword (rel) ;
    RETURN 0
 END EmJcc ;
@@ -567,6 +597,21 @@ BEGIN
    END
 END EmStoreVar ;
 
+PROCEDURE EmPushVarAddr (local : BOOLEAN ; off : CARDINAL) ;
+(* LEA AX,[BP+disp] / LEA AX,[off] then PUSH AX - READ passes the address of
+   a variable, not its value.  8D 46 disp is LEA AX,[BP+disp] and 8D 06 off
+   is LEA AX,[off] (mod=00 rm=110 = direct disp16), both 8086-legal. *)
+VAR disp : CARDINAL ;
+BEGIN
+   disp := off MOD 100H ;
+   IF local THEN
+      Ebyte (8DH) ; Ebyte (46H) ; Ebyte (VAL (BYTE, disp))
+   ELSE
+      Ebyte (8DH) ; Ebyte (06H) ; Eword (off)
+   END ;
+   EmPushAx ()
+END EmPushVarAddr ;
+
 PROCEDURE EmSubSp (n : CARDINAL) ;
 BEGIN
    Ebyte (81H) ; Ebyte (0ECH) ; Eword (n MOD 10000H)
@@ -1468,7 +1513,9 @@ PROCEDURE ParseAtom (VAR r : ERes) ;
 (* const | variable | func(params) | '(' expr ')' *)
 VAR idx : CARDINAL ;
     strf : BOOLEAN ;
+    quoted : BOOLEAN ;
 BEGIN
+   r.chr := FALSE ;            (* default: not a quoted char literal *)
    Skip () ;
    IF CurCh () = '(' THEN
       DropCh (GetCh ()) ;
@@ -1477,7 +1524,13 @@ BEGIN
       RETURN
    END ;
    IF (CurCh () = '$') OR (Digit (CurCh ())) OR (ORD (CurCh ()) = AposC) THEN
+      (* remember that this was a quoted literal BEFORE RdConst consumes it:
+         RdConst reports a 1-character literal as TScalar (its char code),
+         which is right for "c := 'a'" but would make writeln('a') print 97.
+         Mark it so the writer picks the char entry, not the integer one. *)
+      quoted := (ORD (CurCh ()) = AposC) ;
       RdConst (r.imm, r.cls, strf) ;
+      r.chr := quoted AND (r.cls = TScalar) AND NOT strf ;
       IF r.cls = TReal THEN
          Err (ENoLib) ;
          r.kind := 2 ;
@@ -1701,6 +1754,114 @@ BEGIN
    END
 END Compound ;
 
+PROCEDURE IoCall (idx : CARDINAL) ;
+(* WRITE / WRITELN / READ / READLN / HALT.
+
+   TP3 (TPSRC8 pwriteln, pwrloop, prdtyped) does not pass a descriptor to
+   the runtime: it looks at each argument's class and emits a *different*
+   call per type, so the formatting is fixed at compile time.  Mirrored
+   here - one call per argument, then a final call for the line break.
+
+   WRITE/WRITELN push the value; READ/READLN push the address, so the
+   runtime can store.  As everywhere else in this compiler the caller
+   cleans the argument off the stack. *)
+VAR args : ARRAY [0..15] OF ERes ;
+    nArgs, i, ent, which, acls : CARDINAL ;
+    reading : BOOLEAN ;
+    dummy : ERes ;
+BEGIN
+   which := symtab [idx].cls ;               (* BI_* *)
+   IF which = BI_Halt THEN
+      IF MatchDelim ('(') THEN               (* halt(0) - code ignored *)
+         ParseExpr (dummy) ;
+         ExpectDelim (')', ENoSemi)
+      END ;
+      DropC (EmCall (TU_Halt)) ;
+      RETURN
+   END ;
+   reading := (which = BI_Read) OR (which = BI_ReadLn) ;
+   nArgs := 0 ;
+   IF MatchDelim ('(') THEN
+      IF CurCh () # ')' THEN
+         LOOP
+            IF nArgs >= 16 THEN
+               Err (ECompOvf) ;
+               EXIT
+            END ;
+            ParseExpr (args [nArgs]) ;
+            INC (nArgs) ;
+            IF NOT MatchDelim (',') THEN
+               EXIT
+            END
+         END ;
+         IF NOT MatchDelim (')') THEN
+            Err (ENoSemi) ;
+            RETURN
+         END
+      ELSE
+         DropCh (GetCh ())
+      END
+   END ;
+   IF reading AND (nArgs = 0) THEN
+      (* readln with no variable: just skip to the next line *)
+      DropC (EmCall (TU_RdLn)) ;
+      RETURN
+   END ;
+   (* NB: guard the loop bound - with nArgs = 0, "nArgs - 1" would wrap round
+      to 65535 in CARDINAL and spin 65536 times. *)
+   IF nArgs > 0 THEN
+      FOR i := 0 TO nArgs - 1 DO
+      IF reading THEN
+         IF args [i].kind # 1 THEN
+            Err (ETypeErr) ;                  (* READ needs a variable *)
+            RETURN
+         END ;
+         acls := symtab [args [i].idx].cls ;
+         IF acls = TString THEN
+            Err (ENoLib) ;                    (* string runtime pending *)
+            RETURN
+         END ;
+         EmPushVarAddr (symtab [args [i].idx].local, symtab [args [i].idx].off) ;
+         IF acls = TReal THEN
+            ent := TU_RdInt                   (* real reads: not yet *)
+         ELSIF acls = TBool THEN
+            ent := TU_RdBool
+         ELSIF acls = TScalar THEN
+            ent := TU_RdInt
+         ELSE
+            ent := TU_RdChar
+         END
+      ELSE
+         acls := args [i].cls ;
+         IF acls = TString THEN
+            Err (ENoLib) ;                    (* string runtime pending *)
+            RETURN
+         END ;
+         LoadAtom (args [i]) ;
+         EmPushAx () ;
+         IF args [i].chr THEN
+            ent := TU_WrChar                   (* 'a' - one char, not 97 *)
+         ELSIF acls = TReal THEN
+            ent := TU_WrReal
+         ELSIF acls = TBool THEN
+            ent := TU_WrBool
+         ELSIF acls = TScalar THEN
+            ent := TU_WrInt
+         ELSE
+            ent := TU_WrChar
+         END
+      END ;
+      DropC (EmCall (ent)) ;
+      EmAddSp (2)                            (* one 16-bit argument *)
+      END
+   END ;
+   IF which = BI_WriteLn THEN
+      DropC (EmCall (TU_WrLn))
+   ELSIF which = BI_ReadLn THEN
+      DropC (EmCall (TU_RdLn))
+   END
+END IoCall ;
+
 PROCEDURE Statmnt () ;
 VAR tok : CARDINAL ;
     idx, i2 : CARDINAL ;
@@ -1974,6 +2135,10 @@ BEGIN
          Err (EUnknown) ;
          RETURN
       END ;
+      IF symtab [idx].tag = KBuiltin THEN
+         IoCall (idx) ;
+         RETURN
+      END ;
       IF symtab [idx].tag = KProc THEN
          IF MatchDelim ('(') THEN
             ParseCallArgs (idx)
@@ -2479,6 +2644,35 @@ END DefPart ;
 (*  driver  (TPSRC7 compile)                                        *)
 (* ---------------------------------------------------------------- *)
 
+PROCEDURE DefBuiltins () ;
+(* The standard procedures.  Without these, WRITELN is absent from the
+   symbol table, Statmnt's identifier branch fails its Search and every
+   program that prints anything dies with EUnknown (41) on the '(' after the
+   call name - the single remaining cause of failure in the fixture matrix.
+
+   Tagged KBuiltin (not KProc) because these are not called generically:
+   WRITE/WRITELN/READ/READLN need TP3's per-argument type dispatch
+   (IoCall), and HALT takes no argument at all.  defnd is TRUE because the
+   entry point is known - there is no forward reference to patch. *)
+VAR i : CARDINAL ;
+BEGIN
+   i := NewSym ("WRITE"  , KBuiltin, BI_Write  , 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   symtab [i].goPos := TU_WrInt ;
+   i := NewSym ("WRITELN", KBuiltin, BI_WriteLn, 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   symtab [i].goPos := TU_WrInt ;
+   i := NewSym ("READ"   , KBuiltin, BI_Read   , 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   symtab [i].goPos := TU_RdInt ;
+   i := NewSym ("READLN" , KBuiltin, BI_ReadLn , 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   symtab [i].goPos := TU_RdInt ;
+   i := NewSym ("HALT"   , KBuiltin, BI_Halt   , 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   symtab [i].goPos := TU_Halt
+END DefBuiltins ;
+
 PROCEDURE Inittur () ;
 (* reset compiler state and define the standard types *)
 BEGIN
@@ -2513,6 +2707,7 @@ BEGIN
    DropC (NewSym ("STRING" , KType, TString, 256, 1, 0, 0, FALSE)) ;
    DropC (NewSym ("TRUE"   , KConst, TBool, 1, 1, 0, 1, FALSE)) ;
    DropC (NewSym ("FALSE"  , KConst, TBool, 1, 1, 0, 0, FALSE)) ;
+   DefBuiltins () ;
    tmpA := NewSym ("@@T1", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
    dc := dc + 2 ;
    tmpB := NewSym ("@@T2", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
@@ -2616,4 +2811,15 @@ BEGIN
    RETURN dataSz
 END DataBytes ;
 
+PROCEDURE CodeByteAt (i : CARDINAL) : BYTE ;
+(* i-th byte of the emitted image, for test harnesses that need to check
+   the generated 8086 code rather than just its size.  Returns 0 past the
+   end of the image. *)
+BEGIN
+   IF i >= codeSz THEN
+      RETURN 0
+   END ;
+   RETURN cbuf [i]
+END CodeByteAt ;
+
 END Compiler.

+ 106 - 22
shell/tests/CompileTest.mod

@@ -15,7 +15,7 @@ MODULE CompileTest ;
 
 FROM Posix IMPORT read, write, open, close ;
 FROM TextBuf IMPORT TextLimit, Clear, Length, CharAt, InsertCh ;
-FROM Compiler IMPORT Compile, CodeBytes, DataBytes ;
+FROM Compiler IMPORT Compile, CodeBytes, DataBytes, CodeByteAt ;
 FROM SYSTEM IMPORT ADR, BYTE ;
 
 CONST
@@ -25,7 +25,7 @@ CONST
 
 VAR
    lineBuf : ARRAY [0..255] OF CHAR ;
-   path    : ARRAY [0..511] OF CHAR ;
+   pathCopy : ARRAY [0..511] OF CHAR ;
    txt     : ARRAY [0..79] OF CHAR ;
    mark    : ARRAY [0..79] OF CHAR ;
 
@@ -191,33 +191,117 @@ END ShowAt ;
 VAR
    errNo, errPos : CARDINAL ;
    ok : BOOLEAN ;
+   dump : BOOLEAN ;
+
+PROCEDURE Hex (b : BYTE ; VAR out : ARRAY OF CHAR) ;
+(* ISO will not index a plain string constant as an array, so compute the
+   two nibbles instead of using a "0123456789ABCDEF" lookup. *)
+VAR d : CARDINAL ;
+BEGIN
+   d := VAL (CARDINAL, b) DIV 16 ;   (* BYTE arith yields BYTE *)
+   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 PutCardHex4 (n : CARDINAL) ;
+VAR hx : ARRAY [0..1] OF CHAR ; b : BYTE ; d : CARDINAL ;
+BEGIN
+   d := 4096 ;                       (* 16^3, no "**" needed *)
+   WHILE d > 0 DO
+      b := VAL (BYTE, (n DIV d) MOD 16) ;
+      Hex (b, hx) ;
+      PutCh (hx [0]) ;
+      PutCh (hx [1]) ;
+      d := d DIV 16
+   END ;
+   PutStr (":  ")
+END PutCardHex4 ;
+
+PROCEDURE DumpCode () ;
+(* hex dump of the emitted image, 16 bytes per line *)
+VAR i, n : CARDINAL ;
+    hx : ARRAY [0..1] OF CHAR ;
+    b : BYTE ;
+BEGIN
+   i := 0 ;
+   WHILE i < CodeBytes () DO
+      PutStr ("        " ) ;
+      PutCardHex4 (i) ;
+      n := 0 ;
+      WHILE (n < 16) AND (i + n < CodeBytes ()) DO
+         b := CodeByteAt (i + n) ;
+         Hex (b, hx) ;
+         PutCh (hx [0]) ;
+         PutCh (hx [1]) ;
+         PutCh (" ") ;
+         INC (n)
+      END ;
+      NL ;
+      i := i + 16
+   END
+END DumpCode ;
+
+PROCEDURE IsDumpCmd () : BOOLEAN ;
+(* the line "@dump" switches the hex dump on for the rest of the run *)
+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 # 5) OR (lineBuf [1] # "d") OR (lineBuf [2] # "u") OR
+      (lineBuf [3] # "m") OR (lineBuf [4] # "p") THEN
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END IsDumpCmd ;
+
 BEGIN
    PutStr ("FIXTURE  RESULT") ;
    NL ;
    WHILE ReadLineStr (lineBuf) DO
-      StrCopy (path, lineBuf) ;
-      IF LoadFile (path) THEN
-         ok := Compile (errNo, errPos) ;
-         IF ok THEN
-            PutStr (lineBuf) ;
-            PutStr ("  OK  code=") ;
-            PutCard (CodeBytes ()) ;
-            PutStr (" data=") ;
-            PutCard (DataBytes ()) ;
-            NL
+      IF IsDumpCmd () THEN
+         dump := TRUE                    (* "@dump": hex-dump from here on *)
+      ELSE
+         StrCopy (pathCopy, lineBuf) ;
+         IF LoadFile (pathCopy) THEN
+            ok := Compile (errNo, errPos) ;
+            IF ok THEN
+               PutStr (lineBuf) ;
+               PutStr ("  OK  code=") ;
+               PutCard (CodeBytes ()) ;
+               PutStr (" data=") ;
+               PutCard (DataBytes ()) ;
+               NL ;
+               IF dump THEN
+                  DumpCode ()
+               END
+            ELSE
+               PutStr (lineBuf) ;
+               PutStr ("  ERROR ") ;
+               PutCard (errNo) ;
+               PutStr (" at pos ") ;
+               PutCard (errPos) ;
+               NL ;
+               ShowAt (errPos)
+            END
          ELSE
             PutStr (lineBuf) ;
-            PutStr ("  ERROR ") ;
-            PutCard (errNo) ;
-            PutStr (" at pos ") ;
-            PutCard (errPos) ;
-            NL ;
-            ShowAt (errPos)
+            PutStr ("  CANNOT OPEN") ;
+            NL
          END
-      ELSE
-         PutStr (lineBuf) ;
-         PutStr ("  CANNOT OPEN") ;
-         NL
       END
    END
 END CompileTest.

+ 4 - 0
shell/tests/fixtures/t16_str1.pas

@@ -0,0 +1,4 @@
+program t16;
+begin
+  writeln('a')
+end.

+ 4 - 0
shell/tests/fixtures/t17_two_str.pas

@@ -0,0 +1,4 @@
+program t17;
+begin
+  writeln('abc','de')
+end.

+ 4 - 0
shell/tests/fixtures/t18_writeln_bare.pas

@@ -0,0 +1,4 @@
+program t18;
+begin
+  writeln
+end.

+ 4 - 0
shell/tests/fixtures/t19_int1.pas

@@ -0,0 +1,4 @@
+program t19;
+begin
+  writeln(1)
+end.

+ 4 - 0
shell/tests/fixtures/t20_str3.pas

@@ -0,0 +1,4 @@
+program t20;
+begin
+  writeln('a','b','c')
+end.

+ 4 - 0
shell/tests/fixtures/t21_mixed.pas

@@ -0,0 +1,4 @@
+program t21;
+begin
+  writeln(1,'a',2)
+end.

+ 10 - 0
shell/tests/fixtures/uierror.pas

@@ -0,0 +1,10 @@
+program uierror;
+(* Dedicated fixture for tests/uitest.py: needs a *syntax* error that is
+   independent of which library features the compiler happens to support,
+   so the expected error number and position stay stable as the compiler
+   grows.  The missing operand after '+' is the error. *)
+var
+  x : integer;
+begin
+  x := 1 + ;
+end.

+ 10 - 7
shell/tests/uitest.py

@@ -12,8 +12,11 @@ This test covers the *shell* behaviour that only exists interactively:
   5. Q exits the shell cleanly with status 0
      (a bare HALT aborts with SIGABRT under gm2 -fiso)
 
-Fixture: t02_writeln.pas fails with error 41 at pos 28, which is line 3,
-column 10 (1-based) - the '(' just after 'writeln'.
+Fixture: uierror.pas has a deliberate *syntax* error (a missing operand
+after '+'), reported as error 41 at pos 331 = line 9, column 12 (1-based).
+A syntax error is used deliberately rather than, say, a missing library
+feature: those come and go as the compiler grows, and a UI test whose
+expectations drift with it stops being a test.
 
 Usage: uitest.py [fixture.pas]
 """
@@ -24,10 +27,10 @@ sys.path.insert(0, os.path.dirname(os.path.abspath(__file__)))
 from ptyharness import CTRL_K, SHELL_DIR, Screen, drain, reap, send, spawn, status_str, visible
 
 FIXTURE = sys.argv[1] if len(sys.argv) > 1 else os.path.join(
-    os.path.dirname(os.path.abspath(__file__)), "fixtures", "t02_writeln.pas")
+    os.path.dirname(os.path.abspath(__file__)), "fixtures", "uierror.pas")
 EXPECT_ERR = "41"
-EXPECT_LINE = 3
-EXPECT_COL = 10
+EXPECT_LINE = 9
+EXPECT_COL = 12
 
 
 def main():
@@ -50,9 +53,9 @@ def main():
         scr = Screen()
         scr.feed(ed)
         text = scr.text()
-        row = scr.row_with("writeln")
+        row = scr.row_with("x := 1 +")
         checks.append(("editor opened", "Line %d" % EXPECT_LINE in text))
-        checks.append(("cursor on the faulty line (screen row carries 'writeln')",
+        checks.append(("cursor on the faulty line (that row carries the bad stmt)",
                        row is not None))
         checks.append(("status line reports Line %d" % EXPECT_LINE,
                        ("Line %d" % EXPECT_LINE) in text.split("\n")[0]))