Ver Fonte

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 há 2 dias atrás
pai
commit
02d5b6e459

+ 12 - 6
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | 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):
 
@@ -135,6 +135,7 @@ Rungs ahead:
 |---|---|
 | 22280 | file operations (`Assign`, `Reset`, `Rewrite`, `Close`, `IoResult`) - done by the file control-block rung |
 | 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
 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
 assignment, string fields through DI, REAL constants, UpCase, run-time set
 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
 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) |
 | `ff05141` | `v-TP3-CALC-LAYOUT` | `ERR 1 22253` (untyped file, initially misread as a function) |
 | `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.
   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
   image now fits the raised 0x7000-byte read). `t14` re-baselined: the array
   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).**
   `text`, `file of T`, and untyped `file`; a file variable is our control block
   (`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
 layout** are landed: the ladder (`tests/calc_ladder.sh` +
 `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),
 subranges, arrays, element/field access, file types, string value parameters,
 `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
 real output (`t84_realwrite`), run-time set algebra and `Succ`/`Pred`
 (`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
 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
       next file increment. *)
    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 *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -1381,6 +1381,9 @@ END EmStDiGlob ;
 PROCEDURE EmLdAlDi () ;
 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 () ;
 BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ;    (* 8B 05: AX := [DI] *)
 
@@ -2446,7 +2449,25 @@ BEGIN
                   Err (ESimpType) ;
                   RETURN
                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
                      r.cls drops to TChar so every consumer below - LoadAtom,
                      Assignment, IoCall - sees a one-byte value instead of the
@@ -3012,8 +3033,21 @@ BEGIN
          `if Sheet[UFX,UFY].Contents <> '' then'. *)
       EmPushDi ()
    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
       EmPushVarAddr (FALSE, EmStrBlob (r))  (* the literal travels inline *)
    ELSE
@@ -3919,6 +3953,34 @@ BEGIN
          fixture had ever exercised the fold. *)
       ParseVar (r) ;
       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
       (* IOResult: the last file operation's DOS status; reading it clears the
          slot in the runtime.  It is a no-argument function. *)
@@ -4034,7 +4096,15 @@ BEGIN
          Err (ETypeErr) ;
          RETURN
       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,
                     (symtab [r.idx].off + r.boff) MOD 10000H, 1)
       ELSIF r.kind = 3 THEN
@@ -4214,7 +4284,28 @@ BEGIN
             END ;
             ParseExpr (arg) ;
             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 *)
                IF arg.cls # TString THEN
                   Err (ETypeErr) ;
@@ -4527,6 +4618,29 @@ BEGIN
       END ;
       RETURN
    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
       (* `varparam := expr': store through the address the slot holds.  DI is
          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. *)
                      IF arg.kind = 5 THEN
                         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
                         EmPushVarAddr (symtab [arg.idx].local,
                                        (symtab [arg.idx].off + arg.boff) MOD 10000H)
@@ -6404,11 +6523,13 @@ BEGIN
             END ;
             ExpectDelim (':', ENoSemi) ;   (* formal is 'name : type' *)
             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) ;
                RETURN
             END ;
@@ -6728,6 +6849,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    i := NewSym ("IORESULT", KBuiltin, BI_IoResult, 0, 0, 0, 0, FALSE) ;
    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
       already read the console, so `Read(Kbd, Ch)' drops the file argument and
       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
 # 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
 #                   success path needs real DOS.
 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()
 old = """                     IF arg.kind = 5 THEN
                         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
                         EmPushVarAddr (symtab [arg.idx].local,
                                        (symtab [arg.idx].off + arg.boff) MOD 10000H)