compiler: VAR parameters by reference, and shadowing in DupTest

`procedure IBMCh(var Ch: Char)' in CALC.INC was the rung, and it was
two bugs at once.

VAR parameters were parsed and then recorded as VALUE parameters
("recorded as value in this milestone") - a section-7 failure that would
have compiled IBMCh into a procedure that never updates its caller.  The
slot now holds an address (always two bytes, whatever the type; `size'
stays the type's width), the caller pushes an address (a global's, a
local's LEA BP+off, an element's off+boff, or - when passing a VAR
parameter on - the pointer already in its slot), and the callee reads
and writes through it:

  LoadVarInd        AX := [[BP+off]]                (BX carries the pointer)
  StoreVarIndPrep   DI := [[BP+off]], PUSH DI       (DI survives the RHS)
  StoreInd          [DI] := AL/WORD

READ into a VAR parameter pushes the pointer, not the slot's address.
VAR parameters wider than a word (records, arrays, strings) are refused
loudly at the declaration until an access path exists for them.

DupTest rejected any name Search could see, so IBMCh's parameter `Ch'
collided with the global `Ch'.  ISO Pascal lets an inner declaration
shadow an outer one; duplicates in the SAME scope stay errors.  The
change is the level test, and it is deliberately in this commit: fixing
DupTest alone would have let CALC past IBMCh with a silent miscompile.

t73_varparam is red before (ERR 41 at the parameter name) and covers a
global CHAR, a global INTEGER, a local CHAR, a VAR parameter relayed to
another, and READ through one (read into the slot instead of the target
is the failure the last case exists for).  A value implementation prints
H,H,41,a and reads into a copy; the .out is h,h,42,? and Z.

Non-vacuity: making DupTest unconditional is red at compile time, and
setting isVar back to FALSE is red only at execution - which is why t73
is executed rather than merely compiled.

The ladder moves 12901 -> 13052, now the comma-separated CASE labels
`'G', 'I', 'O', 'Q':' in IBMCh.

shell/Compiler.mod

@@ -182,6 +182,7 @@ TYPE
          parmFirst, parmCount : CARDINAL ;  (* a PROCEDURE/FUNCTION's parameters:
                                        symtab indices, in declaration order *)
          isKbd  : BOOLEAN ;          (* the predefined KBD file: reads are console *)
+         isVar  : BOOLEAN ;          (* a VAR parameter: the slot holds an address *)
          level  : CARDINAL ;
          local  : BOOLEAN ;
          resvar : CARDINAL ;
@@ -1326,6 +1327,40 @@ BEGIN Ebyte (57H) END EmPushDi ;                  (* PUSH DI *)
 PROCEDURE EmPopDi () ;
 BEGIN Ebyte (5FH) END EmPopDi ;                   (* POP DI *)
 
+PROCEDURE EmLoadVarInd (off, nbytes : CARDINAL) ;
+(* AX := the value of a VAR parameter.  [BP+off] holds the ADDRESS; BX carries
+   it so the byte/word load has a base register.  The address is a DS offset:
+   a .COM has one segment, which is why no segment register appears here. *)
+BEGIN
+   EmLoadVar (TRUE, off, 2) ;        (* AX := [BP+off], the address *)
+   Ebyte (89H) ; Ebyte (0C3H) ;      (* MOV BX,AX *)
+   IF nbytes = 1 THEN
+      Ebyte (8AH) ; Ebyte (07H) ;    (* MOV AL,[BX] *)
+      EmMovAh0 ()
+   ELSE
+      Ebyte (8BH) ; Ebyte (07H)      (* MOV AX,[BX] *)
+   END
+END EmLoadVarInd ;
+
+PROCEDURE EmStoreVarIndPrep (off : CARDINAL) ;
+(* DI := the address of a VAR parameter, then PUSH DI.  The push protects it
+   across the parse of the right-hand side, which may use DI for a string
+   element of its own.  EmStoreInd finishes the store after POP DI. *)
+BEGIN
+   Ebyte (8BH) ; EmBpDisp (off, 7) ; (* MOV DI,[BP+off] *)
+   EmPushDi ()
+END EmStoreVarIndPrep ;
+
+PROCEDURE EmStoreInd (nbytes : CARDINAL) ;
+(* [DI] := AL/WORD, after POP DI - the companion of EmStoreVarIndPrep. *)
+BEGIN
+   IF nbytes = 1 THEN
+      EmStDiAl ()                     (* MOV [DI],AL *)
+   ELSE
+      Ebyte (89H) ; Ebyte (05H)       (* MOV [DI],AX *)
+   END
+END EmStoreInd ;
+
 PROCEDURE EmSubSp (n : CARDINAL) ;
 BEGIN
    Ebyte (81H) ; Ebyte (0ECH) ; Eword (n MOD 10000H)
@@ -1501,6 +1536,7 @@ BEGIN
    e.parmFirst := 0 ;
    e.parmCount := 0 ;
    e.isKbd := FALSE ;
+   e.isVar := FALSE ;
    e.level := lexnest ;
    e.local := local ;
    e.resvar := 0 ;
@@ -1531,10 +1567,17 @@ BEGIN
 END Search ;
 
 PROCEDURE DupTest (nm : ARRAY OF CHAR) ;
+(* A name may be declared twice only in the SAME scope.  This used to reject
+   any name Search could see, so a parameter could not shadow a global - legal
+   ISO Pascal, and CALC.INC's `procedure IBMCh(var Ch: Char)' does exactly
+   that (`Ch' is a global).  Same-level duplicates stay errors: two parameters
+   in one list, two locals, or two globals. *)
 VAR i : CARDINAL ;
 BEGIN
    IF Search (nm, i) THEN
-      Err (EUnknown)
+      IF symtab [i].level = lexnest THEN
+         Err (EUnknown)
+      END
    END
 END DupTest ;
 
@@ -2091,6 +2134,7 @@ PROCEDURE ParseCall (idx : CARDINAL) ; FORWARD ;
 PROCEDURE ParseCallArgs (idx : CARDINAL) ; FORWARD ;
 PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ; FORWARD ;
 PROCEDURE SlotSize (cls, size : CARDINAL) : CARDINAL ; FORWARD ;
+PROCEDURE ParamSlotBytes (e : SymEntry) : CARDINAL ; FORWARD ;
 
 (* ---------------------------------------------------------------- *)
 (*  expressions  (TPSRC9)                                           *)
@@ -2150,6 +2194,19 @@ BEGIN
       EmMovAxi (W16 (r.imm)) ;
       r.kind := 2
    ELSIF r.kind = 1 THEN
+      IF symtab [r.idx].isVar THEN
+         (* A VAR parameter: [BP+off] holds the address, and the value is one
+            level down.  r.boff is necessarily 0 - a by-reference parameter is
+            a scalar in this increment, so it has nothing to subscript. *)
+         IF r.boff # 0 THEN
+            Err (ENoLib) ;
+            r.kind := 2 ;
+            RETURN
+         END ;
+         EmLoadVarInd (symtab [r.idx].off, VarSize (r)) ;
+         r.kind := 2 ;
+         RETURN
+      END ;
       IF (VarSize (r) > 2) AND NOT
          ((r.cls = TChar) AND (symtab [r.idx].cls = TString)) THEN
          Err (ENoLib)
@@ -3326,9 +3383,22 @@ BEGIN
       RETURN 2
    END ;
    pi := symtab [idx].parmFirst + k ;
-   RETURN SlotSize (symtab [pi].cls, symtab [pi].size)
+   RETURN ParamSlotBytes (symtab [pi])
 END ParmSlot ;
 
+PROCEDURE ParmIsVar (idx, k : CARDINAL) : BOOLEAN ;
+(* Is argument k (0-based) of procedure/function idx declared VAR?  Out of
+   range means the source passed more arguments than there are formals; treat
+   it as a value parameter, as ParmSlot already does. *)
+VAR pi : CARDINAL ;
+BEGIN
+   IF (symtab [idx].parmCount = 0) OR (k >= symtab [idx].parmCount) THEN
+      RETURN FALSE
+   END ;
+   pi := symtab [idx].parmFirst + k ;
+   RETURN symtab [pi].isVar
+END ParmIsVar ;
+
 PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ;
 (* emit the call to sym 'idx' and clean up `cleanup' bytes of arguments, which
    is the SUM of their slot sizes - not 2 per argument once a slot can be
@@ -3373,7 +3443,30 @@ BEGIN
          END ;
          ParseExpr (arg) ;
          slot := ParmSlot (idx, nArgs) ;
-         IF slot > 2 THEN
+         IF ParmIsVar (idx, nArgs) THEN
+            (* VAR formal: push the actual's ADDRESS.  Only a variable has
+               one; a constant or a computed value is refused rather than
+               quietly passed by value.  An element with a constant index
+               (`s[i]') is a variable too: its address is off+boff, which
+               EmPushVarAddr forms directly. *)
+            IF arg.kind # 1 THEN
+               Err (ENoLib) ;
+               EXIT
+            END ;
+            IF symtab [arg.idx].isVar THEN
+               (* Passing a VAR parameter on: its slot already HOLDS the
+                  address, so push that, not the address of the slot. *)
+               IF arg.boff # 0 THEN
+                  Err (ENoLib) ;
+                  EXIT
+               END ;
+               EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
+               EmPushAx ()
+            ELSE
+               EmPushVarAddr (symtab [arg.idx].local,
+                              (symtab [arg.idx].off + arg.boff) MOD 10000H)
+            END
+         ELSIF slot > 2 THEN
             (* A STRING VALUE parameter: push its whole slot, copied.
                `copyN' is at most the slot: an actual shorter than the formal
                leaves the tail untouched, which is harmless because the length
@@ -3520,6 +3613,21 @@ BEGIN
       Err (EUnknown) ;
       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
+         for a string element of its own. *)
+      IF r.boff # 0 THEN
+         Err (ENoLib) ;
+         RETURN
+      END ;
+      EmStoreVarIndPrep (symtab [r.idx].off) ;
+      ParseExpr (src) ;
+      LoadAtom (src) ;
+      EmPopDi () ;
+      EmStoreInd (VarSize (r)) ;
+      RETURN
+   END ;
    IF (r.cls = TString) AND (VarSize (r) > 1) THEN
       (* s := <string literal>.  TPSRC8 asn2 sends a string through the scalar
          store path, and estcpl's string arm emits `MOV CL,max_len' (max_len =
@@ -3877,6 +3985,15 @@ BEGIN
                      the address READ wants.  A constant index folds into boff
                      and takes the LEA path below. *)
                   EmPushDi ()
+               ELSIF symtab [arg.idx].isVar THEN
+                  (* A VAR parameter: its slot holds the address READ must
+                     store through, not the address of the slot. *)
+                  IF arg.boff # 0 THEN
+                     Err (ENoLib) ;
+                     RETURN
+                  END ;
+                  EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
+                  EmPushAx ()
                ELSE
                   EmPushVarAddr (symtab [arg.idx].local,
                                  (symtab [arg.idx].off + arg.boff) MOD 10000H)
@@ -4982,6 +5099,17 @@ BEGIN
    RETURN size
 END SlotSize ;
 
+PROCEDURE ParamSlotBytes (e : SymEntry) : CARDINAL ;
+(* The bytes a parameter occupies in the frame.  A VAR parameter's slot is the
+   ADDRESS, always two bytes, whatever its type: `size' stays the type's width
+   so loads and stores know whether they read one byte or two. *)
+BEGIN
+   IF e.isVar THEN
+      RETURN 2
+   END ;
+   RETURN SlotSize (e.cls, e.size)
+END ParamSlotBytes ;
+
 PROCEDURE ProcFunc () ;
 (* PROCEDURE name (params) ; body | FUNCTION name (params) : type ; body *)
 VAR nm : ARRAY [0..MaxName] OF CHAR ;
@@ -4989,7 +5117,7 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
     tok, tok2 : CARDINAL ;
     parmNm : ARRAY [0..MaxName] OF CHAR ;
     cls, size, elem : CARDINAL ;
-    isFunc : BOOLEAN ;
+    isFunc, groupVar : BOOLEAN ;
     saveNest, saveLoc, saveRes, saveF : CARDINAL ;
     saveLB, savePO : CARDINAL ;
     nestMark : CARDINAL ;             (* symTop just inside this procedure *)
@@ -5032,9 +5160,14 @@ BEGIN
             (* PeekKw, not MatchKey: MatchKey CONSUMES the word it reads, so
                using it to test for VAR would eat the parameter's name. *)
             PeekKw (tok) ;
+            groupVar := FALSE ;
             IF tok = TkVar THEN
-               (* VAR parameter recorded as value in this milestone *)
-               DropB (MatchKey (tok))
+               (* A by-reference parameter: the slot will hold an ADDRESS.
+                  `size' still carries the type's own width, because the
+                  callee's loads and stores must know whether they move one
+                  byte or two. *)
+               DropB (MatchKey (tok)) ;
+               groupVar := TRUE
             END ;
             first := symTop ;
             LOOP
@@ -5053,6 +5186,14 @@ BEGIN
             END ;
             ExpectDelim (':', ENoSemi) ;   (* formal is 'name : type' *)
             ParseType (cls, size, elem) ;
+            IF groupVar AND ((size > 2) OR (cls = TString)) THEN
+               (* A VAR parameter of a record, array or string would need the
+                  callee to address through a larger object (or a counted
+                  string) than the scalar [BX] paths below; refusing is the
+                  honest answer, not quietly passing it by value. *)
+               Err (ENoLib) ;
+               RETURN
+            END ;
             IF (size > 2) AND (cls # TString) THEN
                (* A string VALUE parameter is a whole-slot copy (n+1 bytes on
                   the stack); any other type wider than a word - a record, an
@@ -5065,7 +5206,12 @@ BEGIN
                symtab [i].cls := cls ; symtab [i].size := size ;
                symtab [i].elem := elem ;
                symtab [i].off := parmOff ;
-               parmOff := parmOff + SlotSize (cls, size) ;
+               symtab [i].isVar := groupVar ;
+               IF groupVar THEN
+                  parmOff := parmOff + 2      (* the address, whatever the type *)
+               ELSE
+                  parmOff := parmOff + SlotSize (cls, size)
+               END ;
                INC (i)
             END ;
             IF MatchDelim (')') THEN
@@ -5100,8 +5246,9 @@ BEGIN
       parameter to the far end and the LAST to BP+4.  With every slot 2 -
       every scalar, which is all this compiler accepts today - that reduces
       exactly to the old `parmOff + 2 - off`, so no existing frame moves.
-      A slot larger than 2 (a string's 71 bytes, once the caller can push it)
-      falls out of the same formula.
+      A slot larger than 2 (a string's 71 bytes) falls out of the same
+      formula, and a VAR parameter is exactly 2 even when its TYPE is one
+      byte: ParamSlotBytes carries that rule.
 
       The range is exactly the parameters: the only symbol created while the
       list is read is the parameter itself (NewSym inside the loop),
@@ -5110,7 +5257,7 @@ BEGIN
    i := nestMark ;
    WHILE i < symTop DO
       symtab [i].off := 8 + (parmOff - 4) - symtab [i].off
-                        - SlotSize (symtab [i].cls, symtab [i].size) ;
+                        - ParamSlotBytes (symtab [i]) ;
       INC (i)
    END ;
    (* Record the parameter list on the procedure symbol: a call site has to

shell/tests/audit_helpers.py

@@ -144,6 +144,16 @@ NON_ONE_LINE = {
         # instructions each, with no single name grammar.  Listed, not left
         # implicit.
         "CrtSeq": COMP,
+        # A VAR parameter's slot holds an ADDRESS.  These three read and write
+        # one level down: LoadVarInd fetches the pointer into BX and then the
+        # byte/word at [BX]; StoreVarIndPrep parks the pointer in DI across the
+        # right-hand side and StoreInd stores through it.  The sequence depends
+        # on the width (one byte or a word), so there is no single opcode to
+        # name; t73_varparam's execution pins both widths, the local/global
+        # address forms, passing one on, and READ through one.
+        "LoadVarInd": COMP,
+        "StoreVarIndPrep": COMP,
+        "StoreInd": COMP,
     },
 }
 # The Vx family is NOT here: those four are audited by audit_vx_helpers,

shell/tests/fixtures/calc_ladder.tsv

@@ -25,11 +25,9 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-20): `procedure IBMCh(var Ch: Char)' in CALC.INC.
-# KeyPressed landed (INT 21h AH=0B; t72), moving 12672 -> 12901.  The blocker
-# is now a VAR PARAMETER, and it is two things at once: `var' is parsed but
-# then silently recorded as a VALUE parameter today (a section-7 violation
-# that must be IMPLEMENTED, not waved through), and the parameter is named
-# `Ch', which is also a global - DupTest rejects shadowing an outer name,
-# which ISO Pascal allows.  Both must be fixed together.
-CALC.PAS	ERR	41	12901
+# Current rung (2026-10-21): the CASE labels `'G', 'I', 'O', 'Q':' in
+# CALC.INC's IBMCh.  VAR parameters landed (by reference; t73_varparam) along
+# with the shadowing rule in DupTest, moving 12901 -> 13052.  The blocker is
+# now a COMMA-SEPARATED case label list: the parser reads one label and then
+# demands ':'.
+CALC.PAS	ERR	1	13052

shell/tests/fixtures/expected.tsv

@@ -564,3 +564,9 @@ t71_repeat_seq	OK	106	7
 #                   not AND AL,1: AH is still 0Bh after the interrupt.  The
 #                   .in is a single 'A'; .out exercises both answers.
 t72_keypress	OK	138	6
+#   t73_varparam           VAR parameters by reference, and a parameter named
+#                   like the global it shadows (CALC's IBMCh(var Ch: Char)).
+#                   Global char, global integer, local char, a VAR parameter
+#                   relayed to another, and READ into a VAR parameter.  A
+#                   value implementation prints H,H,41,a instead of h,h,42,?.
+t73_varparam	OK	334	8

shell/tests/fixtures/t73_varparam.in

@@ -0,0 +1 @@
+Z

shell/tests/fixtures/t73_varparam.out

@@ -0,0 +1,5 @@
+h
+h
+42
+?
+Z

shell/tests/fixtures/t73_varparam.pas

@@ -0,0 +1,75 @@
+program t73_varparam;
+
+{ t73 -- VAR parameters, and a parameter shadowing a global of the same name.
+
+  CALC.INC has
+
+      Ch : Char;                                  (* a GLOBAL *)
+      procedure IBMCh(var Ch: Char); ... Ch := ^E ... end;
+      IBMCh(Ch);
+
+  and expects the caller's Ch to change.  This fixture is that shape:
+  IBMCh's parameter is also named Ch, which ISO Pascal allows (the inner
+  declaration shadows the outer one); DupTest used to reject it outright.
+
+  Five calls, so every address path is exercised:
+    * a global CHAR by reference (one byte through the pointer),
+    * a global INTEGER by reference (two bytes through the pointer),
+    * a LOCAL CHAR by reference (the caller passes LEA BP+off),
+    * a VAR parameter passed ON to another VAR parameter (Relay -> IBMCh),
+    * READ into a VAR parameter (ReadIt), which must store through the
+      pointer, not into the parameter slot.
+
+  A by-value implementation would print H, H, 41 and a; the .out is
+  h, h, 42, ? and the character read by ReadIt. }
+
+var
+   Ch : char;
+   i  : integer;
+
+procedure IBMCh (var Ch : Char);
+begin
+   if Ch = 'H' then
+      Ch := 'h'
+   else
+      Ch := '?'
+end;
+
+procedure Bump (var n : integer);
+begin
+   n := n + 1
+end;
+
+procedure Relay (var c : char);
+begin
+   IBMCh (c)
+end;
+
+procedure ReadIt (var c : char);
+begin
+   read (c)
+end;
+
+procedure Local;
+var
+   v : char;
+begin
+   v := 'a';
+   IBMCh (v);
+   writeln (v)
+end;
+
+begin
+   Ch := 'H';
+   IBMCh (Ch);
+   writeln (Ch);
+   Ch := 'H';
+   Relay (Ch);
+   writeln (Ch);
+   i := 41;
+   Bump (i);
+   writeln (i);
+   Local;
+   ReadIt (Ch);
+   writeln (Ch)
+end.

shell/tests/nonvacuity.sh

@@ -953,7 +953,7 @@ s = open(p).read()
 old = """   i := nestMark ;
    WHILE i < symTop DO
       symtab [i].off := 8 + (parmOff - 4) - symtab [i].off
-                        - SlotSize (symtab [i].cls, symtab [i].size) ;
+                        - ParamSlotBytes (symtab [i]) ;
       INC (i)
    END ;
 """
@@ -1793,6 +1793,43 @@ else
 fi
 cp "$SAVED_C" Compiler.mod
 
+# --- a parameter may shadow a global --------------------------------------
+# DupTest used to reject any name Search could see, so CALC's
+# `IBMCh(var Ch: Char)' collided with the global `Ch'.  Make the level test
+# unconditional and t73 is ERR 41 at the parameter name again.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|      IF symtab \[i\].level = lexnest THEN|      IF TRUE THEN|'; then
+    if rebuild_compiler; then
+        expect_red "t73 red when a parameter may not shadow a global"             "expected: OK 334 8" tests/run_compile_tests.sh
+    else
+        echo "  FAIL: the compiler would not rebuild with the old DupTest"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the DupTest level-test mutation did not apply"
+    fail=$((fail + 1))
+fi
+cp "$SAVED_C" Compiler.mod
+
+# --- a VAR parameter is not a value parameter -----------------------------
+# Record the formal as a value parameter again (the exact old behaviour):
+# the caller pushes a copy and IBMCh/Bump update that copy.  This compiles and
+# runs, and prints H,H,41,a - which is why it is the execution, not the
+# compile, that must catch it.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|               symtab \[i\].isVar := groupVar ;|               symtab \[i\].isVar := FALSE ;|'; then
+    if rebuild_compiler; then
+        expect_red "t73 red when a VAR parameter is recorded as value"             "FAIL" python3 tests/run_com_exec.py t73_varparam
+    else
+        echo "  FAIL: the compiler would not rebuild with VAR as value"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the VAR-as-value 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"