Просмотр исходного кода

calc: VAR string parameters and Chr (ladder 23700)

A formal `var X : string[n]` now passes the caller's address in its two-byte
slot instead of being refused with ENoLib.  The callee's whole-string
assignment copies through that address with strstore (source address, then
destination loaded from the slot); Length reads the length byte through it;
writeln, concatenation, comparison and Read already know how to use it.
String elements x[i] and x[0] compute the target address from the slot, so
constant and variable indices both work, and ParseCall now handles a VAR
formal in a function call as well as ParseCallArgs does for procedures.

Chr(n) is a builtin too: a constant folds to a CHAR, otherwise the ordinal is
loaded and its class becomes CHAR.  This was the next CALC blocker after the
VAR string declaration (Line[0] := chr(8)).

t89_varstr exercises all of it and runs under qemu and Exec86 with the
hand-derived output hello / 5 / Hello! / H.  The CALC ladder moves
22706 -> 22859 -> 23700; the next blocker is typed-file data I/O:
write(MCfile, Sheet[I,J]) in Save.

Verified: compile matrix 90/90, ladder 1/1, 81 .COM linked, 79 executed under
both qemu and Exec86, rt_exec 276/276, nonvacuity 121/121, run_all ALL PASS.
Eric Streit 2 дней назад
Родитель
Сommit
02d5b6e459

+ 12 - 6
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | position | blocker |
 |---|---|
 |---|---|
-| **22706** | `var Line : AnyString` in `GetFileName` — VAR string parameters (`ERR 102`) |
+| **23700** | `write(MCfile, Sheet[I,J])` in `Save` — typed-file data I/O (`ERR 102`) |
 
 
 Rungs behind it (now passed):
 Rungs behind it (now passed):
 
 
@@ -135,6 +135,7 @@ Rungs ahead:
 |---|---|
 |---|---|
 | 22280 | file operations (`Assign`, `Reset`, `Rewrite`, `Close`, `IoResult`) - done by the file control-block rung |
 | 22280 | file operations (`Assign`, `Reset`, `Rewrite`, `Close`, `IoResult`) - done by the file control-block rung |
 | 22706 | `var Line : AnyString` - a by-reference string parameter |
 | 22706 | `var Line : AnyString` - a by-reference string parameter |
+| 23700 | typed-file data write (`write(MCfile, Sheet[I,J])`) |
 
 
 Corrections the measurements force, worth stating plainly because the stage list
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
 below was written before them:
@@ -454,10 +455,10 @@ calling convention and string value parameters, `Length`, the CRT identifiers,
 subscripts, write field widths, WITH with n-dimensional subscripts, set-field
 subscripts, write field widths, WITH with n-dimensional subscripts, set-field
 assignment, string fields through DI, REAL constants, UpCase, run-time set
 assignment, string fields through DI, REAL constants, UpCase, run-time set
 membership, string fields in WRITE, real output, run-time set algebra,
 membership, string fields in WRITE, real output, run-time set algebra,
-`Succ`/`Pred`, the original memory layout, the untyped file type, and the
-file control-block operations). The
-ladder has moved from the first typed constant at 7,791 to **22,706**, where
-`var Line : AnyString` is the first by-reference string parameter.
+`Succ`/`Pred`, the original memory layout, the untyped file type, the
+file control-block operations, VAR string parameters and `Chr`). The
+ladder has moved from the first typed constant at 7,791 to **23,700**, where
+`write(MCfile, Sheet[I,J])` asks for typed-file data I/O.
 
 
 The rung commits and their tags, in order (each is one rung with its own
 The rung commits and their tags, in order (each is one rung with its own
 fixture, red proof, and — where the harness allows — execution under qemu and
 fixture, red proof, and — where the harness allows — execution under qemu and
@@ -494,7 +495,8 @@ Exec86):
 | `203f77e` | `v-TP3-CALC-SETOPS` | `ERR 98 20912` (layout limit reached) |
 | `203f77e` | `v-TP3-CALC-SETOPS` | `ERR 98 20912` (layout limit reached) |
 | `ff05141` | `v-TP3-CALC-LAYOUT` | `ERR 1 22253` (untyped file, initially misread as a function) |
 | `ff05141` | `v-TP3-CALC-LAYOUT` | `ERR 1 22253` (untyped file, initially misread as a function) |
 | `ed9e790` | `v-TP3-CALC-UNTYPEDFILE` | `ERR 41 22280` (`assign`) |
 | `ed9e790` | `v-TP3-CALC-UNTYPEDFILE` | `ERR 41 22280` (`assign`) |
-| *(this commit)* | `v-TP3-CALC-FILEOPS` | **`ERR 102 22706`** (VAR string parameter) |
+| `ab7cced` | `v-TP3-CALC-FILEOPS` | `ERR 102 22706` (VAR string parameter) |
+| *(this commit)* | `v-TP3-CALC-VARSTR` | **`ERR 102 23700`** (typed-file data write) |
 
 
 - **Code HEAD** is the layout rung (`v-TP3-CALC-LAYOUT`).  Nothing is pushed.
 - **Code HEAD** is the layout rung (`v-TP3-CALC-LAYOUT`).  Nothing is pushed.
   The terminal-config work (`v-TP3-TERMCFG`) and the editor key map
   The terminal-config work (`v-TP3-TERMCFG`) and the editor key map
@@ -536,6 +538,10 @@ Exec86):
   Fixture `t64_arrays` (compile-only because it has no `.out`; its ~16 KB
   Fixture `t64_arrays` (compile-only because it has no `.out`; its ~16 KB
   image now fits the raised 0x7000-byte read). `t14` re-baselined: the array
   image now fits the raised 0x7000-byte read). `t14` re-baselined: the array
   DECLARES now; the refusal moved to element access.
   DECLARES now; the refusal moved to element access.
+- **VAR string parameters and `Chr` are landed (`t89_varstr`).**  The
+  parameter slot holds the caller's address; assignment, `Read`, `Length`,
+  `writeln`, concatenation, comparison and `x[i]` all go through that address.
+  `Chr(n)` folds or loads an ordinal and yields a CHAR.
 - **File TYPES and the control-block OPERATIONS are landed (Stage 13).**
 - **File TYPES and the control-block OPERATIONS are landed (Stage 13).**
   `text`, `file of T`, and untyped `file`; a file variable is our control block
   `text`, `file of T`, and untyped `file`; a file variable is our control block
   (`FileVarSize` = 132: handle, mode, 128-byte NUL-terminated name).  The
   (`FileVarSize` = 132: handle, mode, 128-byte NUL-terminated name).  The

+ 4 - 4
SUMMARY.md

@@ -2044,7 +2044,7 @@ the compiler *emitting* a 16,560-byte program). The ratchet and front-end
 features through **file control-block operations and the original memory
 features through **file control-block operations and the original memory
 layout** are landed: the ladder (`tests/calc_ladder.sh` +
 layout** are landed: the ladder (`tests/calc_ladder.sh` +
 `tests/fixtures/calc_ladder.tsv`, run by `run_all.sh`; CALC.PAS now stops at
 `tests/fixtures/calc_ladder.tsv`, run by `run_all.sh`; CALC.PAS now stops at
-`ERR 102` at pos 22706, `var Line : AnyString` in `GetFileName`), the `{$I}` include,
+`ERR 102` at pos 23700, `write(MCfile, Sheet[I,J])` in `Save`), the `{$I}` include,
 `^X`/`#nn`, scalar typed constants, sets, enums, records (CellRec = 80),
 `^X`/`#nn`, scalar typed constants, sets, enums, records (CellRec = 80),
 subranges, arrays, element/field access, file types, string value parameters,
 subranges, arrays, element/field access, file types, string value parameters,
 `Length`, the CRT identifiers (`ClrScr`/`GotoXY`/`ClrEol`/`LowVideo`/
 `Length`, the CRT identifiers (`ClrScr`/`GotoXY`/`ClrEol`/`LowVideo`/
@@ -2058,9 +2058,9 @@ the measured 6-byte REAL constants (`t80_realconst`, with a byte-level check),
 `UpCase` and run-time set membership (`t81_upcase`, `t82_setin`), and
 `UpCase` and run-time set membership (`t81_upcase`, `t82_setin`), and
 real output (`t84_realwrite`), run-time set algebra and `Succ`/`Pred`
 real output (`t84_realwrite`), run-time set algebra and `Succ`/`Pred`
 (`t85`/`t86`), the original code-only `.COM` layout (§3.2), the untyped `file`
 (`t85`/`t86`), the original code-only `.COM` layout (§3.2), the untyped `file`
-type (`t87`), and file control-block operations (`t88`: `Assign`/`Reset`/
-`Rewrite`/`Close`/`IoResult`; data I/O is still refused). The next rung is a
-`var` string parameter. The runtime is 3,907 bytes / 39 entries and its probe
+type (`t87`), file control-block operations (`t88`: `Assign`/`Reset`/
+`Rewrite`/`Close`/`IoResult`; data I/O is still refused), and VAR string
+parameters plus `Chr` (`t89`). The next rung is typed-file data I/O. The runtime is 3,907 bytes / 39 entries and its probe
 scaffold is nearly full, so the next runtime addition must move HDR. Items 1-4
 scaffold is nearly full, so the next runtime addition must move HDR. Items 1-4
 below are independent of both tracks.
 below are independent of both tracks.
 
 

+ 134 - 11
shell/Compiler.mod

@@ -140,7 +140,7 @@ CONST
       the later Reset/Rewrite.  IOResult is an expression; EndOfFile is the
       the later Reset/Rewrite.  IOResult is an expression; EndOfFile is the
       next file increment. *)
       next file increment. *)
    BI_Assign = 16 ; BI_Reset = 17 ; BI_Rewrite = 18 ;
    BI_Assign = 16 ; BI_Reset = 17 ; BI_Rewrite = 18 ;
-   BI_Close = 19 ; BI_IoResult = 20 ;
+   BI_Close = 19 ; BI_IoResult = 20 ; BI_Chr = 21 ;
    (* the sub-codes EmCrtSeq takes *)
    (* the sub-codes EmCrtSeq takes *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -1381,6 +1381,9 @@ END EmStDiGlob ;
 PROCEDURE EmLdAlDi () ;
 PROCEDURE EmLdAlDi () ;
 BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ;    (* 8A 05: AL := [DI] *)
 BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ;    (* 8A 05: AL := [DI] *)
 
 
+PROCEDURE EmMovDiAx () ;
+BEGIN Ebyte (89H) ; Ebyte (0C7H) END EmMovDiAx ;  (* 89 C7: DI := AX *)
+
 PROCEDURE EmLdAxDi () ;
 PROCEDURE EmLdAxDi () ;
 BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ;    (* 8B 05: AX := [DI] *)
 BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ;    (* 8B 05: AX := [DI] *)
 
 
@@ -2446,7 +2449,25 @@ BEGIN
                   Err (ESimpType) ;
                   Err (ESimpType) ;
                   RETURN
                   RETURN
                END ;
                END ;
-               IF t.kind = 0 THEN
+               IF symtab [r.idx].isVar THEN
+                  (* VAR string parameter: the base is the address in the
+                     parameter slot, not LEA of the slot.  Compute DI once for
+                     both constant and variable indices, so LoadAtom and
+                     Assignment see the same kind-5 character address they do
+                     for an ordinary string. *)
+                  EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
+                  EmMovDiAx () ;
+                  IF t.kind = 0 THEN
+                     EmAddDiImm ((r.boff + W16 (t.imm)) MOD 10000H)
+                  ELSE
+                     IF r.boff # 0 THEN
+                        EmAddDiImm (r.boff)
+                     END ;
+                     LoadAtom (t) ;
+                     EmAddDiAx ()
+                  END ;
+                  r.kind := 5
+               ELSIF t.kind = 0 THEN
                   (* constant index: fold it into boff, as an array's does, and
                   (* constant index: fold it into boff, as an array's does, and
                      r.cls drops to TChar so every consumer below - LoadAtom,
                      r.cls drops to TChar so every consumer below - LoadAtom,
                      Assignment, IoCall - sees a one-byte value instead of the
                      Assignment, IoCall - sees a one-byte value instead of the
@@ -3012,8 +3033,21 @@ BEGIN
          `if Sheet[UFX,UFY].Contents <> '' then'. *)
          `if Sheet[UFX,UFY].Contents <> '' then'. *)
       EmPushDi ()
       EmPushDi ()
    ELSIF r.kind = 1 THEN
    ELSIF r.kind = 1 THEN
-      EmPushVarAddr (symtab [r.idx].local,
-                     (symtab [r.idx].off + r.boff) MOD 10000H)
+      IF symtab [r.idx].isVar THEN
+         (* A VAR string parameter: the slot at [BP+off] holds the address of
+            the caller's characters, so push its CONTENTS, not the address of
+            the slot.  boff is zero for the whole string; an element/subscript
+            is kind 5 and handled above. *)
+         IF r.boff # 0 THEN
+            Err (ENoLib)
+         ELSE
+            EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
+            EmPushAx ()
+         END
+      ELSE
+         EmPushVarAddr (symtab [r.idx].local,
+                        (symtab [r.idx].off + r.boff) MOD 10000H)
+      END
    ELSIF r.kind = 3 THEN
    ELSIF r.kind = 3 THEN
       EmPushVarAddr (FALSE, EmStrBlob (r))  (* the literal travels inline *)
       EmPushVarAddr (FALSE, EmStrBlob (r))  (* the literal travels inline *)
    ELSE
    ELSE
@@ -3919,6 +3953,34 @@ BEGIN
          fixture had ever exercised the fold. *)
          fixture had ever exercised the fold. *)
       ParseVar (r) ;
       ParseVar (r) ;
       RETURN
       RETURN
+   ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_Chr) THEN
+      (* Chr(n): the character with code n.  A constant folds; otherwise the
+         integer is loaded and its class becomes CHAR.  The value is one byte,
+         so an assignment stores AL and a CHAR writer uses AL. *)
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      ParseExpr (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF (r.cls # TScalar) AND (r.cls # TChar) THEN
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      IF r.kind = 0 THEN
+         r.imm := VAL (LONGINT, W16 (r.imm) MOD 256) ;
+         r.chr := TRUE
+      ELSE
+         LoadAtom (r) ;
+         r.kind := 2 ;
+         r.chr := FALSE
+      END ;
+      r.cls := TChar ;
+      r.sz := 1 ;
+      RETURN
    ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_IoResult) THEN
    ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_IoResult) THEN
       (* IOResult: the last file operation's DOS status; reading it clears the
       (* IOResult: the last file operation's DOS status; reading it clears the
          slot in the runtime.  It is a no-argument function. *)
          slot in the runtime.  It is a no-argument function. *)
@@ -4034,7 +4096,15 @@ BEGIN
          Err (ETypeErr) ;
          Err (ETypeErr) ;
          RETURN
          RETURN
       END ;
       END ;
-      IF r.kind = 1 THEN
+      IF (r.kind = 1) AND symtab [r.idx].isVar THEN
+         (* VAR string: the slot holds the address; read the length byte
+            through that pointer. *)
+         IF r.boff # 0 THEN
+            Err (ENoLib)
+         ELSE
+            EmLoadVarInd (symtab [r.idx].off, 1)
+         END
+      ELSIF r.kind = 1 THEN
          EmLoadVar (symtab [r.idx].local,
          EmLoadVar (symtab [r.idx].local,
                     (symtab [r.idx].off + r.boff) MOD 10000H, 1)
                     (symtab [r.idx].off + r.boff) MOD 10000H, 1)
       ELSIF r.kind = 3 THEN
       ELSIF r.kind = 3 THEN
@@ -4214,7 +4284,28 @@ BEGIN
             END ;
             END ;
             ParseExpr (arg) ;
             ParseExpr (arg) ;
             slot := ParmSlot (idx, nArgs) ;
             slot := ParmSlot (idx, nArgs) ;
-            IF slot > 2 THEN
+            IF ParmIsVar (idx, nArgs) THEN
+               (* A VAR formal in a FUNCTION call: the callee wants the
+                  address, exactly as ParseCallArgs does for a procedure.  This
+                  path was missing, so `Length(s)' inside a function whose
+                  formal is `var s' pushed the string's VALUE and the callee
+                  would have read it as an address. *)
+               IF arg.kind # 1 THEN
+                  Err (ENoLib) ;
+                  EXIT
+               END ;
+               IF symtab [arg.idx].isVar THEN
+                  IF arg.boff # 0 THEN
+                     Err (ENoLib) ;
+                     EXIT
+                  END ;
+                  EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
+                  EmPushAx ()
+               ELSE
+                  EmPushVarAddr (symtab [arg.idx].local,
+                                 (symtab [arg.idx].off + arg.boff) MOD 10000H)
+               END
+            ELSIF slot > 2 THEN
                (* see ParseCallArgs: push the whole string slot *)
                (* see ParseCallArgs: push the whole string slot *)
                IF arg.cls # TString THEN
                IF arg.cls # TString THEN
                   Err (ETypeErr) ;
                   Err (ETypeErr) ;
@@ -4527,6 +4618,29 @@ BEGIN
       END ;
       END ;
       RETURN
       RETURN
    END ;
    END ;
+   IF (r.kind = 1) AND (r.cls = TString) AND symtab [r.idx].isVar THEN
+      (* A VAR string parameter: the slot holds the caller's string address.
+         Copy through the runtime, exactly as a normal string variable does:
+         source address first, destination address second, limit in CX.  This
+         covers literals and whole-string expressions alike; the destination
+         address is loaded from the parameter slot rather than formed with
+         LEA, which would point at the slot itself. *)
+      ParseExpr (src) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF src.cls # TString THEN
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      EmPushStrAddr (src) ;
+      EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
+      EmPushAx () ;
+      EmMovCxi ((VarSize (r) - 1) MOD 10000H) ;
+      DropC (EmCall (TU_StrStore)) ;
+      EmAddSp (4) ;
+      RETURN
+   END ;
    IF (r.kind = 1) AND symtab [r.idx].isVar THEN
    IF (r.kind = 1) AND symtab [r.idx].isVar THEN
       (* `varparam := expr': store through the address the slot holds.  DI is
       (* `varparam := expr': store through the address the slot holds.  DI is
          parked across the right-hand side because that expression may use DI
          parked across the right-hand side because that expression may use DI
@@ -5063,6 +5177,11 @@ BEGIN
                         Write(Contents)') already HAS its address in DI. *)
                         Write(Contents)') already HAS its address in DI. *)
                      IF arg.kind = 5 THEN
                      IF arg.kind = 5 THEN
                         EmPushDi ()
                         EmPushDi ()
+                     ELSIF symtab [arg.idx].isVar THEN
+                        (* VAR string: the slot holds the address of the
+                           caller's characters; push that, not the slot. *)
+                        EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
+                        EmPushAx ()
                      ELSE
                      ELSE
                         EmPushVarAddr (symtab [arg.idx].local,
                         EmPushVarAddr (symtab [arg.idx].local,
                                        (symtab [arg.idx].off + arg.boff) MOD 10000H)
                                        (symtab [arg.idx].off + arg.boff) MOD 10000H)
@@ -6404,11 +6523,13 @@ BEGIN
             END ;
             END ;
             ExpectDelim (':', ENoSemi) ;   (* formal is 'name : type' *)
             ExpectDelim (':', ENoSemi) ;   (* formal is 'name : type' *)
             ParseType (cls, size, elem) ;
             ParseType (cls, size, elem) ;
-            IF groupVar AND ((size > 2) OR (cls = TString)) THEN
-               (* A VAR parameter of a record, array or string would need the
-                  callee to address through a larger object (or a counted
-                  string) than the scalar [BX] paths below; refusing is the
-                  honest answer, not quietly passing it by value. *)
+            IF groupVar AND (size > 2) AND (cls # TString) THEN
+               (* A VAR parameter of a record or array would need the callee
+                  to address through a larger object than the scalar [BX]
+                  paths; refusing is the honest answer.  A VAR STRING is the
+                  exception: its slot is the ADDRESS of the characters (two
+                  bytes), so the callee can hand that address to the string
+                  runtime exactly as it hands a global's address. *)
                Err (ENoLib) ;
                Err (ENoLib) ;
                RETURN
                RETURN
             END ;
             END ;
@@ -6728,6 +6849,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    symtab [i].defnd := TRUE ;
    i := NewSym ("IORESULT", KBuiltin, BI_IoResult, 0, 0, 0, 0, FALSE) ;
    i := NewSym ("IORESULT", KBuiltin, BI_IoResult, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
    symtab [i].defnd := TRUE ;
+   i := NewSym ("CHR", KBuiltin, BI_Chr, 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
    (* KBD: the console keyboard as a TEXT file.  This runtime's read entries
    (* KBD: the console keyboard as a TEXT file.  This runtime's read entries
       already read the console, so `Read(Kbd, Ch)' drops the file argument and
       already read the console, so `Read(Kbd, Ch)' drops the file argument and
       reads a character exactly as `Read(Ch)' does. *)
       reads a character exactly as `Read(Ch)' does. *)

+ 8 - 9
shell/tests/fixtures/calc_ladder.tsv

@@ -25,12 +25,11 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 # remembered one.
 #
 #
-# Current rung (2026-10-22): `var Line : AnyString' on CALC.INC's GetFileName.
-# UpCase, run-time set membership, string fields through DI, the original
-# memory layout, untyped-file declarations and the file control-block
-# operations moved the ladder 15911 -> 18267 -> 19847 -> 20912 -> 22253 ->
-# 22280 -> 22706.  The function declaration itself was never the blocker;
-# `file' required an OF, and then Assign/Reset/IOResult/Close were missing.
-# The next blocker is a VAR parameter of string type, which ProcFunc refuses
-# with ENoLib (TP3 error 102).
-CALC.PAS	ERR	102	22706
+# Current rung (2026-10-22): `write(MCfile, Sheet[I,J])' in Save.  UpCase,
+# run-time set membership, string fields through DI, the original memory
+# layout, untyped-file declarations, file control-block operations, VAR string
+# parameters and Chr moved the ladder 15911 -> 18267 -> 19847 -> 20912 ->
+# 22253 -> 22280 -> 22706 -> 22859 -> 23700.  The next blocker is DATA I/O on
+# a typed file: a leading TFile argument to write/read, still refused with
+# ENoLib (TP3 error 102).
+CALC.PAS	ERR	102	23700

+ 6 - 0
shell/tests/fixtures/expected.tsv

@@ -637,3 +637,9 @@ t87_untypedfile	OK	62	137
 #                   the missing-file path (CF=1, AX=2) in both oracles; the
 #                   the missing-file path (CF=1, AX=2) in both oracles; the
 #                   success path needs real DOS.
 #                   success path needs real DOS.
 t88_fileops	OK	109	137
 t88_fileops	OK	109	137
+
+#   t89_varstr           VAR string parameters: a callee writes through the
+#                   caller's address slot (whole string, x[1], x[i]), reads
+#                   Length through it, and a function takes a VAR string.  The
+#                   output is hand-derived from the Pascal: hello, 5, Hello!, H.
+t89_varstr	OK	390	276

+ 4 - 0
shell/tests/fixtures/t89_varstr.out

@@ -0,0 +1,4 @@
+hello
+5
+Hello!
+H

+ 52 - 0
shell/tests/fixtures/t89_varstr.pas

@@ -0,0 +1,52 @@
+program t89_varstr;
+
+{ t89 -- VAR string parameters.  CALC.INC's GetFileName is
+
+      procedure GetFileName(var Line : AnyString; FileType : String3);
+
+  and the callee must operate on the CALLER's string, not on a copy.  This
+  exercises the address slot for the whole variable, a constant-index element
+  (x[1]), a variable-index element (x[i]), Length, assignment of a literal and
+  of a concatenation, and a function whose formal is VAR string.
+
+  Hand-derived output:
+      hello        setit copies the literal through the caller's address
+      5            Length reads the length byte through that address
+      Hello!       upd writes x[1] and x[0], then appends through the address
+      H            the same element read back
+}
+
+var
+  S : string[10];
+  I : integer;
+
+procedure setit (var X : string[10]);
+begin
+  X := 'hello'
+end;
+
+procedure upd (var X : string[10]);
+var
+  I : integer;
+begin
+  X[1] := 'H';
+  X[0] := chr (5);
+  for I := 1 to Length (X) do
+    X[I] := X[I];
+  X := X + '!'
+end;
+
+function size (var X : string[10]) : integer;
+begin
+  size := Length (X)
+end;
+
+begin
+  setit (S);
+  writeln (S);
+  writeln (size (S));
+  upd (S);
+  writeln (S);
+  I := 1;
+  writeln (S[I])
+end.

+ 5 - 0
shell/tests/nonvacuity.sh

@@ -1137,6 +1137,11 @@ p = 'Compiler.mod'
 s = open(p).read()
 s = open(p).read()
 old = """                     IF arg.kind = 5 THEN
 old = """                     IF arg.kind = 5 THEN
                         EmPushDi ()
                         EmPushDi ()
+                     ELSIF symtab [arg.idx].isVar THEN
+                        (* VAR string: the slot holds the address of the
+                           caller's characters; push that, not the slot. *)
+                        EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
+                        EmPushAx ()
                      ELSE
                      ELSE
                         EmPushVarAddr (symtab [arg.idx].local,
                         EmPushVarAddr (symtab [arg.idx].local,
                                        (symtab [arg.idx].off + arg.boff) MOD 10000H)
                                        (symtab [arg.idx].off + arg.boff) MOD 10000H)