Ver código fonte

calc: VAR REAL parameters (ladder 32096)

A VAR parameter of type REAL now has a two-byte address slot like VAR STRING.
The declaration check allows it, call sites pass plain variables and kind-5
record-field addresses, and assignment through the slot stores either a
converted constant or copies six bytes from a REAL source.  The latter pushes
the destination pointer and source address, pops them into DI/SI and copies
byte by byte.

t97_varreal covers a constant store and a six-byte copy through record-field
actuals, then formats the result with Str; it runs under qemu and Exec86.

The CALC ladder moves 31758 -> 32096; the next blocker is a REAL function
result (`function Expression(...):Real;forward`).

Verified: compile matrix 98/98, ladder 1/1, 89 .COM linked, 84 executed under
both qemu and Exec86, rt_exec 276/276, nonvacuity 121/121, run_all ALL PASS.
Eric Streit 5 dias atrás
pai
commit
a4e72bf510

+ 17 - 9
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | position | blocker |
 |---|---|
 |---|---|
-| **31758** | `var Value : Real` in `Evaluate` — by-reference REAL parameters (`ERR 102`) |
+| **32096** | `function Expression(...):Real;forward` — REAL function results (`ERR 102`) |
 
 
 Rungs behind it (now passed):
 Rungs behind it (now passed):
 
 
@@ -142,7 +142,8 @@ Rungs ahead:
 | 27648 | text-file `Eof`/`Readln` - DONE |
 | 27648 | text-file `Eof`/`Readln` - DONE |
 | 27759 | `Str(count,st)` - integer Str - DONE |
 | 27759 | `Str(count,st)` - integer Str - DONE |
 | 28074 | `Val(Buffer^[0],...)` - string-to-integer - DONE |
 | 28074 | `Val(Buffer^[0],...)` - string-to-integer - DONE |
-| 31758 | `var Value : Real` - by-reference REAL parameter |
+| 31758 | `var Value : Real` - by-reference REAL parameter - DONE |
+| 32096 | REAL function result (`Expression:Real`) |
 
 
 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:
@@ -465,9 +466,9 @@ membership, string fields in WRITE, real output, run-time set algebra,
 `Succ`/`Pred`, the original memory layout, the untyped file type, the
 `Succ`/`Pred`, the original memory layout, the untyped file type, the
 file control-block operations, VAR string parameters, `Chr`, typed-file
 file control-block operations, VAR string parameters, `Chr`, typed-file
 block I/O, text-file output, `Str`, pointer types with `New`/dereference,
 block I/O, text-file output, `Str`, pointer types with `New`/dereference,
-text `Eof`/`Readln`, integer `Str`, and integer `Val`). The
-ladder has moved from the first typed constant at 7,791 to **31,758**, where
-`var Value : Real` asks for by-reference REAL parameters.
+text `Eof`/`Readln`, integer `Str`, integer `Val`, and VAR REAL parameters). The
+ladder has moved from the first typed constant at 7,791 to **32,096**, where
+`function Expression(...):Real;forward` asks for REAL function results.
 
 
 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
@@ -511,7 +512,8 @@ Exec86):
 | `38b6184` | `v-TP3-CALC-STR` | `ERR 30 26924` (pointer type) |
 | `38b6184` | `v-TP3-CALC-STR` | `ERR 30 26924` (pointer type) |
 | `1aed9cd` | `v-TP3-CALC-POINTER` | `ERR 41 27648` (`Eof`) |
 | `1aed9cd` | `v-TP3-CALC-POINTER` | `ERR 41 27648` (`Eof`) |
 | `e940a1d` | `v-TP3-CALC-TEXTREAD` | `ERR 41 28074` (`Val`) |
 | `e940a1d` | `v-TP3-CALC-TEXTREAD` | `ERR 41 28074` (`Val`) |
-| *(this commit)* | `v-TP3-CALC-VALINT` | **`ERR 102 31758`** (VAR REAL) |
+| `9d4ab01` | `v-TP3-CALC-VALINT` | `ERR 102 31758` (VAR REAL) |
+| *(this commit)* | `v-TP3-CALC-VARREAL` | **`ERR 102 32096`** (REAL function result) |
 
 
 - **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
@@ -557,6 +559,11 @@ Exec86):
   parameter slot holds the caller's address; assignment, `Read`, `Length`,
   parameter slot holds the caller's address; assignment, `Read`, `Length`,
   `writeln`, concatenation, comparison and `x[i]` all go through that address.
   `writeln`, concatenation, comparison and `x[i]` all go through that address.
   `Chr(n)` folds or loads an ordinal and yields a CHAR.
   `Chr(n)` folds or loads an ordinal and yields a CHAR.
+- **VAR REAL parameters are landed (`t97_varreal`).**  The two-byte slot
+  holds the caller's address; assignment copies six bytes through it (or
+  stores a converted constant), and call sites pass record-field addresses
+  (kind-5 DI actuals) as well as plain variables.  The fixture executes under
+  both oracles.
 - **`Val(string, integer, error)` is landed (`t96_valint`).**  `val_int`
 - **`Val(string, integer, error)` is landed (`t96_valint`).**  `val_int`
   parses optional sign and decimal digits, stores the value on success, and
   parses optional sign and decimal digits, stores the value on success, and
   leaves the destination unchanged on error while writing the 1-based
   leaves the destination unchanged on error while writing the 1-based
@@ -1170,9 +1177,10 @@ and TEXT file output is done (`t91_textout`), both compile-only because the
 harness has no filesystem.  `Str` real formatting is done (`t92_strreal`),
 harness has no filesystem.  `Str` real formatting is done (`t92_strreal`),
 pointer types with `New`/`Dispose`/dereference are done (`t93_pointer`), and
 pointer types with `New`/`Dispose`/dereference are done (`t93_pointer`), and
 text `Eof`/`Readln` plus integer `Str` are done (`t94_textread`/`t95_strint`).
 text `Eof`/`Readln` plus integer `Str` are done (`t94_textread`/`t95_strint`).
-The next ladder blocker is a by-reference REAL parameter (`var Value : Real`
-in `Evaluate`).  The probe scaffold has been moved to HDR=0x1300 / data
-0x2110; the runtime is 4,384 bytes and now has room for the remaining work.
+The next ladder blocker is a REAL function result
+(`function Expression(...):Real;forward`).  The probe scaffold has been moved
+to HDR=0x1300 / data 0x2110; the runtime is 4,384 bytes and now has room for
+the remaining work.
 
 
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),

+ 2 - 2
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 31758, `var Value : Real` in Evaluate), the `{$I}` include,
+`ERR 102` at pos 32096, `function Expression(...):Real;forward`), 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`/
@@ -2064,7 +2064,7 @@ parameters plus `Chr` (`t89`), typed-file block I/O (`t90`, compile-only), and
 text-file output (`t91`, compile-only), `Str` real formatting (`t92`), and
 text-file output (`t91`, compile-only), `Str` real formatting (`t92`), and
 pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 (`t94`), integer `Str` (`t95`), and integer `Val` (`t96`). The next rung is
 (`t94`), integer `Str` (`t95`), and integer `Val` (`t96`). The next rung is
-by-reference REAL parameters (`var Value : Real`). The runtime is 3,907 bytes / 39 entries and its probe
+REAL function results (`function Expression(...):Real`). 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.
 
 

+ 74 - 13
shell/Compiler.mod

@@ -1404,6 +1404,15 @@ 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 EmLdAlSi () ;
+BEGIN Ebyte (8AH) ; Ebyte (04H) END EmLdAlSi ;    (* 8A 04: AL := [SI] *)
+
+PROCEDURE EmIncSi () ;
+BEGIN Ebyte (46H) END EmIncSi ;
+
+PROCEDURE EmIncDi () ;
+BEGIN Ebyte (47H) END EmIncDi ;
+
 PROCEDURE EmMovDiAx () ;
 PROCEDURE EmMovDiAx () ;
 BEGIN Ebyte (89H) ; Ebyte (0C7H) END EmMovDiAx ;  (* 89 C7: DI := AX *)
 BEGIN Ebyte (89H) ; Ebyte (0C7H) END EmMovDiAx ;  (* 89 C7: DI := AX *)
 
 
@@ -4372,11 +4381,14 @@ BEGIN
                quietly passed by value.  An element with a constant index
                quietly passed by value.  An element with a constant index
                (`s[i]') is a variable too: its address is off+boff, which
                (`s[i]') is a variable too: its address is off+boff, which
                EmPushVarAddr forms directly. *)
                EmPushVarAddr forms directly. *)
-            IF arg.kind # 1 THEN
+            IF arg.kind = 5 THEN
+               (* An element/field address already in DI, including a record
+                  field passed as a VAR actual: Sheet[I,J].Contents. *)
+               EmPushDi ()
+            ELSIF arg.kind # 1 THEN
                Err (ENoLib) ;
                Err (ENoLib) ;
                EXIT
                EXIT
-            END ;
-            IF symtab [arg.idx].isVar THEN
+            ELSIF symtab [arg.idx].isVar THEN
                (* Passing a VAR parameter on: its slot already HOLDS the
                (* Passing a VAR parameter on: its slot already HOLDS the
                   address, so push that, not the address of the slot. *)
                   address, so push that, not the address of the slot. *)
                IF arg.boff # 0 THEN
                IF arg.boff # 0 THEN
@@ -4450,11 +4462,12 @@ BEGIN
                   path was missing, so `Length(s)' inside a function whose
                   path was missing, so `Length(s)' inside a function whose
                   formal is `var s' pushed the string's VALUE and the callee
                   formal is `var s' pushed the string's VALUE and the callee
                   would have read it as an address. *)
                   would have read it as an address. *)
-               IF arg.kind # 1 THEN
+               IF arg.kind = 5 THEN
+                  EmPushDi ()
+               ELSIF arg.kind # 1 THEN
                   Err (ENoLib) ;
                   Err (ENoLib) ;
                   EXIT
                   EXIT
-               END ;
-               IF symtab [arg.idx].isVar THEN
+               ELSIF symtab [arg.idx].isVar THEN
                   IF arg.boff # 0 THEN
                   IF arg.boff # 0 THEN
                      Err (ENoLib) ;
                      Err (ENoLib) ;
                      EXIT
                      EXIT
@@ -4625,6 +4638,52 @@ BEGIN
          measured MBF layout; another REAL field is copied byte for byte.
          measured MBF layout; another REAL field is copied byte for byte.
          Real arithmetic and real-valued expressions are a later stage and
          Real arithmetic and real-valued expressions are a later stage and
          are refused, not guessed. *)
          are refused, not guessed. *)
+      IF (r.kind = 1) AND symtab [r.idx].isVar THEN
+         (* VAR REAL parameter: the slot holds the destination address. *)
+         ParseExpr (src) ;
+         IF NOT OK () THEN
+            RETURN
+         END ;
+         IF (src.kind = 0) AND (src.cls # TString) AND (src.cls # TSet) THEN
+            IntToMbf (src.imm, rbuf) ;
+            EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
+            EmMovDiAx () ;
+            k := 0 ;
+            WHILE k < 6 DO
+               EmStDiImm (k, ORD (rbuf [k])) ;
+               INC (k)
+            END ;
+            RETURN
+         END ;
+         IF (src.cls = TReal) AND ((src.kind = 1) OR (src.kind = 5)) THEN
+            (* Destination pointer first, then the source address; pop SI
+               (source), DI (destination), and copy six bytes. *)
+            EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
+            EmPushAx () ;
+            IF src.kind = 5 THEN
+               EmPushDi ()
+            ELSIF symtab [src.idx].isVar THEN
+               EmLoadVar (TRUE, symtab [src.idx].off, 2) ;
+               EmPushAx ()
+            ELSE
+               EmPushVarAddr (symtab [src.idx].local,
+                              (symtab [src.idx].off + src.boff) MOD 10000H)
+            END ;
+            EmPopSi () ;
+            EmPopDi () ;
+            k := 0 ;
+            WHILE k < 6 DO
+               EmLdAlSi () ;
+               EmStDiAl () ;
+               EmIncSi () ;
+               EmIncDi () ;
+               INC (k)
+            END ;
+            RETURN
+         END ;
+         Err (ENoLib) ;
+         RETURN
+      END ;
       ParseExpr (src) ;
       ParseExpr (src) ;
       IF NOT OK () THEN
       IF NOT OK () THEN
          RETURN
          RETURN
@@ -6986,20 +7045,22 @@ 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) AND (cls # TString) THEN
+            IF groupVar AND (size > 2) AND (cls # TString) AND (cls # TReal) THEN
                (* A VAR parameter of a record or array would need the callee
                (* A VAR parameter of a record or array would need the callee
                   to address through a larger object than the scalar [BX]
                   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. *)
+                  paths; refusing is the honest answer.  VAR STRING and VAR
+                  REAL are the exceptions: both slots are two-byte ADDRESSES,
+                  and both value types already have address-based runtime
+                  paths. *)
                Err (ENoLib) ;
                Err (ENoLib) ;
                RETURN
                RETURN
             END ;
             END ;
-            IF (size > 2) AND (cls # TString) THEN
+            IF (size > 2) AND (cls # TString)
+               AND NOT (groupVar AND (cls = TReal)) THEN
                (* A string VALUE parameter is a whole-slot copy (n+1 bytes on
                (* A string VALUE parameter is a whole-slot copy (n+1 bytes on
                   the stack); any other type wider than a word - a record, an
                   the stack); any other type wider than a word - a record, an
-                  array, a set - is still refused. *)
+                  array, a set - is still refused.  A VAR REAL is allowed:
+                  its slot is an address, not the six bytes. *)
                Err (ENoLib) ;
                Err (ENoLib) ;
                RETURN
                RETURN
             END ;
             END ;

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

@@ -25,12 +25,13 @@
 # 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-23): `var Value : Real' in Evaluate's parameter list.
-# UpCase, run-time set membership, string fields through DI, the original
-# memory layout, untyped-file declarations, file control-block operations, VAR
-# string parameters, Chr, typed-file block I/O, text-file output, Str,
-# pointers/New/dereference, text Eof/Readln, Str(integer) and Val(integer)
-# moved the ladder 15911 -> 18267 -> 19847 -> 20912 -> 22253 -> 22280 -> 22706
-# -> 22859 -> 23700 -> 25674 -> 26066 -> 26924 -> 27648 -> 28074 -> 31758.
-# The next blocker is a VAR parameter of type Real (TP3 error 102).
-CALC.PAS	ERR	102	31758
+# Current rung (2026-10-23): `function Expression(...):Real;forward;'.  UpCase,
+# run-time set membership, string fields through DI, the original memory
+# layout, untyped-file declarations, file control-block operations, VAR string
+# parameters, Chr, typed-file block I/O, text-file output, Str,
+# pointers/New/dereference, text Eof/Readln, Str(integer), Val(integer) and
+# VAR REAL parameters moved the ladder 15911 -> 18267 -> 19847 -> 20912 ->
+# 22253 -> 22280 -> 22706 -> 22859 -> 23700 -> 25674 -> 26066 -> 26924 ->
+# 27648 -> 28074 -> 31758 -> 32096.  The next blocker is a REAL function
+# result (TP3 error 102).
+CALC.PAS	ERR	102	32096

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

@@ -683,3 +683,8 @@ t95_strint	OK	133	18
 #                   an invalid character at position 3 (destination unchanged)
 #                   an invalid character at position 3 (destination unchanged)
 #                   and an empty string.
 #                   and an empty string.
 t96_valint	OK	328	20
 t96_valint	OK	328	20
+
+#   t97_varreal          VAR REAL parameters: constant store and six-byte
+#                   copy through the two-byte address slot, using record fields
+#                   as actual parameters.
+t97_varreal	OK	282	28

+ 1 - 0
shell/tests/fixtures/t97_varreal.out

@@ -0,0 +1 @@
+3

+ 34 - 0
shell/tests/fixtures/t97_varreal.pas

@@ -0,0 +1,34 @@
+program t97_varreal;
+
+{ t97 -- VAR REAL parameters.  CALC.INC's Evaluate takes `var Value : Real'
+  and assigns a real function result into it.  This fixture checks a constant
+  store and a six-byte copy through the two-byte address slot, using record
+  fields as actual parameters. }
+
+type
+  R = record
+    V : real;
+  end;
+
+var
+  A, B : R;
+  S : string[10];
+
+procedure setv (var Z : real);
+begin
+  Z := 3
+end;
+
+procedure copyv (var D : real; var Src : real);
+begin
+  D := Src
+end;
+
+begin
+  A.V := 0;
+  B.V := 0;
+  setv (B.V);
+  copyv (A.V, B.V);
+  Str (A.V : 0 : 0, S);
+  writeln (S)
+end.