Browse Source

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 days ago
parent
commit
823fbbde40

+ 13 - 7
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | 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):
 Rungs behind it (now passed):
 
 
@@ -156,7 +156,9 @@ Rungs ahead:
 | 41118 | `Sin`/`Cos`/`Arctan` - DONE |
 | 41118 | `Sin`/`Cos`/`Arctan` - DONE |
 | 41595 | `Int(f)` - DONE |
 | 41595 | `Int(f)` - DONE |
 | 43902 | forward definition repeating only the name - 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
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
 below was written before them:
@@ -534,7 +536,8 @@ Exec86):
 | `30782f6` | `v-TP3-CALC-REALEXPR` | `ERR 41 35135` (`Copy`) |
 | `30782f6` | `v-TP3-CALC-REALEXPR` | `ERR 41 35135` (`Copy`) |
 | `df54e71` | `v-TP3-CALC-COPYVAL` | `ERR 41 40930` (`Exp`) |
 | `df54e71` | `v-TP3-CALC-COPYVAL` | `ERR 41 40930` (`Exp`) |
 | `dcfbf8c` | `v-TP3-CALC-TRANSCEND` | `ERR 41 43902` (forward definition) |
 | `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.
 - **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
@@ -594,6 +597,9 @@ Exec86):
 - **`Abs`, `Sqr` and `Sqrt` are landed (`t104_mathbasic`).**  `Abs` clears the
 - **`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
   MBF sign, `Sqr` lowers to the real multiply entry, and `Sqrt` is Newton over
   the existing real division/addition entries.
   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
 - **Forward definitions may repeat only the name (`t107_forward`).**  The
   earlier `function Expression{(...)}` source exposed two bugs: a forward
   earlier `function Expression{(...)}` source exposed two bugs: a forward
   `FUNCTION` was rejected as if it were a duplicate `PROCEDURE`, and the
   `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`),
 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 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`
 **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),

+ 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
 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 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),
 `^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`/
@@ -2067,9 +2067,10 @@ pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 literals/comparisons/arithmetic, self-recursion, `Copy`, real `Val`, the REAL
 literals/comparisons/arithmetic, self-recursion, `Copy`, real `Val`, the REAL
 standard functions (`Abs`, `Sqr`, `Sqrt`, `Ln`, `Exp`, `Sin`, `Cos`,
 standard functions (`Abs`, `Sqr`, `Sqrt`, `Ln`, `Exp`, `Sin`, `Cos`,
 `Arctan`), `Int(REAL)` and forward definitions that repeat only the name are
 `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
 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)`
    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
       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. *)
       image is EntSize further along than it was before the jump existed. *)
    EntSize   = 3 ;
    EntSize   = 3 ;
-   MaxCode   = 7F00H ;
+   MaxCode   = 8000H ;
    (* Program layout, image offsets.  The original puts the runtime and the
    (* 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
       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
       .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
       code must end below CodeMax, where the boot harness puts the stdin
       descriptor (memory 7000h). *)
       descriptor (memory 7000h). *)
    DataStart = 8000H ;       (* image offset of the first global (memory 8100h) *)
    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 ;
    MaxSym    = 3000 ;
    MaxPatch  = 2000 ;
    MaxPatch  = 2000 ;
@@ -144,7 +144,7 @@ CONST
    BI_New = 23 ; BI_Dispose = 24 ; BI_Eof = 25 ; BI_Val = 26 ;
    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_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_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 *)
    (* 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 ;
@@ -423,7 +423,7 @@ VAR
    TU_RealAbs     : CARDINAL ;  TU_RealSqrt : CARDINAL ;
    TU_RealAbs     : CARDINAL ;  TU_RealSqrt : CARDINAL ;
    TU_RealLn      : CARDINAL ;  TU_RealExp : CARDINAL ;
    TU_RealLn      : CARDINAL ;  TU_RealExp : CARDINAL ;
    TU_RealSin     : CARDINAL ;  TU_RealCos : CARDINAL ;  TU_RealArctan : 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,
    TU_CmpStr   : CARDINAL ;  (* string comparison; two addresses on the stack,
                                 signed -1/0/+1 in AX *)
                                 signed -1/0/+1 in AX *)
    TU_StrCat   : CARDINAL ;  (* string concatenation; dest and source addresses
    TU_StrCat   : CARDINAL ;  (* string concatenation; dest and source addresses
@@ -5624,6 +5624,44 @@ BEGIN
       END ;
       END ;
       RETURN
       RETURN
    END ;
    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
    IF which = BI_Val THEN
       (* Val(S, V, E): integer conversion.  E receives 0 on success or the
       (* 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
          1-based position of the first invalid character; V is left unchanged
@@ -7939,6 +7977,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    symtab [i].defnd := TRUE ;
    i := NewSym ("INT", KBuiltin, BI_Int, 0, 0, 0, 0, FALSE) ;
    i := NewSym ("INT", KBuiltin, BI_Int, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
    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
    (* 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. *)
@@ -8126,6 +8166,7 @@ BEGIN
    TU_RealCos     := RT_Entry (52) ;
    TU_RealCos     := RT_Entry (52) ;
    TU_RealArctan  := RT_Entry (53) ;
    TU_RealArctan  := RT_Entry (53) ;
    TU_RealIntFunc := RT_Entry (27) ;
    TU_RealIntFunc := RT_Entry (27) ;
+   TU_StrDelete   := RT_Entry (54) ;
    TU_WrStr    := RT_Entry (15) ;      (* a string variable is written through
    TU_WrStr    := RT_Entry (15) ;      (* a string variable is written through
                                           the address on the stack *)
                                           the address on the stack *)
    TU_RdStr    := RT_Entry (16) ;      (* readln(s)/read(s): TPSRC8 prdstr,
    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_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_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_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. *)
    (* File control block, mirrored by Compiler.FileVarSize. *)
    F_NameOff = 4 ;           (* handle word, mode word, then the name *)
    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 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 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 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 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 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] *)
 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 XorBhBh ; BEGIN B (30H) ; B (0FFH) END XorBhBh ;       (* BH:=0 *)
 PROCEDURE AddAlAh ; BEGIN B (00H) ; B (0E0H) END AddAlAh ;       (* AL:=AL+AH *)
 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 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 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 AdcDxCx ; BEGIN B (13H) ; B (0D1H) END AdcDxCx ;       (* DX:=DX+CX+CF *)
 PROCEDURE AddAxDx ; BEGIN B (03H) ; B (0C2H) END AddAxDx ;       (* AX:=AX+DX *)
 PROCEDURE AddAxDx ; BEGIN B (03H) ; B (0C2H) END AddAxDx ;       (* AX:=AX+DX *)
@@ -3314,6 +3317,42 @@ BEGIN
 END EmitSetOps ;
 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 ;
 PROCEDURE EmitFileOps ;
 (* File control-block operations.  The block is Compiler.FileVarSize:
 (* File control-block operations.  The block is Compiler.FileVarSize:
       +0  DOS handle (FFFFh when closed)
       +0  DOS handle (FFFFh when closed)
@@ -3960,7 +3999,7 @@ BEGIN
    EmitRdStr ; EmitStrStore ; EmitCmpStr ; EmitStrCat ; EmitStrCopy ;
    EmitRdStr ; EmitStrStore ; EmitCmpStr ; EmitStrCat ; EmitStrCopy ;
    EmitRealFromInt ; EmitRealAddSub ; EmitRealMul ;
    EmitRealFromInt ; EmitRealAddSub ; EmitRealMul ;
    EmitRealCmp ; EmitRealInt ; EmitRealMath ; EmitRealConv ; EmitSetOps ;
    EmitRealCmp ; EmitRealInt ; EmitRealMath ; EmitRealConv ; EmitSetOps ;
-   EmitFileOps ; EmitValReal ;
+   EmitStrDelete ; EmitFileOps ; EmitValReal ;
    EmitData ;
    EmitData ;
    FixUp ;
    FixUp ;
    SetStr (entNm [0], "initmem") ;
    SetStr (entNm [0], "initmem") ;
@@ -4017,6 +4056,7 @@ BEGIN
    SetStr (entNm [51], "real_sin") ;
    SetStr (entNm [51], "real_sin") ;
    SetStr (entNm [52], "real_cos") ;
    SetStr (entNm [52], "real_cos") ;
    SetStr (entNm [53], "real_arctan") ;
    SetStr (entNm [53], "real_arctan") ;
+   SetStr (entNm [54], "str_delete") ;
    built := TRUE
    built := TRUE
 END RT_Build ;
 END RT_Build ;
 
 
@@ -4044,7 +4084,7 @@ BEGIN
    IF NOT built THEN
    IF NOT built THEN
       RT_Build (0)
       RT_Build (0)
    END ;
    END ;
-   IF i > 53 THEN
+   IF i > 54 THEN
       RETURN 0
       RETURN 0
    END ;
    END ;
    RETURN rtBase + LblOff (entNm [i])
    RETURN rtBase + LblOff (entNm [i])

+ 4 - 3
shell/tests/RtProbe.mod

@@ -108,7 +108,7 @@ END PENT ;
 
 
 PROCEDURE Main ;
 PROCEDURE Main ;
 VAR i, n, base : CARDINAL ;
 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
 BEGIN
    base := GetBase () ;
    base := GetBase () ;
    RT_Build (base) ;
    RT_Build (base) ;
@@ -121,7 +121,7 @@ BEGIN
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    PS ("code ends at ") ; PCARD (RT_CodeEnd ()) ; NL ;
    PS ("code ends at ") ; PCARD (RT_CodeEnd ()) ; NL ;
    i := 0 ;
    i := 0 ;
-   WHILE i <= 53 DO
+   WHILE i <= 54 DO
       names [i] := "" ;
       names [i] := "" ;
       INC (i)
       INC (i)
    END ;
    END ;
@@ -166,8 +166,9 @@ BEGIN
    names [51] := "real_sin" ;
    names [51] := "real_sin" ;
    names [52] := "real_cos" ;
    names [52] := "real_cos" ;
    names [53] := "real_arctan" ;
    names [53] := "real_arctan" ;
+   names [54] := "str_delete" ;
    i := 0 ;
    i := 0 ;
-   WHILE i <= 53 DO
+   WHILE i <= 54 DO
       PENT (i, names [i]) ;
       PENT (i, names [i]) ;
       INC (i)
       INC (i)
    END ;
    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
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 # 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
 # UpCase, run-time set membership, string fields through DI, the original memory
 # layout, untyped-file declarations, file control-block operations, VAR string
 # layout, untyped-file declarations, file control-block operations, VAR string
 # parameters, Chr, typed-file block I/O, text-file output, Str,
 # parameters, Chr, typed-file block I/O, text-file output, Str,
 # pointers/New/dereference, text Eof/Readln, Str(integer), Val(integer), VAR/
 # pointers/New/dereference, text Eof/Readln, Str(integer), Val(integer), VAR/
 # value REAL and REAL function results, REAL literals/comparisons/arithmetic,
 # value REAL and REAL function results, REAL literals/comparisons/arithmetic,
 # self-recursion, enum-indexed arrays, string-array typed constants, local REAL
 # 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         forward definition repeating only the name; formals stay in scope.
 t107_forward	OK	99	6
 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",
         "ioresult", "io_store", "heap_new", "file_eof", "file_readln",
         "int_fmt", "val_int", "str_copy", "val_real", "real_abs",
         "int_fmt", "val_int", "str_copy", "val_real", "real_abs",
         "real_sqrt", "real_ln", "real_exp", "real_sin", "real_cos",
         "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.
 # A call slot's flags, as rtdrv.s reads them.
 F_STACK = 1     # the argument goes on the stack, popped by the caller
 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