Browse Source

compiler: variable array subscripts, scaled by element size

CALC.INC:130 is `GotoXY(XPos[Count],1)`: a run-time index into a typed
constant array.  Arrays only folded a CONSTANT index, so this was ENoLib.
A run-time index now computes (i - lower) * elemsize into AX, forms the
base address in DI (LEA DI,[base] / ADD DI,AX) and marks the value as
DI-addressed - the same shape string subscripts already use.  What is
new is the WIDTH: LoadAtom and Assignment now move one byte or two
through DI, while a wider element (a record) is refused rather than
stored as its first two bytes.  A second subscript or a field on a
DI-addressed element is loud until its element type travels with the
expression (the 2-D `Sheet[FX,FY]` rung).

Behind it was a latent type bug: ParseType's NAMED-type arm copied
`elem := size`, so a named array type reported its WHOLE size as the
element size.  `X : Letters = (10,20,30)` then wrote six bytes per
element, and DefConst's little-endian divider wrapped to zero - SIGFPE
inside the compiler.  It now copies the type's `elem`; records are
unaffected (their elem equals their size), arrays, files and sets are
fixed.

t75_arrvar covers a global Integer array, a global Byte array, an
XPOS-shaped typed constant indexed by a Char, a LOCAL array, writes
whose RHS uses a subscript (DI must survive), and reads in expressions.
Non-vacuity skips the element-scale multiply; the fixture then reads the
second byte of a[1] for a[2] and goes red at execution, not at compile.

The ladder moves 14195 -> 14330, now `writeln(I:2)` - a write field
width.
Eric Streit 1 day ago
parent
commit
c78611c0bc

+ 90 - 45
shell/Compiler.mod

@@ -1320,6 +1320,9 @@ BEGIN Ebyte (01H) ; Ebyte (0C7H) END EmAddDiAx ;  (* 01 C7: DI := DI + AX *)
 PROCEDURE EmLdAlDi () ;
 BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ;    (* 8A 05: AL := [DI] *)
 
+PROCEDURE EmLdAxDi () ;
+BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ;    (* 8B 05: AX := [DI] *)
+
 PROCEDURE EmStDiAl () ;
 BEGIN Ebyte (88H) ; Ebyte (05H) END EmStDiAl ;    (* 88 05: [DI] := AL *)
 
@@ -2179,16 +2182,24 @@ BEGIN
       RETURN
    END ;
    IF r.kind = 5 THEN
-      (* A string element with a variable index: ParseSub already computed its
-         address into DI (LEA DI,[base] / ADD DI,AX), so the byte is at [DI].
-         Zeroing AH keeps the value a clean 16-bit char, the same thing the
-         size-1 load below does, because every consumer of a CHAR expects the
-         high half to be zero.  The read must happen HERE, before anything
-         else is emitted: the caller reaches this immediately after parsing
-         the subscript, or - for a binary operator - SaveLeft has already
-         materialised it, so DI is still the element's address. *)
-      EmLdAlDi () ;
-      EmMovAh0 () ;
+      (* An element whose address ParseSub computed into DI (LEA DI,[base] /
+         ADD DI,AX): a string character, or an array element of one or two
+         bytes.  Zeroing AH keeps a one-byte value a clean 16-bit char.  The
+         read must happen HERE, before anything else is emitted: the caller
+         reaches this immediately after parsing the subscript, or - for a
+         binary operator - SaveLeft has already materialised it, so DI is
+         still the element's address. *)
+      IF VarSize (r) > 2 THEN
+         Err (ENoLib) ;                  (* a whole record/array as a value *)
+         r.kind := 2 ;
+         RETURN
+      END ;
+      IF VarSize (r) = 2 THEN
+         EmLdAxDi ()
+      ELSE
+         EmLdAlDi () ;
+         EmMovAh0 ()
+      END ;
       r.kind := 2 ;
       RETURN
    END ;
@@ -2250,6 +2261,12 @@ 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
@@ -2314,25 +2331,53 @@ BEGIN
                r.cls := TChar ;
                r.sz := 1
             ELSIF symtab [r.idx].cls = TArray THEN
-               (* A constant array subscript.  The element's address is
+               (* 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.  A VARIABLE index needs scaled run-time addressing and
-                  is the next increment. *)
-               IF t.kind # 0 THEN
-                  Err (ENoLib) ;
+                  array. *)
+               IF symtab [r.idx].arrIdx = 0 THEN
+                  Err (ESimpType) ;
                   RETURN
                END ;
-               IF symtab [r.idx].arrIdx > 0 THEN
-                  ai := symtab [r.idx].arrIdx - 1 ;
+               ai := symtab [r.idx].arrIdx - 1 ;
+               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 ;
+                  LoadAtom (t) ;
+                  EmMovCxi (W16 (arrs [ai].lo [0])) ;
+                  EmSubAxCx () ;
+                  IF arrs [ai].elem # 1 THEN
+                     EmMovCxi (arrs [ai].elem) ;
+                     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
                ELSE
-                  Err (ESimpType) ;
+                  (* 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
                END
             ELSIF t.kind # 0 THEN
@@ -3685,35 +3730,30 @@ BEGIN
       RETURN
    END ;
    IF (r.kind = 5) OR (VarSize (r) > 2) THEN
-      IF (r.cls # TChar) OR (r.kind = 1) THEN
-         Err (ENoLib) ;
-         RETURN
-      END ;
-      (* s[i] := c : one byte, either at off+boff (a constant index) or at [DI]
-         (a variable one, r.kind = 5).  The whole-string path above was skipped
-         because r.cls is TChar, not TString, so this is the element store; a
-         plain char variable has size 1 and takes the scalar path below
-         instead.
-
-         For a variable index the destination address is in DI, and the
-         right-hand side is parsed next, so DI has to be saved first - the RHS
-         may hold a subscript of its own, which reuses DI, or call a routine
-         that clobbers it.  This is TPSRC8 asnscal2/asnscal3 (758-760,
-         786-789), which set flgpshdi around the expression for the same
-         reason.  After the save, DI is free for the RHS, and the store reads
-         it back. *)
-      IF r.kind = 5 THEN
-         EmPushDi ()
-      END ;
-      ParseExpr (src) ;
-      LoadAtom (src) ;
       IF r.kind = 5 THEN
+         (* An element addressed by DI: a string character (one byte) or an
+            array element (one or two).  A wider element - a record - is
+            refused rather than stored as its first two bytes.
+
+            The destination address is in DI, and the right-hand side is
+            parsed next, so DI has to be saved first - the RHS may hold a
+            subscript of its own, which reuses DI, or call a routine that
+            clobbers it.  This is TPSRC8 asnscal2/asnscal3 (758-760, 786-789),
+            which set flgpshdi around the expression for the same reason. *)
+         IF VarSize (r) > 2 THEN
+            Err (ENoLib) ;
+            RETURN
+         END ;
+         EmPushDi () ;
+         ParseExpr (src) ;
+         LoadAtom (src) ;
          EmPopDi () ;                    (* DI := the destination again *)
-         EmStDiAl ()                     (* [DI] := AL *)
-      ELSE
-         EmStoreVar (symtab [r.idx].local,
-                     (symtab [r.idx].off + r.boff) MOD 10000H, 1)
+         EmStoreInd (VarSize (r)) ;      (* [DI] := AL or AX *)
+         RETURN
       END ;
+      (* A value wider than a word with no address to store through: an
+         assignment to a whole string/record/array is not a scalar store. *)
+      Err (ENoLib) ;
       RETURN
    END ;
    ParseExpr (src) ;
@@ -4832,7 +4872,12 @@ BEGIN
          IF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
             cls := symtab [idx].cls ;
             size := symtab [idx].size ;
-            elem := symtab [idx].size ;
+            (* The type's ELEMENT size, not its total size.  They are equal for
+               a record, but not for an array (`Letters' is 6 bytes of 3
+               Integers) or a file.  A named array typed constant used to get
+               typElem = 6, wrote six bytes per element and wrapped the
+               little-endian divider to zero: SIGFPE in DefConst. *)
+            elem := symtab [idx].elem ;
             enumLo := symtab [idx].lo ;
             enumHi := symtab [idx].hi ;
             recFldFirst := symtab [idx].fldFirst ;

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

@@ -25,10 +25,8 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-21): `XPos[Count]' in CALC.INC's DisplayP - a VARIABLE
-# array subscript.  Comma-separated CASE labels and real case RANGES landed
-# (t74_caselist), moving 13052 -> 14195.  The subscript is refused ENoLib:
-# arrays still accept only a constant index (a variable index needs the
-# element-size scaling), while string subscripts have been run-time since
-# v-TP3-STRIDX-VAR.
-CALC.PAS	ERR	102	14195
+# Current rung (2026-10-21): `writeln(I:2)' in CALC.INC's DisplayP - a WRITE
+# FIELD WIDTH.  Variable array subscripts landed (t75_arrvar), moving
+# 14195 -> 14330.  The parser reads the expression and then demands ',' or
+# ')', so the ':' is ENoSemi.
+CALC.PAS	ERR	1	14330

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

@@ -576,3 +576,8 @@ t73_varparam	OK	334	8
 #                   `1..5' matched nothing unless lo=hi; the fixture pins the
 #                   low edge, the high edge, a mixed list, and misses.
 t74_caselist	OK	579	8
+#   t75_arrvar             variable ARRAY subscripts, scaled by element size:
+#                   global Integer and Byte arrays, a typed-constant array
+#                   indexed by Char, a LOCAL array, and a RHS that itself
+#                   subscripts (DI must survive the parse).
+t75_arrvar	OK	452	23

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

@@ -0,0 +1,7 @@
+30
+20
+99
+30
+2
+10
+8

+ 52 - 0
shell/tests/fixtures/t75_arrvar.pas

@@ -0,0 +1,52 @@
+program t75_arrvar;
+
+{ t75 -- variable ARRAY subscripts.
+
+  CALC.INC:130 has `XPos[Count]' - a run-time index into a typed-constant
+  array - and later `Sheet[FX,FY]'.  A CONSTANT index folds into boff; a
+  run-time one is (i - lower) * elemsize from the base, and the element's
+  address rides in DI, the same shape string subscripts use.  What is new is
+  the WIDTH: an array element is one byte or two, not always a character.
+
+  Covers a global Integer array, a global Byte array, a typed-constant array
+  indexed by a Char, a LOCAL array, writes whose right-hand side also uses a
+  subscript (DI must survive the parse), and reads used in expressions. }
+
+type
+   Letters = array ['A'..'C'] of Integer;
+const
+   X : Letters = (10, 20, 30);
+var
+   a : array [1..5] of Integer;
+   b : array [1..5] of Byte;
+   i : Integer;
+   c : Char;
+
+procedure Local;
+var
+   v : array [1..3] of Integer;
+   k : Integer;
+begin
+   for k := 1 to 3 do
+      v[k] := k * 5;
+   writeln (v[2])
+end;
+
+begin
+   for i := 1 to 5 do
+      a[i] := i * 10;
+   writeln (a[3]);
+   i := 2;
+   writeln (a[i]);
+   a[i] := 99;
+   writeln (a[2]);
+   c := 'C';
+   writeln (X[c]);
+   for i := 1 to 3 do
+      b[i] := i;
+   writeln (b[2]);
+   Local;
+   b[2] := 7;
+   a[3] := b[2] + 1;
+   writeln (a[3])
+end.

+ 27 - 2
shell/tests/nonvacuity.sh

@@ -1599,9 +1599,16 @@ cp "$SAVED_C" Compiler.mod
 if python3 - <<'PYX'
 p = 'Compiler.mod'
 s = open(p).read()
-old = 'r.sz := arrs [ai].elem'
+# 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')
 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, 'r.sz := 0'))
+open(p, 'w').write(s.replace(old, new))
 PYX
 then
     if rebuild_compiler; then
@@ -1850,6 +1857,24 @@ else
 fi
 cp "$SAVED_C" Compiler.mod
 
+# --- an array subscript scales by the element size ------------------------
+# Skip the multiply: for an Integer array a[i] is then base + (i - lo) BYTES,
+# 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 rebuild_compiler; then
+        expect_red "t75 red when an array subscript is not scaled"             "FAIL" python3 tests/run_com_exec.py t75_arrvar
+    else
+        echo "  FAIL: the compiler would not rebuild without the element scale"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the element-scale 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"