Sfoglia il codice sorgente

calc: Delete string builtin (ladder 48461)

Add str_delete (runtime entry 54): a counted string is modified in place, with
pos 1-based.  Non-positive lengths, pos < 1 and pos past the end are no-ops;
the tail is moved down and the length byte rewritten.  The compiler builtin
Delete parses a whole-string variable/field, position and length, and emits the
runtime call.

t108_delete covers middle/front/truncation/no-op cases and runs under qemu and
Exec86.

The code ceiling was raised from 0x7F00 to 0x8000 (the data area starts at
0x8000), which moves CALC past the previous image-capacity failure.  CALC now
stops at ERR 102 48461: a local `OkChars : set of Char` inside GotoX.

Verified: compile matrix 109/109, ladder 1/1 at ERR 102 48461, 95 .COM
executions under both oracles, rt_exec 276/276, nonvacuity 121/121, run_all
ALL PASS.
Eric Streit 5 giorni fa
parent
commit
823fbbde40

+ 13 - 7
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | position | blocker |
 |---|---|
-| **44567** | `delete(Formula,1,1)` in `Evaluate` — the `Delete` string builtin (`ERR 41`) |
+| **48461** | `OkChars : set of Char` inside `GotoX` — local set variable (`ERR 102`) |
 
 Rungs behind it (now passed):
 
@@ -156,7 +156,9 @@ Rungs ahead:
 | 41118 | `Sin`/`Cos`/`Arctan` - DONE |
 | 41595 | `Int(f)` - DONE |
 | 43902 | forward definition repeating only the name - DONE |
-| 44567 | `Delete` string builtin (`ERR 41`) |
+| 44567 | `Delete` string builtin - DONE |
+| 47788 | code ceiling reached; raised to 0x8000 - DONE |
+| 48461 | local `set of Char` variable (`ERR 102`) |
 
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
@@ -534,7 +536,8 @@ Exec86):
 | `30782f6` | `v-TP3-CALC-REALEXPR` | `ERR 41 35135` (`Copy`) |
 | `df54e71` | `v-TP3-CALC-COPYVAL` | `ERR 41 40930` (`Exp`) |
 | `dcfbf8c` | `v-TP3-CALC-TRANSCEND` | `ERR 41 43902` (forward definition) |
-| `21ce8e5` | `v-TP3-CALC-FORWARD` | **`ERR 41 44567`** (`Delete`) |
+| `21ce8e5` | `v-TP3-CALC-FORWARD` | `ERR 41 44567` (`Delete`) |
+| *(this commit)* | `v-TP3-CALC-DELETE` | **`ERR 102 48461`** (local set) |
 
 - **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
@@ -594,6 +597,9 @@ Exec86):
 - **`Abs`, `Sqr` and `Sqrt` are landed (`t104_mathbasic`).**  `Abs` clears the
   MBF sign, `Sqr` lowers to the real multiply entry, and `Sqrt` is Newton over
   the existing real division/addition entries.
+- **`Delete(S,pos,len)` is landed (`t108_delete`).**  A counted-string
+  runtime entry rewrites the length and moves the tail; positions outside the
+  string and non-positive lengths are no-ops.
 - **Forward definitions may repeat only the name (`t107_forward`).**  The
   earlier `function Expression{(...)}` source exposed two bugs: a forward
   `FUNCTION` was rejected as if it were a duplicate `PROCEDURE`, and the
@@ -1230,10 +1236,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 the `Delete` string builtin in `Evaluate`.  All the
-REAL builtins CALC uses are implemented, and forward definitions that repeat
-only the name are accepted.  The runtime is 13,955 bytes; `rt_exec` is at
-HDR=0x4000 / data 0x5000, and the compiler's code ceiling is 0x7F00.
+The next ladder blocker is a local `set of Char` variable in `GotoX`.  All the
+REAL builtins CALC uses, forward definitions and `Delete` are implemented.  The
+runtime is 14,063 bytes; `rt_exec` is at HDR=0x4000 / data 0x5000, and the
+compiler's code ceiling is 0x8000.
 
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),

+ 5 - 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 41` at pos 44567, `Delete(Formula,1,1)`), the `{$I}` include,
+`ERR 102` at pos 48461, a local `set of Char`), 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`/
@@ -2067,9 +2067,10 @@ pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 literals/comparisons/arithmetic, self-recursion, `Copy`, real `Val`, the REAL
 standard functions (`Abs`, `Sqr`, `Sqrt`, `Ln`, `Exp`, `Sin`, `Cos`,
 `Arctan`), `Int(REAL)` and forward definitions that repeat only the name are
-landed.  The ladder now stops at the `Delete` string builtin (`ERR 41 44567`).
-The runtime is 13,955 bytes / 54 entries; the rt_exec scaffold is at
-HDR=0x4000 / data 0x5000.  Items 1-4 below are independent of both tracks.
+landed, along with `Delete`.  The ladder now stops at a local `set of Char`
+(`ERR 102 48461`).  The runtime is 14,063 bytes / 55 entries; the rt_exec
+scaffold is at HDR=0x4000 / data 0x5000.  Items 1-4 below are independent of
+both tracks.
 
 1. The rest of the string language. `v-TP3-STRVAR`/`v-TP3-STRREAD-ASSIGN` cover
    string variables, `s := 'literal'`, `writeln (s)`, `readln (s)`/`read (s)`

+ 45 - 4
shell/Compiler.mod

@@ -75,7 +75,7 @@ CONST
       displacement is relative to the END of the jump, so every offset in the
       image is EntSize further along than it was before the jump existed. *)
    EntSize   = 3 ;
-   MaxCode   = 7F00H ;
+   MaxCode   = 8000H ;
    (* Program layout, image offsets.  The original puts the runtime and the
       program's code in CS and the globals in a SEPARATE DS segment, so the
       .COM contains no data and the code is not limited by a data gap.  We
@@ -85,7 +85,7 @@ CONST
       code must end below CodeMax, where the boot harness puts the stdin
       descriptor (memory 7000h). *)
    DataStart = 8000H ;       (* image offset of the first global (memory 8100h) *)
-   CodeMax   = 7F00H ;       (* code must end below memory 7000h *)
+   CodeMax   = 8000H ;       (* code must end below memory 7000h *)
 
    MaxSym    = 3000 ;
    MaxPatch  = 2000 ;
@@ -144,7 +144,7 @@ CONST
    BI_New = 23 ; BI_Dispose = 24 ; BI_Eof = 25 ; BI_Val = 26 ;
    BI_Copy = 27 ; BI_Abs = 28 ; BI_Sqrt = 29 ; BI_Sqr = 30 ;
    BI_Ln = 31 ; BI_Exp = 32 ; BI_Sin = 33 ; BI_Cos = 34 ; BI_Arctan = 35 ;
-   BI_Int = 36 ;
+   BI_Int = 36 ; BI_Delete = 37 ;
    (* the sub-codes EmCrtSeq takes *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -423,7 +423,7 @@ VAR
    TU_RealAbs     : CARDINAL ;  TU_RealSqrt : CARDINAL ;
    TU_RealLn      : CARDINAL ;  TU_RealExp : CARDINAL ;
    TU_RealSin     : CARDINAL ;  TU_RealCos : CARDINAL ;  TU_RealArctan : CARDINAL ;
-   TU_RealIntFunc : CARDINAL ;
+   TU_RealIntFunc : CARDINAL ;  TU_StrDelete : CARDINAL ;
    TU_CmpStr   : CARDINAL ;  (* string comparison; two addresses on the stack,
                                 signed -1/0/+1 in AX *)
    TU_StrCat   : CARDINAL ;  (* string concatenation; dest and source addresses
@@ -5624,6 +5624,44 @@ BEGIN
       END ;
       RETURN
    END ;
+   IF which = BI_Delete THEN
+      (* Delete(S, pos, len): S must be a variable (or a DI-addressed field);
+         the runtime mutates it in place.  S's address is parked while the
+         two integer expressions are parsed. *)
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      ParseExpr (arg) ;
+      IF OK () AND (arg.cls = TString) AND
+         ((arg.kind = 1) OR (arg.kind = 5)) THEN
+         EmPushStrAddr (arg) ;
+         ExpectDelim (',', ENoSemi) ;
+         ParseExpr (dummy) ;
+         IF OK () AND ((dummy.cls = TScalar) OR (dummy.cls = TChar)) THEN
+            LoadAtom (dummy) ; EmPushAx () ;
+            ExpectDelim (',', ENoSemi) ;
+            ParseExpr (errV) ;
+            IF OK () AND ((errV.cls = TScalar) OR (errV.cls = TChar)) THEN
+               LoadAtom (errV) ; EmPushAx () ;
+               EmPopAx () ;                (* len *)
+               EmPopBx () ;                (* pos *)
+               EmPopCx () ;                (* source *)
+               EmPushAx () ; EmPushBx () ; EmPushCx () ;
+               DropC (EmCall (TU_StrDelete)) ;
+               EmAddSp (6)
+            ELSIF OK () THEN
+               Err (ETypeErr)
+            END
+         ELSIF OK () THEN
+            Err (ETypeErr)
+         END
+      ELSIF OK () THEN
+         Err (ETypeErr)
+      END ;
+      ExpectDelim (')', ENoSemi) ;
+      RETURN
+   END ;
    IF which = BI_Val THEN
       (* Val(S, V, E): integer conversion.  E receives 0 on success or the
          1-based position of the first invalid character; V is left unchanged
@@ -7939,6 +7977,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    i := NewSym ("INT", KBuiltin, BI_Int, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
+   i := NewSym ("DELETE", KBuiltin, BI_Delete, 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. *)
@@ -8126,6 +8166,7 @@ BEGIN
    TU_RealCos     := RT_Entry (52) ;
    TU_RealArctan  := RT_Entry (53) ;
    TU_RealIntFunc := RT_Entry (27) ;
+   TU_StrDelete   := RT_Entry (54) ;
    TU_WrStr    := RT_Entry (15) ;      (* a string variable is written through
                                           the address on the stack *)
    TU_RdStr    := RT_Entry (16) ;      (* readln(s)/read(s): TPSRC8 prdstr,

+ 1 - 0
shell/Runtime.def

@@ -93,6 +93,7 @@ CONST
    E_RealSin = 51 ;         (* [BP+4]=12-byte block; Sin of the first REAL *)
    E_RealCos = 52 ;         (* [BP+4]=12-byte block; Cos of the first REAL *)
    E_RealArctan = 53 ;      (* [BP+4]=12-byte block; Arctan of the first REAL *)
+   E_StrDelete = 54 ;       (* [BP+4]=counted string, [BP+6]=pos, [BP+8]=len *)
 
    (* File control block, mirrored by Compiler.FileVarSize. *)
    F_NameOff = 4 ;           (* handle word, mode word, then the name *)

+ 42 - 2
shell/Runtime.mod

@@ -632,6 +632,7 @@ PROCEDURE XorBxBx  ; BEGIN B (31H) ; B (0DBH) END XorBxBx ;  (* 31 DB: BX:=0 *)
 PROCEDURE MovBlDl  ; BEGIN B (8AH) ; B (0DAH) END MovBlDl ;  (* 8A DA: BL:=DL *)
 PROCEDURE MovBhAh  ; BEGIN B (88H) ; B (0E7H) END MovBhAh ;  (* 88 E7: BH:=AH *)
 PROCEDURE MovDxAx  ; BEGIN B (89H) ; B (0C2H) END MovDxAx ;  (* 89 C2: DX:=AX *)
+PROCEDURE MovAxDx  ; BEGIN B (89H) ; B (0D0H) END MovAxDx ;  (* 89 D0: AX:=DX *)
 PROCEDURE MovSiBp4 ; BEGIN B (8BH) ; B (76H) ; B (4) END MovSiBp4 ; (* SI:=[BP+4] *)
 PROCEDURE MovSiBp6 ; BEGIN B (8BH) ; B (76H) ; B (6) END MovSiBp6 ; (* SI:=[BP+6] *)
 PROCEDURE LdAxSi   ; BEGIN B (8BH) ; B (04H) END LdAxSi ;    (* 8B 04: AX:=[SI] *)
@@ -797,6 +798,8 @@ PROCEDURE AddBlBh ; BEGIN B (00H) ; B (0FBH) END AddBlBh ;       (* BL:=BL+BH *)
 PROCEDURE XorBhBh ; BEGIN B (30H) ; B (0FFH) END XorBhBh ;       (* BH:=0 *)
 PROCEDURE AddAlAh ; BEGIN B (00H) ; B (0E0H) END AddAlAh ;       (* AL:=AL+AH *)
 PROCEDURE AddAxCx ; BEGIN B (03H) ; B (0C1H) END AddAxCx ;       (* AX:=AX+CX *)
+PROCEDURE AddAxBx ; BEGIN B (03H) ; B (0C3H) END AddAxBx ;       (* AX:=AX+BX *)
+PROCEDURE SubAxCx ; BEGIN B (2BH) ; B (0C1H) END SubAxCx ;       (* AX:=AX-CX *)
 PROCEDURE AdcBxCx ; BEGIN B (13H) ; B (0D9H) END AdcBxCx ;       (* BX:=BX+CX+CF *)
 PROCEDURE AdcDxCx ; BEGIN B (13H) ; B (0D1H) END AdcDxCx ;       (* DX:=DX+CX+CF *)
 PROCEDURE AddAxDx ; BEGIN B (03H) ; B (0C2H) END AddAxDx ;       (* AX:=AX+DX *)
@@ -3314,6 +3317,42 @@ BEGIN
 END EmitSetOps ;
 
 
+PROCEDURE EmitStrDelete ;
+(* str_delete: Delete(S, pos, len).  S is a counted string modified in place;
+   pos is 1-based.  A non-positive length, pos < 1 or pos > |S| are no-ops.
+   The tail after the deleted range is moved down and the length byte is
+   rewritten. *)
+BEGIN
+   M ("str_delete") ;
+   PushBp ; MovBpSp ;
+   PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovBxBp4 ;                       (* BX := S *)
+   LdAlBx ; XorAhAh ; MovCxAx ;     (* CX := |S| *)
+   MovAxBp6 ;                        (* AX := pos *)
+   CmpAxImm (1) ; Jb8 ("strdel_done") ;
+   CmpAxCx ; Ja8 ("strdel_done") ;
+   MovDxAx ;                        (* DX := pos *)
+   MovAxBp8 ;                        (* AX := len *)
+   CmpAx0 ; Jle8 ("strdel_done") ;
+   MovSiAx ;                        (* SI := len *)
+   MovAxCx ; SubAxDx ; AddAxImm (1) ; (* AX := available *)
+   CmpAxSi ; Jbe8 ("strdel_count") ;
+   MovAxSi ;
+   M ("strdel_count") ;
+   MovCxAx ;                        (* CX := count *)
+   MovAxDx ; AddAxBx ; MovDiAx ;    (* DI := S + pos *)
+   AddAxCx ; MovSiAx ;              (* SI := first tail byte *)
+   (* tail = |S| - pos - count + 1 *)
+   LdAlBx ; XorAhAh ; SubAxDx ; SubAxCx ; AddAxImm (1) ; PushAx ;
+   LdAlBx ; XorAhAh ; SubAxCx ; StBxAl ; (* new length *)
+   PopAx ; MovCxAx ;
+   Jcxz8 ("strdel_done") ;
+   M ("strdel_loop") ;
+   LdAlSi ; StDiAl ; IncSi ; IncDi ; Loop8 ("strdel_loop") ;
+   M ("strdel_done") ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ; MovSpBp ; PopBp ; RetR
+END EmitStrDelete ;
+
 PROCEDURE EmitFileOps ;
 (* File control-block operations.  The block is Compiler.FileVarSize:
       +0  DOS handle (FFFFh when closed)
@@ -3960,7 +3999,7 @@ BEGIN
    EmitRdStr ; EmitStrStore ; EmitCmpStr ; EmitStrCat ; EmitStrCopy ;
    EmitRealFromInt ; EmitRealAddSub ; EmitRealMul ;
    EmitRealCmp ; EmitRealInt ; EmitRealMath ; EmitRealConv ; EmitSetOps ;
-   EmitFileOps ; EmitValReal ;
+   EmitStrDelete ; EmitFileOps ; EmitValReal ;
    EmitData ;
    FixUp ;
    SetStr (entNm [0], "initmem") ;
@@ -4017,6 +4056,7 @@ BEGIN
    SetStr (entNm [51], "real_sin") ;
    SetStr (entNm [52], "real_cos") ;
    SetStr (entNm [53], "real_arctan") ;
+   SetStr (entNm [54], "str_delete") ;
    built := TRUE
 END RT_Build ;
 
@@ -4044,7 +4084,7 @@ BEGIN
    IF NOT built THEN
       RT_Build (0)
    END ;
-   IF i > 53 THEN
+   IF i > 54 THEN
       RETURN 0
    END ;
    RETURN rtBase + LblOff (entNm [i])

+ 4 - 3
shell/tests/RtProbe.mod

@@ -108,7 +108,7 @@ END PENT ;
 
 PROCEDURE Main ;
 VAR i, n, base : CARDINAL ;
-    names : ARRAY [0..53] OF ARRAY [0..15] OF CHAR ;
+    names : ARRAY [0..54] OF ARRAY [0..15] OF CHAR ;
 BEGIN
    base := GetBase () ;
    RT_Build (base) ;
@@ -121,7 +121,7 @@ BEGIN
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    PS ("code ends at ") ; PCARD (RT_CodeEnd ()) ; NL ;
    i := 0 ;
-   WHILE i <= 53 DO
+   WHILE i <= 54 DO
       names [i] := "" ;
       INC (i)
    END ;
@@ -166,8 +166,9 @@ BEGIN
    names [51] := "real_sin" ;
    names [52] := "real_cos" ;
    names [53] := "real_arctan" ;
+   names [54] := "str_delete" ;
    i := 0 ;
-   WHILE i <= 53 DO
+   WHILE i <= 54 DO
       PENT (i, names [i]) ;
       INC (i)
    END ;

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

@@ -25,18 +25,15 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-23): `delete(Formula,1,1)' in Evaluate.
+# Current rung (2026-10-23): `OkChars : set of Char' in GotoX's scope.
 # 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), VAR/
 # value REAL and REAL function results, REAL literals/comparisons/arithmetic,
 # self-recursion, enum-indexed arrays, string-array typed constants, local REAL
-# variables, Copy, real Val, Abs/Sqr/Sqrt, Ln/Exp/Sin/Cos/Arctan, Int(REAL) and
-# forward definitions that repeat only the name moved the ladder 15911 -> 18267
-# -> 19847 -> 20912 -> 22253 -> 22280 -> 22706 -> 22859 -> 23700 -> 25674 ->
-# 26066 -> 26924 -> 27648 -> 28074 -> 31758 -> 32096 -> 32284 -> 32482 ->
-# 32564 -> 33374 -> 33537 -> 33778 -> 35135 -> 36054 -> 39987 -> 40263 ->
-# 40930 -> 41118 -> 41595 -> 43902 -> 44567.  The next blocker is the Delete
-# string builtin (TP3 error 41).
-CALC.PAS	ERR	41	44567
+# variables, Copy, real Val, Abs/Sqr/Sqrt, Ln/Exp/Sin/Cos/Arctan, Int(REAL),
+# forward definitions that repeat only the name and Delete moved the ladder
+# 15911 -> ... -> 43902 -> 44567 -> 47788 -> 48461.  The next blocker is a
+# local `set of Char' declaration (TP3 error 102).
+CALC.PAS	ERR	102	48461

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

@@ -719,3 +719,6 @@ t106_trig	OK	1338	184
 
 #   t107_forward         forward definition repeating only the name; formals stay in scope.
 t107_forward	OK	99	6
+
+#   t108_delete           Delete(S,pos,len): middle/front/truncation/no-ops.
+t108_delete	OK	417	26

+ 7 - 0
shell/tests/fixtures/t108_delete.out

@@ -0,0 +1,7 @@
+aef
+ef
+a
+a
+a
+a
+[]

+ 26 - 0
shell/tests/fixtures/t108_delete.pas

@@ -0,0 +1,26 @@
+program t108_delete;
+
+{ t108 -- the Delete(S, pos, len) string builtin: middle, front, truncation,
+  and the no-op positions. }
+
+var
+  S : string[20];
+begin
+  S := 'abcdef';
+  Delete (S, 2, 3);
+  writeln (S);
+  Delete (S, 1, 1);
+  writeln (S);
+  S := 'abcdef';
+  Delete (S, 2, 99);
+  writeln (S);
+  Delete (S, 10, 2);
+  writeln (S);
+  Delete (S, 0, 2);
+  writeln (S);
+  Delete (S, 1, 0);
+  writeln (S);
+  S := '';
+  Delete (S, 1, 1);
+  writeln ('[', S, ']')
+end.

+ 1 - 1
shell/tests/rt_exec.py

@@ -117,7 +117,7 @@ ENTS = ["initmem", "progend", "stackchk", "wrint", "wrchar", "wrbool",
         "ioresult", "io_store", "heap_new", "file_eof", "file_readln",
         "int_fmt", "val_int", "str_copy", "val_real", "real_abs",
         "real_sqrt", "real_ln", "real_exp", "real_sin", "real_cos",
-        "real_arctan"]
+        "real_arctan", "str_delete"]
 
 # A call slot's flags, as rtdrv.s reads them.
 F_STACK = 1     # the argument goes on the stack, popped by the caller

File diff suppressed because it is too large
+ 690 - 690
shell/tests/runtime.golden


Some files were not shown because too many files changed in this diff