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

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 день назад
Родитель
Сommit
38b61841bf

+ 17 - 9
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | 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):
 Rungs behind it (now passed):
 
 
@@ -137,7 +137,8 @@ Rungs ahead:
 | 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])`) - DONE |
 | 23700 | typed-file data write (`write(MCfile, Sheet[I,J])`) - DONE |
 | 25674 | text-file output (`Writeln(MCFile)`) - 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
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
 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,
 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, 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
 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
@@ -501,7 +502,8 @@ Exec86):
 | `ab7cced` | `v-TP3-CALC-FILEOPS` | `ERR 102 22706` (VAR string parameter) |
 | `ab7cced` | `v-TP3-CALC-FILEOPS` | `ERR 102 22706` (VAR string parameter) |
 | `02d5b6e` | `v-TP3-CALC-VARSTR` | `ERR 102 23700` (typed-file data write) |
 | `02d5b6e` | `v-TP3-CALC-VARSTR` | `ERR 102 23700` (typed-file data write) |
 | `0859a3b` | `v-TP3-CALC-FILEIO` | `ERR 102 25674` (text-file output) |
 | `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.
 - **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
@@ -547,6 +549,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.
+- **`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,
 - **Text-file output is landed (`t91_textout`).**  `Writeln(F)` writes CRLF,
   `Write(F,' ')` writes one CHAR, and `writeln(F,Line)` writes the string then
   `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
   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`)
 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
 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`
 **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),

+ 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
 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 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),
 `^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`/
@@ -2061,8 +2061,8 @@ real output (`t84_realwrite`), run-time set algebra and `Succ`/`Pred`
 type (`t87`), file control-block operations (`t88`: `Assign`/`Reset`/
 type (`t87`), file control-block operations (`t88`: `Assign`/`Reset`/
 `Rewrite`/`Close`/`IoResult`; data I/O is still refused), and VAR string
 `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
 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
 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.
 
 

+ 93 - 2
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_Chr = 21 ;
+   BI_Close = 19 ; BI_IoResult = 20 ; BI_Chr = 21 ; BI_Str = 22 ;
    (* 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 ;
@@ -386,7 +386,8 @@ VAR
    TU_StackChk : CARDINAL ;
    TU_StackChk : CARDINAL ;
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrChar   : CARDINAL ;  TU_WrBool : 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_RdInt    : CARDINAL ;  TU_RdChar : CARDINAL ;  TU_RdBool : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
    TU_RdByte   : CARDINAL ;  (* one-byte variable reads; see IoCall *)
    TU_RdByte   : CARDINAL ;  (* one-byte variable reads; see IoCall *)
@@ -1040,6 +1041,21 @@ BEGIN
    Ebyte (58H)                                   (* POP AX *)
    Ebyte (58H)                                   (* POP AX *)
 END EmPopAx ;
 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
 (* 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
    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
    commonest, shape: it pushes the left, loads the right, then pops the
@@ -5000,6 +5016,78 @@ BEGIN
       END ;
       END ;
       RETURN
       RETURN
    END ;
    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
    IF which = BI_Assign THEN
       (* Assign(F, Name): the file variable's address and the counted
       (* Assign(F, Name): the file variable's address and the counted
          string's address.  The runtime copies the characters into the file
          string's address.  The runtime copies the characters into the file
@@ -6997,6 +7085,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    symtab [i].defnd := TRUE ;
    i := NewSym ("CHR", KBuiltin, BI_Chr, 0, 0, 0, 0, FALSE) ;
    i := NewSym ("CHR", KBuiltin, BI_Chr, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
    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
    (* 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. *)
@@ -7142,6 +7232,7 @@ BEGIN
    TU_WrBool   := RT_Entry (5) ;
    TU_WrBool   := RT_Entry (5) ;
    TU_WrReal   := RT_Entry (6) ;
    TU_WrReal   := RT_Entry (6) ;
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
+   TU_RealFmt   := RT_Entry (28) ;     (* fmtreal into a string variable *)
    TU_WrLn     := RT_Entry (7) ;
    TU_WrLn     := RT_Entry (7) ;
    TU_RdInt    := RT_Entry (8) ;
    TU_RdInt    := RT_Entry (8) ;
    TU_RdChar   := RT_Entry (9) ;
    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
         "InlineCh": COMP,      # emits a string blob, not one instruction
         "InlineCrLf": COMP,    # emits a string blob, not one instruction
         "InlineCrLf": COMP,    # emits a string blob, not one instruction
         "AddSp": PARAM, "SubSp": PARAM, "Setcc": PARAM,
         "AddSp": PARAM, "SubSp": PARAM, "Setcc": PARAM,
+        "MovChImm": PARAM,
         "Call": COMP, "Jcc": COMP, "JmpNear": COMP,
         "Call": COMP, "Jcc": COMP, "JmpNear": COMP,
         "BpDisp": COMP, "LoadVar": COMP, "StoreVar": COMP,
         "BpDisp": COMP, "LoadVar": COMP, "StoreVar": COMP,
         "PushVarAddr": COMP, "MovAxi": COMP, "CmpAxi": 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
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 # 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
 #                   Write(F,' ') one char, writeln(F,'hello') the string then
 #                   CRLF.  Compile-only: the harnesses have no filesystem.
 #                   CRLF.  Compile-only: the harnesses have no filesystem.
 t91_textout	OK	231	137
 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.