Procházet zdrojové kódy

writeln('hi'): inline string literals, the way TP3 emits them

toto.pas was the five-line hello-world the previous commit fixed the error
position for, and it still would not compile: writeln('toto') reported
error 102, ENoLib, the original's "not implemented" path.  String
literals had no encoding at all - only single-character ones, which the
parser represents as a TScalar holding the character code.

Followed the original rather than inventing an encoding.  TPSRC8 pwrinlin
special-cases a literal sitting directly in a WRITE argument list - it
looks at the next character, and if that is ',' or ')' it is an argument
rather than an expression - and emits, per TPSRC10 estring:

    CALL wrtinl      <length byte> <character>...

with no stack argument.  TPSRC4 xwrtinl is what makes that work: POP BX
takes the return address, which is the address of the length byte, then
JMP BX at the end returns to just past the last character.  The literal
is therefore self-delimiting - no terminator, no length table, and
nothing at all in the data segment, which is why the emitted program
grows by exactly the literal's own bytes and data= is unchanged at 260.

Runtime: new wrtinl entry, 19 bytes at offset 8EH, verified by hand
against the 8086 table (8A 0F = MOV CL,[BX], 8A 07 = MOV AL,[BX],
E3 07 = JCXZ to the end label, E2 F9 = LOOP back 7, FF E3 = JMP BX).
Runtime is now 385 bytes, 14 entries.

Compiler: literals are collected into a pool as they are scanned, since
the text has to survive until IoCall knows it is writing rather than
computing.  ParseFactor marks them (kind 3) instead of rejecting them,
and LoadAtom now refuses any TString - that one guard covers assignment,
IF, WHILE, FOR, REPEAT, CASE and array subscripts, because they all reach
their operand through LoadAtom and none can use a counted string where a
16-bit word is expected.  So a string is a value in exactly one place and
a hard error everywhere else, never a silently wrong machine word.

Two bugs found by running it, both in the new code:

- Every program lost 6 bytes.  The FOR over the argument list needed a
  flag for "this argument pushed a value", and it was never initialised,
  so the first argument's CALL and its ADD SP,2 were skipped.  Only
  visible because expected.tsv pins code sizes.

- writeln('hi') emitted 02 69 00 - 'i' then NUL - because StrNew recorded
  the first character without advancing strTop, so the first StrPut landed
  on top of it and overwrote it.  t17_two_str is what pinned it down: its
  third emitted character was 'e', the *second* literal's character,
  which had been written into that slot.

Also refuses a literal of 256 characters or more (EConstRange, 45): the
length is one byte, so 300 characters went out behind a length of 44 and
the runtime would have printed 44 and silently dropped the rest.

Empty string is now a zero-length literal, reaching the runtime's JCXZ
path.  It used to be the scalar 39, so writeln('') printed a quote mark.

t02 t03 t05 t17 go from ERR 102 to OK, and toto.pas compiles (37 bytes).
Four fixtures added: t23 empty, t24 'don''t' (the doubled quote becomes
one character), t25 a literal used as a value (must stay ERR 102), t26
mixed scalar/string arguments.

27/27 compile matrix, tpshell 125136 bytes, uitest 10/10.  Still nothing
executable: the runtime is not yet copied into the compiler's code buffer,
so TU_WrInl is a placeholder offset and the wrtinl entry has never run.
Eric Streit před 2 týdny
rodič
revize
13a99c7fcf

+ 174 - 33
shell/Compiler.mod

@@ -86,19 +86,27 @@ CONST
    TkSet  = 36 ;  TkPacked  = 37 ; TkForward = 38 ; TkExternal = 39 ;
    TkAbsolute = 40 ; TkOverlay = 41 ; TkString = 42 ;
 
-   (* runtime entry offsets in the emitted image (TU_InitMem etc.) *)
-   TU_InitMem  = 8H ;
-   TU_ProgEnd  = 10H ;
-   TU_StackChk = 18H ;
+   (* Runtime entry offsets in the emitted image.
 
-   (* Standard-procedure runtime entries.  TP3 does NOT pass a descriptor:
+      Standard-procedure 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. *)
+      the runtime needs only the value.  Mirrored here.
+
+      These offsets are still PLACEHOLDERS on a fixed ladder.  The real
+      offsets are known - Runtime.RT_Entry derives them from the assembled
+      blob (wrtinl is really at 8EH) - but the compiler does not copy the
+      runtime into its code buffer yet, so it cannot call it, and using the
+      true offsets here would only look like it works.  They all get replaced
+      by RT_Entry in one go when the runtime is wired in. *)
+   TU_InitMem  = 8H ;
+   TU_ProgEnd  = 10H ;
+   TU_StackChk = 18H ;
    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 ;
+   TU_WrInl    = 70H ;  (* inline string literal; takes NO stack argument *)
 
    (* TP3 error numbers *)
    ENoSemi    = 1 ;  EPointExp  = 10 ;  ESimpType  = 30 ;
@@ -146,11 +154,13 @@ TYPE
    ERes =
       RECORD
          cls  : CARDINAL ;
-         kind : CARDINAL ;          (* 0 const, 1 var, 2 value in AX *)
+         kind : CARDINAL ;          (* 0 const, 1 var, 2 value in AX,
+                                       3 string literal (cls = TString) *)
          imm  : LONGINT ;
          idx  : CARDINAL ;
          boff : CARDINAL ;          (* constant fold-in for subscripts *)
          chr  : BOOLEAN ;           (* single-quoted literal, e.g. 'a' *)
+         strx : CARDINAL ;          (* string literal: index into strPool *)
       END ;
 
    DirRec = RECORD  rng, chk : BOOLEAN  END ;
@@ -164,6 +174,22 @@ VAR
 
    wrd  : ARRAY [0..MaxName] OF CHAR ;
 
+   (* String-literal pool.
+
+      TP3 does not put a literal in the data segment at all: it emits the
+      literal *inline in the code stream* as <length byte><characters>, and
+      the runtime entry "wrtinl" reads the length from the return address and
+      returns to just past the last character (TPSRC4 xwrtinl, TPSRC10
+      estring).  So nothing here ends up in the image as data - the pool only
+      has to survive from the moment the literal is scanned until IoCall
+      decides to emit it, because by then the parser has moved on. *)
+   strPool : ARRAY [0..4095] OF CHAR ;
+   strOff  : ARRAY [0..255] OF CARDINAL ;
+   strLen  : ARRAY [0..255] OF CARDINAL ;
+   strTop  : CARDINAL ;        (* next free byte in strPool *)
+   strCnt  : CARDINAL ;        (* literals collected so far *)
+   rdStrX  : CARDINAL ;        (* pool index of the literal RdConst just read *)
+
    symtab : ARRAY [0..MaxSym - 1] OF SymEntry ;
    symTop : CARDINAL ;
 
@@ -1100,10 +1126,56 @@ BEGIN
    v := acc
 END RdIntConst ;
 
+PROCEDURE StrNew (first : CARDINAL ; hasFirst : BOOLEAN ) : CARDINAL ;
+(* Open a pool slot for a string literal, optionally pre-seeded with its
+   first character.
+
+   RdConst has to read the first character before it can tell a one-character
+   literal from a longer one - the "is the next character another quote?"
+   test only makes sense once something has been read - so the seeding has to
+   happen here and has to advance strTop.  Leaving strTop alone and letting the
+   caller write the character by hand is a trap: strTop is the next FREE byte,
+   so the first StrPut lands on top of the seeded character and overwrites it.
+   (That bug shipped the literal 'hi' as 69 00 - 'i' then NUL.) *)
+VAR x : CARDINAL ;
+BEGIN
+   IF strCnt > HIGH (strOff) THEN
+      Err (ECompOvf) ;                     (* too many literals in one unit *)
+      RETURN 0
+   END ;
+   x := strCnt ;
+   strOff [x] := strTop ;
+   strLen [x] := 0 ;
+   INC (strCnt) ;
+   IF hasFirst THEN
+      strPool [strTop] := CHR (first) ;
+      INC (strTop) ;
+      strLen [x] := 1
+   END ;
+   rdStrX := x ;
+   RETURN x
+END StrNew ;
+
+PROCEDURE StrPut (x : CARDINAL ) ;
+(* append the current source character to pool slot x *)
+BEGIN
+   IF x > HIGH (strOff) THEN
+      RETURN
+   END ;
+   IF strTop > HIGH (strPool) THEN
+      Err (ECompOvf) ;                     (* literal longer than the pool *)
+      RETURN
+   END ;
+   strPool [strTop] := CurCh () ;
+   INC (strTop) ;
+   INC (strLen [x])
+END StrPut ;
+
 PROCEDURE RdConst (VAR v : LONGINT ; VAR cls : CARDINAL ;
                    VAR isStr : BOOLEAN) ;
-(* scalar or string constant.  String values (isStr) can only be
-   rejected with ENoLib by the caller. *)
+(* scalar or string constant.  A string literal's text is collected into the
+   pool and its slot index left in rdStrX; a single-character literal stays a
+   TScalar holding its character code, which is what "c := 'a'" wants. *)
 CONST q = AposC ;
 BEGIN
    isStr := FALSE ;
@@ -1132,9 +1204,15 @@ BEGIN
    ELSIF ORD (CurCh ()) = q THEN
       DropCh (GetCh ()) ;
       IF ORD (CurCh ()) = q THEN
+         (* '' - the empty string.  It used to be reported as the scalar 39,
+            so writeln('') printed a single quote mark.  It is a string of
+            length zero, and an inline zero-length literal is exactly what the
+            runtime's JCXZ path is for. *)
          DropCh (GetCh ()) ;
-         v := VAL (LONGINT, q) ;
-         cls := TScalar
+         isStr := TRUE ;
+         cls := TString ;
+         v := 0 ;
+         rdStrX := StrNew (0, FALSE)
       ELSIF (CurCh () = 0C) OR ((ORD (CurCh ()) = 0DH)) OR ((ORD (CurCh ()) = 0AH)) THEN
          Err (EUnknown)
       ELSE
@@ -1154,11 +1232,16 @@ BEGIN
                satisfied, and the scan runs on to end-of-buffer - which
                silently eats the rest of the program and makes every later
                error point at end-of-file.  Stop on the quote itself, and
-               treat a doubled quote as one embedded quote character. *)
+               treat a doubled quote as one embedded quote character.
+
+               The first character is already gone - it was read into v above -
+               so the pool slot is pre-seeded with it. *)
+            rdStrX := StrNew (VAL (CARDINAL, v), TRUE) ;
             LOOP
                IF ORD (CurCh ()) = q THEN
                   IF ORD (PeekAhead (1)) = q THEN
-                     DropCh (GetCh ()) ; DropCh (GetCh ())   (* '' inside *)
+                     StrPut (rdStrX) ;                  (* '' inside *)
+                     DropCh (GetCh ()) ; DropCh (GetCh ())
                   ELSE
                      EXIT                                (* closing quote *)
                   END
@@ -1166,6 +1249,7 @@ BEGIN
                   Err (EUnknown) ;                         (* unterminated *)
                   EXIT
                ELSE
+                  StrPut (rdStrX) ;
                   DropCh (GetCh ())
                END
             END ;
@@ -1199,8 +1283,20 @@ PROCEDURE EmCallMost (idx, nk : CARDINAL) ; FORWARD ;
 (* ---------------------------------------------------------------- *)
 
 PROCEDURE LoadAtom (VAR r : ERes) ;
-(* load value of r into AX (folding constants) *)
+(* load value of r into AX (folding constants).
+
+   A string literal is refused here, and this is the single place that has to:
+   assignment, IF, WHILE, FOR, REPEAT, CASE, array subscripts and every
+   operator all reach their operand through LoadAtom, and none of them can use
+   a counted string where a 16-bit word is expected.  Reporting it here rather
+   than in the parser means writeln('hi') still works - IoCall handles a
+   literal before it ever calls LoadAtom. *)
 BEGIN
+   IF r.cls = TString THEN
+      Err (ENoLib) ;                    (* string value used as a number *)
+      r.kind := 2 ;
+      RETURN
+   END ;
    IF r.kind = 0 THEN
       EmMovAxi (W16 (r.imm)) ;
       r.kind := 2
@@ -1559,8 +1655,13 @@ BEGIN
          RETURN
       END ;
       IF strf THEN
-         Err (ENoLib) ;
-         r.kind := 2 ;
+         (* A string literal is legal here as a *value* - it is not rejected
+            at this point, because writeln('hi') needs it and IoCall is the
+            only place that knows how to emit one.  Everywhere else the
+            literal has to end up as a machine word, and that is caught by
+            LoadAtom, which refuses a TString. *)
+         r.strx := rdStrX ;
+         r.kind := 3 ;
          RETURN
       END ;
       r.kind := 0 ;
@@ -1790,6 +1891,8 @@ PROCEDURE IoCall (idx : CARDINAL) ;
 VAR args : ARRAY [0..15] OF ERes ;
     nArgs, i, ent, which, acls : CARDINAL ;
     reading : BOOLEAN ;
+    pushed : BOOLEAN ;
+    n : CARDINAL ;
     dummy : ERes ;
 BEGIN
    which := symtab [idx].cls ;               (* BI_* *)
@@ -1833,6 +1936,7 @@ BEGIN
       to 65535 in CARDINAL and spin 65536 times. *)
    IF nArgs > 0 THEN
       FOR i := 0 TO nArgs - 1 DO
+      pushed := TRUE ;      (* default: value is on the stack -> call + pop *)
       IF reading THEN
          IF args [i].kind # 1 THEN
             Err (ETypeErr) ;                  (* READ needs a variable *)
@@ -1855,26 +1959,60 @@ BEGIN
          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
+         IF (acls = TString) AND (args [i].kind = 3) THEN
+            (* An inline string literal.  TP3 TPSRC8 pwrinlin special-cases a
+               literal that is followed directly by ',' or ')' - i.e. an
+               argument, not an expression - and emits
+                  CALL wrtinl  <length byte> <characters...>
+               with no stack argument at all; wrtinl reads the length from the
+               return address and returns to just past the last character.
+               Mirrored exactly, so the literal costs only its own characters
+               in the code stream and nothing in the data segment. *)
+            IF strLen [args [i].strx] > 255 THEN
+               (* The length is one byte, so a literal of 256 characters or
+                  more would wrap: 300 characters emitted behind a length of
+                  44, and the runtime would print 44 of them and silently drop
+                  the rest.  TP3 strings are at most 255 characters, so refuse
+                  rather than truncate. *)
+               Err (EConstRange) ;
+               RETURN
+            END ;
+            DropC (EmCall (TU_WrInl)) ;
+            Ebyte (VAL (BYTE, strLen [args [i].strx])) ;
+            n := 0 ;
+            WHILE n < strLen [args [i].strx] DO
+               Ebyte (VAL (BYTE, ORD (strPool [strOff [args [i].strx] + n]))) ;
+               INC (n)
+            END ;
+            pushed := FALSE                (* nothing was pushed for this one *)
          ELSE
-            ent := TU_WrChar
+            IF acls = TString THEN
+               (* A string *variable*.  Not emitted rather than emitted wrongly:
+                  EmPushVarAddr's local form is still wrong (see the note on
+                  that procedure), and a wrong address here would print
+                  garbage instead of failing. *)
+               Err (ENoLib) ;
+               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
       END ;
-      DropC (EmCall (ent)) ;
-      EmAddSp (2)                            (* one 16-bit argument *)
+      IF pushed THEN
+         DropC (EmCall (ent)) ;
+         EmAddSp (2)                         (* one 16-bit argument *)
+      END
       END
    END ;
    IF which = BI_WriteLn THEN
@@ -2705,6 +2843,9 @@ BEGIN
    srcLen := Length () ;
    pc := 0 ;
    dc := 100H ;
+   strTop := 0 ;
+   strCnt := 0 ;
+   rdStrX := 0 ;
    varspc := 0 ;
    symTop := 0 ;
    nPatch := 0 ;

+ 1 - 1
shell/Runtime.def

@@ -25,7 +25,7 @@ CONST
    E_WrInt   = 3 ;  E_WrChar  = 4 ;  E_WrBool  = 5 ;
    E_WrReal  = 6 ;  E_WrLn    = 7 ;
    E_RdInt   = 8 ;  E_RdChar  = 9 ;  E_RdBool  = 10 ;
-   E_RdLn    = 11 ; E_Halt    = 12 ;
+   E_RdLn    = 11 ; E_Halt    = 12 ; E_WrInl   = 13 ;
 
 PROCEDURE RT_Build () ;
 (* assemble the runtime; idempotent, called once at Compile time *)

+ 45 - 2
shell/Runtime.mod

@@ -60,7 +60,7 @@ VAR
    nfix   : CARDINAL ;
    dataAt : CARDINAL ;
    built  : BOOLEAN ;
-   entNm  : ARRAY [0..12] OF ARRAY [0..MaxNm] OF CHAR ;
+   entNm  : ARRAY [0..13] OF ARRAY [0..MaxNm] OF CHAR ;
 
 (* ---------------------------------------------------------------- *)
 (*  name helpers                                                     *)
@@ -255,6 +255,10 @@ PROCEDURE MovSiBx  ; BEGIN B (89H) ; B (0DCH) END MovSiBx ;
 PROCEDURE MovDiDx  ; BEGIN B (89H) ; B (0D7H) END MovDiDx ;
 PROCEDURE MovDiAx  ; BEGIN B (89H) ; B (0C7H) END MovDiAx ;
 PROCEDURE AddDiAx  ; BEGIN B (1H) ; B (0C7H) END AddDiAx ;
+PROCEDURE IncBx    ; BEGIN B (43H) END IncBx ;
+PROCEDURE MovAlBx  ; BEGIN B (8AH) ; B (07H) END MovAlBx ;  (* 8A 07: AL:=[BX] *)
+PROCEDURE MovClBx  ; BEGIN B (8AH) ; B (0FH) END MovClBx ;  (* 8A 0F: CL:=[BX] *)
+PROCEDURE JmpBx    ; BEGIN B (0FFH) ; B (0E3H) END JmpBx ;  (* FF E3: JMP BX *)
 (* JE 74  JNE 75  JB 72  JBE 76  JGE 7D *)
 PROCEDURE Je8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (74H, nm) END Je8 ;
 PROCEDURE Jne8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (75H, nm) END Jne8 ;
@@ -262,6 +266,8 @@ PROCEDURE Jb8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (72H, nm) END Jb8 ;
 PROCEDURE Jbe8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (76H, nm) END Jbe8 ;
 PROCEDURE Jge8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7DH, nm) END Jge8 ;
 PROCEDURE Ja8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (77H, nm) END Ja8 ;
+PROCEDURE Jcxz8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E3H, nm) END Jcxz8 ;
+PROCEDURE Loop8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E2H, nm) END Loop8 ;
 
 (* ---------------------------------------------------------------- *)
 (*  the entries                                                      *)
@@ -371,6 +377,41 @@ BEGIN
    RetR
 END EmitWrChar ;
 
+PROCEDURE EmitWrInl ;
+(* Write an inline string literal - TP3 TPSRC4 "xwrtinl".
+
+   The compiler emits
+
+       CALL wrtinl      <length byte> <character>...
+
+   so the return address on the stack points at the length byte that follows
+   the call.  POP BX takes that address, CX picks up the length, and the
+   routine finishes with JMP BX - returning to just past the last character.
+   That is the whole trick: the literal is self-delimiting, so it needs no
+   terminator, no length table and no space in the data segment, and it costs
+   the code stream only the characters themselves (TPSRC10 "estring" emits
+   exactly <length byte><chars> for the same reason).
+
+   Consequently this entry has NO stack argument, unlike WrInt/WrChar: the
+   return address has already been consumed by the POP. *)
+BEGIN
+   M ("wrtinl") ;
+   PopBx ;                           (* BX := address of the length byte *)
+   XorCxCx ;
+   MovClBx ;                         (* CX := length *)
+   IncBx ;                           (* BX -> first character *)
+   MovAh (2) ;                       (* INT 21h/02h: put character, AL *)
+   Jcxz8 ("wn_end") ;                (* empty string -> nothing to do *)
+   M ("wn_loop") ;
+   MovAlBx ;                         (* AL := next character *)
+   Int21 ;                           (* (preserves every register but AL) *)
+   IncBx ;
+   Loop8 ("wn_loop") ;
+   M ("wn_end") ;
+   JmpBx                             (* resume past the string; no RET here,
+                                       the return address is already gone *)
+END EmitWrInl ;
+
 PROCEDURE EmitWrBool ;
 BEGIN
    M ("wrbool") ;
@@ -569,6 +610,7 @@ BEGIN
    EmitEnd ;
    EmitStackChk ;
    EmitWrInt ; EmitWrChar ; EmitWrBool ; EmitWrReal ; EmitWrLn ;
+   EmitWrInl ;
    EmitRdInt ; EmitRdChar ; EmitRdBool ; EmitRdLn ;
    EmitGetCh ;
    EmitData ;
@@ -586,6 +628,7 @@ BEGIN
    SetStr (entNm [10], "rdbool") ;
    SetStr (entNm [11], "rdln") ;
    SetStr (entNm [12], "halt") ;
+   SetStr (entNm [13], "wrtinl") ;
    built := TRUE
 END RT_Build ;
 
@@ -613,7 +656,7 @@ BEGIN
    IF NOT built THEN
       RT_Build ()
    END ;
-   IF i > 12 THEN
+   IF i > 13 THEN
       RETURN 0
    END ;
    RETURN LblOff (entNm [i])

+ 10 - 6
shell/tests/RtProbe.mod

@@ -65,12 +65,12 @@ END PENT ;
 
 PROCEDURE Main ;
 VAR i, n : CARDINAL ;
-    names : ARRAY [0..12] OF ARRAY [0..15] OF CHAR ;
+    names : ARRAY [0..13] OF ARRAY [0..15] OF CHAR ;
 BEGIN
    RT_Build () ;
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    i := 0 ;
-   WHILE i <= 12 DO
+   WHILE i <= 13 DO
       names [i] := "" ;
       INC (i)
    END ;
@@ -78,17 +78,21 @@ BEGIN
    names [3] := "wrint" ;   names [4] := "wrchar" ;  names [5] := "wrbool" ;
    names [6] := "wrreal" ;  names [7] := "wrln" ;    names [8] := "rdint" ;
    names [9] := "rdchar" ;  names [10] := "rdbool" ; names [11] := "rdln" ;
-   names [12] := "halt" ;
+   names [12] := "halt" ;   names [13] := "wrtinl" ;
    i := 0 ;
-   WHILE i <= 12 DO
+   WHILE i <= 13 DO
       PENT (i, names [i]) ;
       INC (i)
    END ;
    PS ("  hex:") ; NL ;
    i := 0 ;
    WHILE i < RT_Size () DO
-      PHEX ((i DIV 65536) MOD 16) ; PHEX ((i DIV 4096) MOD 16) ;
-      PHEX ((i DIV 256) MOD 16) ; PHEX (i MOD 16) ;
+      (* eight hex digits of the 32-bit offset, one byte per PHEX call
+         (PHEX prints two digits), most significant byte first *)
+      PHEX ((i DIV 16777216) MOD 256) ;
+      PHEX ((i DIV 65536) MOD 256) ;
+      PHEX ((i DIV 256) MOD 256) ;
+      PHEX (i MOD 256) ;
       PS ("  ") ;
       n := 0 ;
       WHILE (n < 16) AND (i + n < RT_Size ()) DO

+ 19 - 9
shell/tests/fixtures/expected.tsv

@@ -14,17 +14,23 @@
 # expectation has to change because the compiler legitimately improved, change
 # it in the same commit as the fix and say why in the message.
 #
-# ERR 102 = ENoLib, the original's "not implemented" path.  The five ERR rows
-# below are all unimplemented features, not parser bugs:
-#   t02 t03 t05 t17  multi-character string literal (string runtime pending)
-#   t14               'array [..] of <type>' at its point of use
-#   uierror           deliberate syntax error, pinned by the editor UI test
+# ERR 102 = ENoLib, the original's "not implemented" path.  The remaining ERR
+# rows are unimplemented features, not parser bugs:
+#   t14       'array [..] of <type>' at its point of use
+#   t25       a string literal used where a 16-bit word is wanted
+#   uierror   deliberate syntax error, pinned by the editor UI test
+#
+# t02 t03 t05 t17 used to be ERR 102 as well: a multi-character literal was
+# rejected because writeln had no string support.  They compile now, via the
+# inline-string path (CALL wrtinl, then <length><chars> in the code stream -
+# TPSRC8 pwrinlin / TPSRC4 xwrtinl), so their rows changed from ERR to OK and
+# their code sizes went up by the literal's own bytes.
 
 t01_minimal	OK	26	260
-t02_writeln	ERR	102	33
-t03_inline_comment	ERR	102	41
+t02_writeln	OK	35	260
+t03_inline_comment	OK	35	260
 t04_var	OK	45	262
-t05_own_line_comment	ERR	102	65
+t05_own_line_comment	OK	35	260
 t06_two_args	OK	49	260
 t07_big	OK	99	262
 t08_const	OK	32	262
@@ -36,10 +42,14 @@ t13_proc	OK	50	262
 t14_types	ERR	102	83
 t15_label	OK	35	262
 t16_str1	OK	39	260
-t17_two_str	ERR	102	34
+t17_two_str	OK	42	260
 t18_writeln_bare	OK	29	260
 t19_int1	OK	39	260
 t20_str3	OK	59	260
 t21_mixed	OK	59	260
 t22_case	OK	93	262
+t23_str_empty	OK	33	260
+t24_str_quote	OK	38	260
+t25_str_as_value	ERR	102	48
+t26_str_mixed_args	OK	55	260
 uierror	ERR	41	331

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

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

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

@@ -0,0 +1,4 @@
+program t24;
+begin
+  writeln('don''t')
+end.

+ 5 - 0
shell/tests/fixtures/t25_str_as_value.pas

@@ -0,0 +1,5 @@
+program t25;
+var i : integer;
+begin
+  i := 'ab'
+end.

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

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