Explorar el Código

compiler: WITH, n-dimensional subscripts, fields through DI

CALC.INC:158 is

    with Sheet[I,J] do begin CellStatus := [Txt]; ... end;

WITH was a bare ENoLib, `a[1,2]` did not parse (the subscript reader
took one expression and demanded ']'), and a field of a run-time-indexed
element was refused.

Subscripts: one expression per dimension, comma separated.  The offset
is sum((i[k]-lo[k])*stride[k]), stride[k] = elemsize * the count of
every LATER dimension.  A constant index folds into coff; run-time
indices are scaled as parsed and summed on the stack ONLY when another
dimension follows, so 1-D code stays byte-identical (t75 is unchanged).

Fields: `Sheet[I,J].Field` adds the field offset to DI.  The field table
is the element record's, which DefVar already copies onto an array
variable - but only for an INLINE `array ... of Rec'; a NAMED array type
lost it (DefType stored arrIdx but not the element's fldFirst/fldLast).
Fixed.  That is the same family as the named-type `elem' bug from
v-TP3-CALC-ARRVAR.

WITH: each base is read, its record field range recorded, and pushed on
a scope stack; bare identifiers are resolved against it BEFORE Search
(fields shadow outer names).  A DI-based base is parked in a two-byte
data slot because the body may clobber DI; each access reloads it.  A
constant-index element stays symbol+boff.  Fields wider than a word
(strings) are refused through DI rather than addressed as the array.

TWO LATENT BUGS surfaced by the compile matrix, which compiles every
fixture in ONE process:
  * a record's recFldFirst was captured before its field types were
    parsed, and ParseType's named-type arm overwrote it with the TYPE's
    range (0/0 for Integer).  The first record in a file was right by
    accident; later ones started at 0 and a WITH lookup could scan the
    PREVIOUS record's fields.  t65 (field B) followed by t77 (field b)
    silently changed a store from a byte to a word.
  * fldTop/arrTop/withN were never reset per compile; they are now,
    so one file cannot depend on the last.

t77_with: WITH over a record variable, a constant-index element and a
2-D run-time element; field reads back inside the body; 2-D and mixed
subscripts; and an aliasing check (g[1,2] vs g[2,1]) that a wrong row
stride cannot fake.  Non-vacuity drops the row stride and the WITH
element offset.

The ladder moves 15026 -> 15131, now `CellStatus := [Txt]' - a SET
assignment to a record field (the set constructor and a store through
DI).
Eric Streit hace 2 días
padre
commit
64eef50061

+ 320 - 68
shell/Compiler.mod

@@ -311,6 +311,17 @@ VAR
 
    caseJmp : ARRAY [0..63] OF CARDINAL ;
    caseN   : CARDINAL ;
+
+   (* the active WITH scopes, innermost last.  A DI-based base (an array
+      element addressed at run time) is parked in a two-byte data slot: the
+      body may clobber DI, so each field access reloads it. *)
+   withN    : CARDINAL ;
+   withIsDI : ARRAY [0..3] OF BOOLEAN ;
+   withIdx  : ARRAY [0..3] OF CARDINAL ;
+   withBoff : ARRAY [0..3] OF CARDINAL ;
+   withSlot : ARRAY [0..3] OF CARDINAL ;
+   withFF   : ARRAY [0..3] OF CARDINAL ;
+   withFL   : ARRAY [0..3] OF CARDINAL ;
    lblLo, lblHi : ARRAY [0..31] OF LONGINT ;  (* one arm's label list *)
    lblJmp : ARRAY [0..63] OF CARDINAL ;       (* its body jumps: 1 or 2 per label *)
 
@@ -1318,6 +1329,27 @@ END EmLeaDi ;
 PROCEDURE EmAddDiAx () ;
 BEGIN Ebyte (01H) ; Ebyte (0C7H) END EmAddDiAx ;  (* 01 C7: DI := DI + AX *)
 
+PROCEDURE EmAddDiImm (n : CARDINAL) ;
+(* ADD DI,imm16: a record field's offset when the element's address is already
+   in DI (`Sheet[I,J].Field', `with Sheet[I,J] do'). *)
+BEGIN
+   Ebyte (81H) ; Ebyte (0C7H) ; Eword (n MOD 10000H)
+END EmAddDiImm ;
+
+PROCEDURE EmLdDiGlob (off : CARDINAL) ;
+(* MOV DI,[off]: recover the base address WITH saved in a scratch word.  The
+   body of a WITH may clobber DI, so the address is parked in the data area
+   and reloaded for every field access. *)
+BEGIN
+   Ebyte (8BH) ; Ebyte (3EH) ; Eword ((off + LoadBias) MOD 10000H)
+END EmLdDiGlob ;
+
+PROCEDURE EmStDiGlob (off : CARDINAL) ;
+(* MOV [off],DI: the WITH statement's base-address scratch. *)
+BEGIN
+   Ebyte (89H) ; Ebyte (3EH) ; Eword ((off + LoadBias) MOD 10000H)
+END EmStDiGlob ;
+
 PROCEDURE EmLdAlDi () ;
 BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ;    (* 8A 05: AL := [DI] *)
 
@@ -2253,7 +2285,9 @@ PROCEDURE ParseSub (VAR r : ERes) ;
    element-size scaling that a one-byte string element does not, and it is
    item 2. *)
 VAR t : ERes ;
-    ai, fi : CARDINAL ;
+    ai, fi, nd, k, st : CARDINAL ;
+    coff : LONGINT ;
+    accOnStack, haveVar, more : BOOLEAN ;
     found : BOOLEAN ;
 BEGIN
    LOOP
@@ -2262,12 +2296,6 @@ BEGIN
          (* FIELD selection: `r.f'.  The field's offset adds to the record
             base's, and the value's class and WIDTH become the field's - which
             is the whole reason a width rides on the expression (VarSize). *)
-         IF r.kind = 5 THEN
-            (* the element is addressed through DI, not by idx+boff; its field
-               table would have to travel with the expression *)
-            Err (ENoLib) ;
-            RETURN
-         END ;
          DropCh (GetCh ()) ;
          Skip () ;
          IF NOT Alpha (CurCh ()) THEN
@@ -2292,18 +2320,28 @@ BEGIN
             Err (EUnknown) ;
             RETURN
          END ;
-         r.boff := W16 (VAL (LONGINT, r.boff)
-                        + VAL (LONGINT, fields [fi].off)) ;
+         IF r.kind = 5 THEN
+            (* The element's address is in DI: a field is a fixed offset from
+               it.  The array symbol already carries the element record's
+               field range (DefVar copies recFldFirst/recFldLast), which is
+               why the lookup above works for `Sheet[I,J].Field' too. *)
+            IF fields [fi].off # 0 THEN
+               EmAddDiImm (fields [fi].off)
+            END
+         ELSE
+            r.boff := W16 (VAL (LONGINT, r.boff)
+                           + VAL (LONGINT, fields [fi].off)) ;
+         END ;
          r.cls := fields [fi].cls ;
          r.sz := fields [fi].size
       ELSIF CurCh () = '[' THEN
          DropCh (GetCh ()) ;
-         ParseExpr (t) ;
-         IF OK () THEN
-            IF symtab [r.idx].cls = TString THEN
-               (* s[i]: a STRING is a length byte at s[0] followed by the
-                  characters, so index i selects the one byte at off+i.  A second
-                  subscript on a character is not a type. *)
+         IF symtab [r.idx].cls = TString THEN
+            (* s[i]: a STRING is a length byte at s[0] followed by the
+               characters, so index i selects the one byte at off+i.  A second
+               subscript on a character is not a type. *)
+            ParseExpr (t) ;
+            IF OK () THEN
                IF r.cls = TChar THEN
                   Err (ESimpType) ;
                   RETURN
@@ -2331,65 +2369,120 @@ BEGIN
                END ;
                r.cls := TChar ;
                r.sz := 1
-            ELSIF symtab [r.idx].cls = TArray THEN
-               (* An array subscript.  The element's address is
-                  (index - lower bound) * element size from the array base, and
-                  the value's width and class become the ELEMENT's - so a store
-                  writes two bytes for an `array of Integer', not the whole
-                  array. *)
-               IF symtab [r.idx].arrIdx = 0 THEN
-                  Err (ESimpType) ;
+            END ;
+            ExpectDelim (']', ENoSemi)
+         ELSIF symtab [r.idx].cls = TArray THEN
+            (* An array subscript LIST: one expression per dimension, comma
+               separated.  The byte offset is
+                  sum over k of (i[k] - lo[k]) * stride[k]
+               where stride[k] is the element size times the count of every
+               LATER dimension (row-major: the LAST dimension varies fastest).
+               A constant index folds into coff; a run-time one is scaled as
+               soon as it is parsed and summed on the STACK, because parsing
+               the next index may clobber AX and DI. *)
+            IF (r.kind = 5) OR (symtab [r.idx].arrIdx = 0) THEN
+               Err (ESimpType) ;
+               RETURN
+            END ;
+            ai := symtab [r.idx].arrIdx - 1 ;
+            nd := 0 ;
+            coff := 0 ;
+            accOnStack := FALSE ;
+            haveVar := FALSE ;
+            LOOP
+               IF nd >= arrs [ai].n THEN
+                  Err (ETypeErr) ;
                   RETURN
                END ;
-               ai := symtab [r.idx].arrIdx - 1 ;
+               ParseExpr (t) ;
+               IF NOT OK () THEN
+                  RETURN
+               END ;
+               st := arrs [ai].elem ;
+               k := nd + 1 ;
+               WHILE k < arrs [ai].n DO
+                  st := st * W16 (arrs [ai].hi [k] - arrs [ai].lo [k] + 1) ;
+                  INC (k)
+               END ;
+               Skip () ;
+               more := CurCh () = ',' ;
                IF t.kind = 0 THEN
-                  (* constant index: fold it into boff, as before *)
-                  r.boff := W16 (VAL (LONGINT, r.boff)
-                                 + (t.imm - arrs [ai].lo [0])
-                                   * VAL (LONGINT, arrs [ai].elem)) ;
-                  r.sz := arrs [ai].elem ;
-                  r.cls := arrs [ai].ecls
-               ELSIF arrs [ai].n = 1 THEN
-                  (* Run-time index, one dimension: AX := (i - lo) * elem,
-                     then DI := base + AX.  The element's address rides in DI
-                     exactly as a string element's does, so LoadAtom,
-                     Assignment, IoCall and SaveLeft already know the shape;
-                     only the WIDTH is new (1 or 2 bytes, not always a char). *)
-                  IF r.kind = 5 THEN
-                     (* a second subscript on an element already addressed
-                        through DI: 2-D run-time indexing is not implemented *)
-                     Err (ENoLib) ;
-                     RETURN
-                  END ;
+                  coff := coff + (t.imm - arrs [ai].lo [nd])
+                                 * VAL (LONGINT, st)
+               ELSE
                   LoadAtom (t) ;
-                  EmMovCxi (W16 (arrs [ai].lo [0])) ;
-                  EmSubAxCx () ;
-                  IF arrs [ai].elem # 1 THEN
-                     EmMovCxi (arrs [ai].elem) ;
+                  IF arrs [ai].lo [nd] # 0 THEN
+                     EmMovCxi (W16 (arrs [ai].lo [nd])) ;
+                     EmSubAxCx ()
+                  END ;
+                  IF st # 1 THEN
+                     EmMovCxi (st) ;
                      EmMulAxCx ()
                   END ;
-                  EmLeaDi (symtab [r.idx].local,
-                           (symtab [r.idx].off + r.boff) MOD 10000H) ;
-                  EmAddDiAx () ;
-                  r.kind := 5 ;
-                  r.sz := arrs [ai].elem ;
-                  r.cls := arrs [ai].ecls
+                  IF more THEN
+                     (* the next dimension's expression will clobber AX: park
+                        the running sum.  A SINGLE index skips this entirely,
+                        so 1-D code is byte-identical to the old path. *)
+                     IF accOnStack THEN
+                        EmPopCx () ;
+                        EmAddAxCx () ;
+                        EmPushAx ()
+                     ELSE
+                        EmPushAx () ;
+                        accOnStack := TRUE
+                     END
+                  ELSE
+                     (* last dimension: AX is the total *)
+                     IF accOnStack THEN
+                        EmPopCx () ;
+                        EmAddAxCx () ;
+                        accOnStack := FALSE
+                     END ;
+                     haveVar := TRUE
+                  END
+               END ;
+               INC (nd) ;
+               IF more THEN
+                  DropCh (GetCh ())
                ELSE
-                  (* two or more dimensions and a run-time index: the row
-                     stride is (hi1 - lo1 + 1) * elem, which is the next
-                     increment; loud, not a wrong address. *)
-                  Err (ENoLib) ;
-                  RETURN
+                  EXIT
                END
-            ELSIF t.kind # 0 THEN
-               Err (ENoLib) ;
+            END ;
+            IF nd # arrs [ai].n THEN
+               (* fewer subscripts than dimensions: the value would be a
+                  sub-array, which has no scalar representation *)
+               Err (ETypeErr) ;
                RETURN
+            END ;
+            ExpectDelim (']', ENoSemi) ;
+            IF accOnStack THEN
+               (* the last dimensions were constant: the parked sum is still
+                  on the stack, and AX is the total *)
+               EmPopAx () ;
+               accOnStack := FALSE
+            END ;
+            IF haveVar THEN
+               EmLeaDi (symtab [r.idx].local,
+                        (symtab [r.idx].off + r.boff
+                         + W16 (coff)) MOD 10000H) ;
+               EmAddDiAx () ;
+               r.kind := 5
             ELSE
-               Err (ESimpType) ;
-               RETURN
-            END
-         END ;
-         ExpectDelim (']', ENoSemi)
+               r.boff := W16 (VAL (LONGINT, r.boff) + coff)
+            END ;
+            r.sz := arrs [ai].elem ;
+            r.cls := arrs [ai].ecls
+         ELSE
+            ParseExpr (t) ;
+            IF OK () THEN
+               IF t.kind # 0 THEN
+                  Err (ENoLib)
+               ELSE
+                  Err (ESimpType)
+               END
+            END ;
+            ExpectDelim (']', ENoSemi)
+         END
       ELSE
          RETURN
       END
@@ -2720,7 +2813,11 @@ PROCEDURE EmPushStrAddr (r : ERes) ;
    is a type error rather than a length-1 string compare.  That is deliberate
    - it is the same rule `c := 'a'` relies on - and the caller rejects it. *)
 BEGIN
-   IF r.kind = 1 THEN
+   IF r.kind = 5 THEN
+      (* a string element/field addressed through DI: the counted-string
+         consumers take a symbol+offset, not an address in DI *)
+      Err (ENoLib)
+   ELSIF r.kind = 1 THEN
       EmPushVarAddr (symtab [r.idx].local,
                      (symtab [r.idx].off + r.boff) MOD 10000H)
    ELSIF r.kind = 3 THEN
@@ -3274,6 +3371,51 @@ BEGIN
    ParseAtom (r)
 END ParseNeg ;
 
+PROCEDURE WithLookup (nm : ARRAY OF CHAR ; VAR r : ERes) : BOOLEAN ;
+(* Resolve a bare identifier against the active WITH scopes, innermost first.
+   ISO Pascal lets a record field shadow an outer declaration, so this is
+   consulted BEFORE Search.  The result is filled exactly as a variable
+   reference: kind 1 (base symbol + boff) for a record variable or a
+   constant-index element, kind 5 (address in DI) for a run-time-indexed one,
+   where the base is reloaded from the WITH slot because the body may have
+   used DI. *)
+VAR w, fi : CARDINAL ;
+    found : BOOLEAN ;
+BEGIN
+   w := withN ;
+   WHILE w > 0 DO
+      DEC (w) ;
+      fi := withFF [w] ;
+      found := FALSE ;
+      WHILE (fi < withFL [w]) AND NOT found DO
+         IF NameEq (fields [fi].name, nm) THEN
+            found := TRUE
+         ELSE
+            INC (fi)
+         END
+      END ;
+      IF found THEN
+         IF withIsDI [w] THEN
+            EmLdDiGlob (withSlot [w]) ;
+            IF fields [fi].off # 0 THEN
+               EmAddDiImm (fields [fi].off)
+            END ;
+            r.kind := 5
+         ELSE
+            r.kind := 1 ;
+            r.boff := W16 (VAL (LONGINT, withBoff [w])
+                           + VAL (LONGINT, fields [fi].off))
+         END ;
+         r.idx := withIdx [w] ;
+         r.cls := fields [fi].cls ;
+         r.sz := fields [fi].size ;
+         r.chr := FALSE ;
+         RETURN TRUE
+      END
+   END ;
+   RETURN FALSE
+END WithLookup ;
+
 PROCEDURE ParseAtom (VAR r : ERes) ;
 (* const | variable | func(params) | '(' expr ')' | '[' set ']' *)
 VAR idx : CARDINAL ;
@@ -3340,6 +3482,10 @@ BEGIN
       RETURN
    END ;
    GetWord () ;
+   IF WithLookup (wrd, r) THEN
+      ParseSub (r) ;
+      RETURN
+   END ;
    IF NOT Search (wrd, idx) THEN
       Err (EUnknown) ;
       RETURN
@@ -3661,6 +3807,13 @@ BEGIN
       Err (EUnknown) ;
       RETURN
    END ;
+   IF (r.kind = 5) AND (r.cls = TString) THEN
+      (* A whole string field of a run-time-indexed record element: the
+         string paths address by symbol+boff, which is not this element.
+         Loud until a counted-string copy through DI exists. *)
+      Err (ENoLib) ;
+      RETURN
+   END ;
    IF (r.kind = 1) AND symtab [r.idx].isVar THEN
       (* `varparam := expr': store through the address the slot holds.  DI is
          parked across the right-hand side because that expression may use DI
@@ -4025,6 +4178,11 @@ BEGIN
                IF (acls = TString) AND (arg.cls = TChar) THEN
                   acls := TChar
                END ;
+               IF (acls = TString) AND (arg.kind = 5) THEN
+                  (* a string field of a DI-addressed element *)
+                  Err (ENoLib) ;
+                  RETURN
+               END ;
                IF arg.kind = 5 THEN
                   (* A variable index: ParseSub computed the element's address
                      into DI, and nothing has been emitted since, so that is
@@ -4112,6 +4270,12 @@ BEGIN
                   END ;
                   pushed := FALSE                (* nothing was pushed for this one *)
                ELSE
+                  IF (acls = TString) AND (arg.kind = 5) THEN
+                     (* a string field of a DI-addressed element: there is no
+                        symbol+offset address to push *)
+                     Err (ENoLib) ;
+                     RETURN
+                  END ;
                   IF acls = TString THEN
                      (* A string *variable*.  Its value IS its address, so it is
                         passed exactly the way READ passes an address: push it
@@ -4213,6 +4377,7 @@ VAR tok : CARDINAL ;
     nm : ARRAY [0..MaxName] OF CHAR ;
     strf : BOOLEAN ;
     dow : BOOLEAN ;
+    savedWith : CARDINAL ;
 BEGIN
    Skip () ;
    IF Digit (CurCh ()) THEN
@@ -4620,9 +4785,71 @@ BEGIN
          END
       END
    ELSIF tok = TkWith THEN
-      Err (ENoLib)
+      (* WITH base (, base)* DO statement.  The record's field range comes from
+         the base symbol: DefVar copies the ELEMENT record's recFldFirst/
+         recFldLast onto an array variable, which is what makes
+         `Sheet[I,J].Field' and `with Sheet[I,J] do' work.  Each base is
+         pushed on the scope stack and popped after the statement. *)
+      savedWith := withN ;
+      LOOP
+         ParseExpr (t) ;
+         IF NOT OK () THEN
+            RETURN
+         END ;
+         IF t.cls # TRecord THEN
+            Err (ETypeErr) ;
+            RETURN
+         END ;
+         IF withN >= 4 THEN
+            Err (ECompOvf) ;
+            RETURN
+         END ;
+         IF symtab [t.idx].fldFirst >= symtab [t.idx].fldLast THEN
+            Err (ETypeErr) ;
+            RETURN
+         END ;
+         IF t.kind = 5 THEN
+            (* the base address is in DI; park it.  Allocating two data bytes
+               here is safe: the statement is parsed once, and the store
+               executes wherever the WITH does. *)
+            withSlot [withN] := dc ;
+            dc := dc + 2 ;
+            EmStDiGlob (withSlot [withN]) ;
+            withIsDI [withN] := TRUE ;
+            withBoff [withN] := 0
+         ELSIF t.kind = 1 THEN
+            withIsDI [withN] := FALSE ;
+            withBoff [withN] := t.boff
+         ELSE
+            Err (ENoLib) ;
+            RETURN
+         END ;
+         withIdx [withN] := t.idx ;
+         withFF [withN] := symtab [t.idx].fldFirst ;
+         withFL [withN] := symtab [t.idx].fldLast ;
+         INC (withN) ;
+         IF MatchDelim (',') THEN
+            (* another base; the last one is innermost *)
+         ELSE
+            EXIT
+         END
+      END ;
+      IF NOT (MatchKey (tok) AND (tok = TkDo)) THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      Statmnt () ;
+      withN := savedWith
    ELSE
       (* identifier statement: assignment or call *)
+      IF WithLookup (wrd, t) THEN
+         IF MatchAssign () THEN
+            Assignment (t) ;
+            RETURN
+         END ;
+         Err (ENoSemi) ;
+         RETURN
+      END ;
       IF NOT Search (wrd, idx) THEN
          Err (EUnknown) ;
          RETURN
@@ -4673,7 +4900,7 @@ VAR tok : CARDINAL ;
     subcls : CARDINAL ;
     strf : BOOLEAN ;
     consumed : BOOLEAN ;
-    running, groupFirst, i, an : CARDINAL ;
+    running, groupFirst, i, an, recStart : CARDINAL ;
     alo, ahi : ARRAY [0..3] OF LONGINT ;
     ecls2 : CARDINAL ;
 BEGIN
@@ -4815,6 +5042,7 @@ BEGIN
          per record so field names need not be globally unique.
          recFldFirst/recFldLast hand the range to DefType, or to the enclosing
          record's field entry when records nest. *)
+      recStart := fldTop ;
       recFldFirst := fldTop ;
       running := 0 ;
       LOOP
@@ -4869,6 +5097,15 @@ BEGIN
             RETURN
          END
       END ;
+      (* The field TYPES are parsed by ParseType, and its named-type arm
+         copies the TYPE's field range into recFldFirst/recFldLast - for
+         `Integer' that is 0/0.  So recFldFirst set at the top of this branch
+         is overwritten by every field type.  It happens to be right for the
+         FIRST record in a compile (fldTop is 0 then), and wrong for every
+         later one: t77's second record started at 2 but recorded 0, which
+         made a WITH field lookup scan the previous record's fields.  Restore
+         the saved start here, after the last field type has been parsed. *)
+      recFldFirst := recStart ;
       recFldLast := fldTop ;
       cls := TRecord ;
       size := running ;
@@ -5528,7 +5765,15 @@ BEGIN
          symtab [tidx].fldLast := recFldLast
       END ;
       IF cls = TArray THEN
-         symtab [tidx].arrIdx := newArrIdx
+         symtab [tidx].arrIdx := newArrIdx ;
+         (* ...and the ELEMENT's field table, if it is a record.  A variable
+            declared `Sheet : Cells' gets its field metadata through the named
+            type; without this, `Sheet[I,J].Field' and `with Sheet[I,J]' found
+            fldFirst = fldLast = 0 and reported "not a record".  An INLINE
+            `array ... of Rec' worked because ParseType's element call left
+            the globals set for DefVar; the named form had lost them. *)
+         symtab [tidx].fldFirst := recFldFirst ;
+         symtab [tidx].fldLast := recFldLast
       END ;
       DropC (tidx) ;
       IF NOT MatchDelim (';') THEN
@@ -5713,6 +5958,13 @@ BEGIN
    rdStrX := 0 ;
    varspc := 0 ;
    symTop := 0 ;
+   (* Per-compile tables.  They used to survive into the next file when the
+      driver compiles several in one process (the compile matrix does exactly
+      that): array indices kept growing, and a record's field range could be
+      read against a stale table.  One compile must not depend on the last. *)
+   fldTop := 0 ;
+   arrTop := 0 ;
+   withN := 0 ;
    nPatch := 0 ;
    nPend := 0 ;
    exitCnt := 0 ;

+ 8 - 0
shell/tests/audit_helpers.py

@@ -154,6 +154,14 @@ NON_ONE_LINE = {
         "LoadVarInd": COMP,
         "StoreVarIndPrep": COMP,
         "StoreInd": COMP,
+        # The WITH/2-D field helpers.  AddDiImm adds a record field's fixed
+        # offset to an address already in DI; LdDiGlob and StDiGlob reload and
+        # park that address in a data slot across a WITH body.  Each is a fixed
+        # 3-4 byte sequence whose operand is a data/field offset, and t77_with
+        # pins the behaviour (2-D element, constant element, field offsets).
+        "AddDiImm": COMP,
+        "LdDiGlob": COMP,
+        "StDiGlob": COMP,
     },
 }
 # The Vx family is NOT here: those four are audited by audit_vx_helpers,

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

@@ -25,9 +25,10 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-21): `with Sheet[I,J] do' in CALC.INC's DisplayP.
-# Integer write field widths landed (t76_width + the wrintw runtime entry),
-# moving 14330 -> 15026.  The blocker is now `with' over a TWO-DIMENSIONAL
-# array element: Sheet[I,J] needs the variable-index row stride, and `with'
-# needs the record's field table to follow the DI-addressed element.
-CALC.PAS	ERR	102	15026
+# Current rung (2026-10-21): `CellStatus := [Txt]' in CALC.INC's Init - the
+# first statement inside `with Sheet[I,J] do'.  WITH, n-dimensional array
+# subscripts, and fields through a DI-addressed element landed (t77_with),
+# moving 15026 -> 15131.  The blocker is now a SET assignment to a record
+# field: the RHS set constructor is still a 32-byte `set of Char' literal and
+# LoadAtom refuses a set, and no counted-field store through DI exists.
+CALC.PAS	ERR	102	15131

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

@@ -585,3 +585,7 @@ t75_arrvar	OK	452	23
 #                   an expression pushed after the value; wrintw pads with
 #                   spaces (sign counted); a narrow width does not truncate.
 t76_width	OK	258	9
+#   t77_with               WITH over a record variable, a constant-index
+#                   element, and a 2-D run-time element (row stride, base
+#                   parked in a data slot); 2-D and mixed subscripts.
+t77_with	OK	390	34

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

@@ -0,0 +1,7 @@
+3q
+42x
+42
+7
+99
+11
+71

+ 78 - 0
shell/tests/fixtures/t77_with.pas

@@ -0,0 +1,78 @@
+program t77_with;
+
+{ t77 -- WITH, and 2-D array subscripts.
+
+  CALC.INC:158 is
+
+      with Sheet[I,J] do
+      begin
+        CellStatus := [Txt];
+        Contents   := '';
+        ...
+      end;
+
+  Sheet is `array['A'..'G',1..FYMax] of CellRec', so the WITH base is an
+  element at a RUN-TIME address: the row stride is (hi1-lo1+1)*elemsize and
+  both indices vary.  The base address is parked in a data slot because the
+  body may clobber DI; each field access reloads it and adds the field's
+  offset.
+
+  Also covers a WITH over a plain record variable (symbol+offset, no slot), a
+  WITH over a constant-index element, a field read back inside the body, and a
+  mixed constant/variable 2-D subscript.  Field types here are INTEGER and
+  CHAR: SET and STRING fields need their own assignments and are the next
+  rung (CALC's CellStatus is the first one). }
+
+type
+   Rec = record
+      a : integer;
+      b : char;
+   end;
+
+var
+   g : array [1..2, 1..3] of Rec;
+   i, j : integer;
+   r : Rec;
+
+begin
+   with r do
+   begin
+      a := 3;
+      b := 'q'
+   end;
+   writeln (r.a, r.b);
+
+   i := 2;
+   j := 3;
+   with g[i,j] do
+   begin
+      a := 42;
+      b := 'x'
+   end;
+   writeln (g[2,3].a, g[2,3].b);
+
+   with g[i,j] do
+      writeln (a);
+
+   with g[1,2] do
+      a := 7;
+   writeln (g[1,2].a);
+
+   (* The stride is pinned INDEPENDENTLY: write with constant indices (folded
+      at compile time) and read with the run-time formula.  A write and a read
+      that share the same wrong stride would agree with each other. *)
+   g[2,3].a := 99;
+   writeln (g[i,j].a);
+
+   j := 2;
+   g[i,j].a := 11;
+   writeln (g[2,2].a);
+
+   (* A wrong row stride makes different index pairs ALIAS.  With the correct
+      stride (9, 3), (1,2) is offset 3 and (2,1) is 9; with a uniform element
+      stride they are both 3.  Writing two values and reading the first is the
+      observation no self-consistent formula can fake. *)
+   g[1,2].a := 71;
+   g[2,1].a := 81;
+   writeln (g[1,2].a)
+end.

+ 40 - 9
shell/tests/nonvacuity.sh

@@ -1599,14 +1599,10 @@ cp "$SAVED_C" Compiler.mod
 if python3 - <<'PYX'
 p = 'Compiler.mod'
 s = open(p).read()
-# Two paths set it now (constant and run-time indices); this case is about the
-# CONSTANT one, so the anchor includes the branch that follows it.
-old = ('                  r.sz := arrs [ai].elem ;\n'
-       '                  r.cls := arrs [ai].ecls\n'
-       '               ELSIF arrs [ai].n = 1 THEN')
-new = ('                  r.sz := 0 ;\n'
-       '                  r.cls := arrs [ai].ecls\n'
-       '               ELSIF arrs [ai].n = 1 THEN')
+# The element width is set once after the subscript list, for constant and
+# run-time indices alike; dropping it makes the whole array's width win.
+old = 'r.sz := arrs [ai].elem'
+new = 'r.sz := 0'
 assert s.count(old) == 1, 'the element width assignment found %d times -- update this mutation' % s.count(old)
 open(p, 'w').write(s.replace(old, new))
 PYX
@@ -1862,7 +1858,7 @@ cp "$SAVED_C" Compiler.mod
 # so a[2] reads the second byte of a[1].  Compiles, runs, wrong - an execution
 # failure, which is what t75 is executed for.
 cp "$SAVED_C" Compiler.mod
-if mutate_compiler 's|                  IF arrs \[ai\].elem # 1 THEN|                  IF FALSE THEN|'; then
+if mutate_compiler 's|                  IF st # 1 THEN|                  IF FALSE THEN|'; then
     if rebuild_compiler; then
         expect_red "t75 red when an array subscript is not scaled"             "FAIL" python3 tests/run_com_exec.py t75_arrvar
     else
@@ -1893,6 +1889,41 @@ else
 fi
 cp "$SAVED_C" Compiler.mod
 
+# --- a 2-D subscript uses the row stride ----------------------------------
+# Let every dimension use the ELEMENT size: `g[i,j]' then adds (i-lo0)*elem
+# and (j-lo1)*elem instead of scaling the first by the second dimension's
+# count.  1-D is unchanged, so t75 stays green; t77's 2-D element moves.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|               k := nd + 1 ;|               k := arrs \[ai\].n ;|'; then
+    if rebuild_compiler; then
+        expect_red "t77 red when the 2-D row stride is dropped"             "FAIL" python3 tests/run_com_exec.py t77_with
+    else
+        echo "  FAIL: the compiler would not rebuild without the row stride"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the row-stride mutation did not apply"
+    fail=$((fail + 1))
+fi
+cp "$SAVED_C" Compiler.mod
+
+# --- a WITH over an element keeps the element's offset ---------------------
+# `with g[1,2]' must remember boff (2,3's predecessor); dropping it makes the
+# body address g[1,1].  t77 sets g[1,2].a := 7 and reads it back.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|            withBoff \[withN\] := t.boff|            withBoff \[withN\] := 0|'; then
+    if rebuild_compiler; then
+        expect_red "t77 red when WITH forgets the element offset"             "FAIL" python3 tests/run_com_exec.py t77_with
+    else
+        echo "  FAIL: the compiler would not rebuild without the WITH offset"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the WITH-offset mutation did not apply"
+    fail=$((fail + 1))
+fi
+cp "$SAVED_C" Compiler.mod
+
 if rebuild_compiler; then
     if python3 tests/run_com_exec.py >/dev/null 2>&1; then
         echo "  ok: every executed fixture passes on the restored sources"