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 4 dias atrás
pai
commit
a4e72bf510

+ 17 - 9
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | 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):
 
@@ -142,7 +142,8 @@ Rungs ahead:
 | 27648 | text-file `Eof`/`Readln` - DONE |
 | 27759 | `Str(count,st)` - integer Str - 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
 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
 file control-block operations, VAR string parameters, `Chr`, typed-file
 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
 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) |
 | `1aed9cd` | `v-TP3-CALC-POINTER` | `ERR 41 27648` (`Eof`) |
 | `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.
   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`,
   `writeln`, concatenation, comparison and `x[i]` all go through that address.
   `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`
   parses optional sign and decimal digits, stores the value on success, and
   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`),
 pointer types with `New`/`Dispose`/dereference are done (`t93_pointer`), and
 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`
 (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
 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 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),
 subranges, arrays, element/field access, file types, string value parameters,
 `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
 pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 (`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
 below are independent of both tracks.
 

+ 74 - 13
shell/Compiler.mod

@@ -1404,6 +1404,15 @@ END EmStDiGlob ;
 PROCEDURE EmLdAlDi () ;
 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 () ;
 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
                (`s[i]') is a variable too: its address is off+boff, which
                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) ;
                EXIT
-            END ;
-            IF symtab [arg.idx].isVar THEN
+            ELSIF symtab [arg.idx].isVar THEN
                (* Passing a VAR parameter on: its slot already HOLDS the
                   address, so push that, not the address of the slot. *)
                IF arg.boff # 0 THEN
@@ -4450,11 +4462,12 @@ BEGIN
                   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
+               IF arg.kind = 5 THEN
+                  EmPushDi ()
+               ELSIF arg.kind # 1 THEN
                   Err (ENoLib) ;
                   EXIT
-               END ;
-               IF symtab [arg.idx].isVar THEN
+               ELSIF symtab [arg.idx].isVar THEN
                   IF arg.boff # 0 THEN
                      Err (ENoLib) ;
                      EXIT
@@ -4625,6 +4638,52 @@ BEGIN
          measured MBF layout; another REAL field is copied byte for byte.
          Real arithmetic and real-valued expressions are a later stage and
          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) ;
       IF NOT OK () THEN
          RETURN
@@ -6986,20 +7045,22 @@ BEGIN
             END ;
             ExpectDelim (':', ENoSemi) ;   (* formal is 'name : type' *)
             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
                   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) ;
                RETURN
             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
                   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) ;
                RETURN
             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
 # 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)
 #                   and an empty string.
 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.