ソースを参照

calc: Str(real:width:decimals) (ladder 26924)

Str formats a REAL into a string variable through the existing runtime
real_fmt entry (28), so no runtime bytes change.  The source address is pushed
first and parked while the width/decimals expressions and destination are
parsed; the two argument words are then swapped to real_fmt's order (source
[BP+4], destination [BP+6]).  CX carries (decimals << 8) | width; it is parked
in tmpA across the destination parse.  Defaults match TPSRC8: width 18,
decimals FFFFh.

t92_strreal covers runtime width/decimals, zero width and zero decimals, and
executes under both qemu and Exec86.  The CALC ladder moves 26066 -> 26924;
the next blocker is a pointer type: `Buffer : ^Pages` and the New/dereference
operations it implies.

Verified: compile matrix 93/93, ladder 1/1, 84 .COM linked, 80 executed under
both qemu and Exec86, rt_exec 276/276, nonvacuity 121/121, run_all ALL PASS.
Eric Streit 1 日 前
親
コミット
38b61841bf

+ 17 - 9
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | position | blocker |
 |---|---|
-| **26066** | `Str(Value:FW:DEC,P)` in `Print` — real-to-string formatting (`ERR 41`) |
+| **26924** | `Buffer : ^Pages` — pointer types and `New`/dereference (`ERR 30`) |
 
 Rungs behind it (now passed):
 
@@ -137,7 +137,8 @@ Rungs ahead:
 | 22706 | `var Line : AnyString` - a by-reference string parameter |
 | 23700 | typed-file data write (`write(MCfile, Sheet[I,J])`) - DONE |
 | 25674 | text-file output (`Writeln(MCFile)`) - DONE |
-| 26066 | `Str(Value:FW:DEC,P)` - real-to-string formatting |
+| 26066 | `Str(Value:FW:DEC,P)` - real-to-string formatting - DONE |
+| 26924 | `Buffer : ^Pages` - pointer type |
 
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
@@ -459,9 +460,9 @@ 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, the
 file control-block operations, VAR string parameters, `Chr`, typed-file
-block I/O, and text-file output). The
-ladder has moved from the first typed constant at 7,791 to **26,066**, where
-`Str(Value:FW:DEC,P)` asks for real-to-string formatting.
+block I/O, text-file output, and `Str`). The
+ladder has moved from the first typed constant at 7,791 to **26,924**, where
+`Buffer : ^Pages` asks for pointer types.
 
 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
@@ -501,7 +502,8 @@ Exec86):
 | `ab7cced` | `v-TP3-CALC-FILEOPS` | `ERR 102 22706` (VAR string parameter) |
 | `02d5b6e` | `v-TP3-CALC-VARSTR` | `ERR 102 23700` (typed-file data write) |
 | `0859a3b` | `v-TP3-CALC-FILEIO` | `ERR 102 25674` (text-file output) |
-| *(this commit)* | `v-TP3-CALC-TEXTOUT` | **`ERR 41 26066`** (`Str`) |
+| `93d2ed4` | `v-TP3-CALC-TEXTOUT` | `ERR 41 26066` (`Str`) |
+| *(this commit)* | `v-TP3-CALC-STR` | **`ERR 30 26924`** (pointer type) |
 
 - **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
@@ -547,6 +549,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.
+- **`Str(real:width:decimals, S)` is landed (`t92_strreal`).**  The source
+  address is parked on the stack while width/decimals and the destination are
+  parsed, then the two argument words are swapped to real_fmt's order.  CX is
+  `(decimals << 8) | width`, with TP3's defaults (18, FFFFh).  Runtime
+  `real_fmt` needed no change.  The fixture executes under both oracles.
 - **Text-file output is landed (`t91_textout`).**  `Writeln(F)` writes CRLF,
   `Write(F,' ')` writes one CHAR, and `writeln(F,Line)` writes the string then
   CRLF, all as DOS AH=40h blocks from code-resident literals or the string's
@@ -1131,9 +1138,10 @@ under qemu and Exec86, and `rt_exec` pins the name copy.
 
 Typed-file block I/O (`write`/`read` with a `TFile`) is done (`t90_fileio`)
 and TEXT file output is done (`t91_textout`), both compile-only because the
-harness has no filesystem.  Still open: `Str`/`Val`, then `EndOfFile` and text
-`Readln(H, ...)`, which need text-mode newline/`^Z` semantics
-(`RESUME-TP3.md` §2).  The next ladder blocker is `Str`.
+harness has no filesystem.  `Str` real formatting is done (`t92_strreal`).
+The next ladder blocker is a POINTER type (`Buffer : ^Pages`) and the
+`New`/`Dispose`/dereference operations that follow it; `Val`, `EndOfFile` and
+text `Readln` are still open.
 
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),

+ 3 - 3
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 41` at pos 26066, `Str(Value:FW:DEC,P)` in `Print`), the `{$I}` include,
+`ERR 30` at pos 26924, `Buffer : ^Pages` in Help), 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`/
@@ -2061,8 +2061,8 @@ real output (`t84_realwrite`), run-time set algebra and `Succ`/`Pred`
 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`), typed-file block I/O (`t90`, compile-only), and
-text-file output (`t91`, compile-only). The next rung is `Str` real-to-string
-formatting. The runtime is 3,907 bytes / 39 entries and its probe
+text-file output (`t91`, compile-only), and `Str` real formatting (`t92`). The
+next rung is pointer types (`^Pages`) and the heap operations. 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.
 

+ 93 - 2
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_Chr = 21 ;
+   BI_Close = 19 ; BI_IoResult = 20 ; BI_Chr = 21 ; BI_Str = 22 ;
    (* the sub-codes EmCrtSeq takes *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -386,7 +386,8 @@ VAR
    TU_StackChk : CARDINAL ;
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrChar   : CARDINAL ;  TU_WrBool : CARDINAL ;
-   TU_WrReal   : CARDINAL ;  TU_RealWrite : CARDINAL ;  TU_WrLn   : CARDINAL ;
+   TU_WrReal   : CARDINAL ;  TU_RealWrite : CARDINAL ;  TU_RealFmt : CARDINAL ;
+   TU_WrLn     : CARDINAL ;
    TU_RdInt    : CARDINAL ;  TU_RdChar : CARDINAL ;  TU_RdBool : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
    TU_RdByte   : CARDINAL ;  (* one-byte variable reads; see IoCall *)
@@ -1040,6 +1041,21 @@ BEGIN
    Ebyte (58H)                                   (* POP AX *)
 END EmPopAx ;
 
+PROCEDURE EmPushBx () ;
+BEGIN Ebyte (53H) END EmPushBx ;
+
+PROCEDURE EmPopBx () ;
+BEGIN Ebyte (5BH) END EmPopBx ;
+
+PROCEDURE EmMovAxCx () ;
+BEGIN Ebyte (89H) ; Ebyte (0C8H) END EmMovAxCx ;   (* MOV AX,CX *)
+
+PROCEDURE EmMovChAl () ;
+BEGIN Ebyte (88H) ; Ebyte (0C5H) END EmMovChAl ;   (* MOV CH,AL *)
+
+PROCEDURE EmMovChImm (v : CARDINAL) ;
+BEGIN Ebyte (0B5H) ; Ebyte (VAL (BYTE, v MOD 256)) END EmMovChImm ;
+
 (* 91 = XCHG AX,CX, and NOT 93.  LoadPair hands the operator the left
    operand in CX and the right in AX (in the original, and still the
    commonest, shape: it pushes the left, loads the right, then pops the
@@ -5000,6 +5016,78 @@ BEGIN
       END ;
       RETURN
    END ;
+   IF which = BI_Str THEN
+      (* Str(Value[:FW[:DEC]], S): format a REAL into a string variable.
+         The source address is pushed first and parked on the stack while the
+         width/decimals expressions and the destination are parsed; the two
+         stack words are then swapped to real_fmt's order (source at [BP+4],
+         destination at [BP+6]).  CX carries (decimals << 8) | width; it is
+         parked in tmpA across the destination parse, which may clobber CX.
+         Defaults match TPSRC8 pstdef1/pstdef3: width 18, decimals FFFFh. *)
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      ParseExpr (arg) ;
+      IF OK () AND (arg.cls = TReal) AND
+         ((arg.kind = 1) OR (arg.kind = 5)) THEN
+         IF arg.kind = 5 THEN
+            EmPushDi ()
+         ELSE
+            EmPushVarAddr (symtab [arg.idx].local,
+                           (symtab [arg.idx].off + arg.boff) MOD 10000H)
+         END ;
+         IF MatchDelim (':') THEN
+            ParseExpr (dummy) ;
+            IF OK () THEN
+               LoadAtom (dummy)
+            END ;
+            IF MatchDelim (':') THEN
+               EmPushAx () ;
+               ParseExpr (dummy) ;
+               IF OK () THEN
+                  LoadAtom (dummy) ;
+                  EmMovChAl () ;
+                  EmPopAx () ;
+                  EmMovClAl ()
+               END
+            ELSIF OK () THEN
+               EmMovClAl () ;
+               EmMovChImm (0FFH)
+            END
+         ELSE
+            EmMovCxi (0FF12H)       (* width 18, decimals FFFFh *)
+         END ;
+         IF NOT OK () THEN
+            RETURN
+         END ;
+         EmMovAxCx () ;
+         EmStoreVar (FALSE, symtab [tmpA].off, 2) ;
+         IF NOT MatchDelim (',') THEN
+            Err (ENoSemi) ;
+            RETURN
+         END ;
+         ParseExpr (dummy) ;
+         IF OK () AND (dummy.cls = TString) AND
+            ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
+            EmPushStrAddr (dummy) ;
+            EmPopAx () ;                     (* destination *)
+            EmPopBx () ;                     (* source *)
+            EmPushAx () ;                    (* destination at [BP+6] *)
+            EmPushBx () ;                    (* source at [BP+4] *)
+            EmLoadVar (FALSE, symtab [tmpA].off, 2) ;
+            EmXchgAxCx () ;                  (* CX := packed width/decimals *)
+            DropC (EmCall (TU_RealFmt)) ;
+            EmAddSp (4)
+         ELSIF OK () THEN
+            Err (ETypeErr)
+         END
+      ELSIF OK () THEN
+         Err (ETypeErr)
+      END ;
+      ExpectDelim (')', ENoSemi) ;
+      RETURN
+   END ;
    IF which = BI_Assign THEN
       (* Assign(F, Name): the file variable's address and the counted
          string's address.  The runtime copies the characters into the file
@@ -6997,6 +7085,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    i := NewSym ("CHR", KBuiltin, BI_Chr, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
+   i := NewSym ("STR", KBuiltin, BI_Str, 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. *)
@@ -7142,6 +7232,7 @@ BEGIN
    TU_WrBool   := RT_Entry (5) ;
    TU_WrReal   := RT_Entry (6) ;
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
+   TU_RealFmt   := RT_Entry (28) ;     (* fmtreal into a string variable *)
    TU_WrLn     := RT_Entry (7) ;
    TU_RdInt    := RT_Entry (8) ;
    TU_RdChar   := RT_Entry (9) ;

+ 1 - 0
shell/tests/audit_helpers.py

@@ -162,6 +162,7 @@ NON_ONE_LINE = {
         "InlineCh": COMP,      # emits a string blob, not one instruction
         "InlineCrLf": COMP,    # emits a string blob, not one instruction
         "AddSp": PARAM, "SubSp": PARAM, "Setcc": PARAM,
+        "MovChImm": PARAM,
         "Call": COMP, "Jcc": COMP, "JmpNear": COMP,
         "BpDisp": COMP, "LoadVar": COMP, "StoreVar": COMP,
         "PushVarAddr": COMP, "MovAxi": COMP, "CmpAxi": COMP,

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

@@ -25,11 +25,11 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-22): `Str(Value:FW:DEC,P)' in Print.  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 and text-file output moved the ladder
-# 15911 -> 18267 -> 19847 -> 20912 -> 22253 -> 22280 -> 22706 -> 22859 ->
-# 23700 -> 25674 -> 26066.  The next blocker is Str: real-to-string formatting
-# into a string variable (TP3 error 41).
-CALC.PAS	ERR	41	26066
+# Current rung (2026-10-23): `Buffer : ^Pages' in the help-data declarations.
+# 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 and Str moved the
+# ladder 15911 -> 18267 -> 19847 -> 20912 -> 22253 -> 22280 -> 22706 -> 22859
+# -> 23700 -> 25674 -> 26066 -> 26924.  The next blocker is a POINTER type
+# (`^Pages') and its New/Dispose/dereference operations (TP3 error 30).
+CALC.PAS	ERR	30	26924

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

@@ -656,3 +656,9 @@ t90_fileio	OK	212	149
 #                   Write(F,' ') one char, writeln(F,'hello') the string then
 #                   CRLF.  Compile-only: the harnesses have no filesystem.
 t91_textout	OK	231	137
+
+#   t92_strreal          Str(real:width:decimals, S) with runtime width and
+#                   decimals, and a zero width.  real_fmt produces the padded,
+#                   length-prefixed field; the .out is derived from its measured
+#                   formatting rules (3.0 at 2 decimals, and 3 at 0 decimals).
+t92_strreal	OK	247	36

+ 3 - 0
shell/tests/fixtures/t92_strreal.out

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

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

@@ -0,0 +1,34 @@
+program t92_strreal;
+
+{ t92 -- Str(real:width:decimals, S).  CALC.INC's Print calls
+
+      Str(Value:FW:DEC,P)
+
+  where Value is a REAL field, FW and DEC are integer fields/variables, and
+  P is a string.  The runtime's real_fmt already produces the padded,
+  length-prefixed field; this fixture pins the compiler's argument packing
+  and both widths/decimals.  The outputs are derived from real_fmt's
+  measured behaviour (the same rules as t84_realwrite): field width 8 with
+  2 decimals is '    3.00'; width 0 is '3.00'; width 10 with 0 decimals
+  pads 3 to ten columns. }
+
+type
+  RealRec = record
+    R : real;
+  end;
+
+var
+  X : RealRec;
+  S : string[20];
+  W, D : integer;
+begin
+  X.R := 3;
+  W := 8;
+  D := 2;
+  Str (X.R : W : D, S);
+  writeln (S);
+  Str (X.R : 0 : 2, S);
+  writeln (S);
+  Str (X.R : 10 : 0, S);
+  writeln (S)
+end.