compiler: UpCase, run-time `in', string fields through DI in WRITE

Three linked rungs, and the interpreter was missing a whole opcode family.

UpCase (t81_upcase): a CHAR function.  A constant folds; a value maps
'a'..'z' to 'A'..'Z' with JL/JG (the four declared branch conditions,
and the right answer for 0..255 chars).  The string form stays ENoLib.

`in' with a RUN-TIME element (t82_setin): `Upcase(Ch) in ['Y','N']' is a
bit test, not a fold.  AX := element - base, two signed range tests, then
byte = (e-base) DIV 8 (three SHR AX,1), bit = (e-base) MOD 8, and the
mask 1 << bit via CL.  The set's address is formed from where its bytes
live: an inline literal or typed constant (image offset + LoadBias), a
global data set (absolute), or a local (LEA BX,[BP+off]).  A DI-addressed
set and an element that itself needs DI are refused rather than losing
the address.

`Write(Contents)' inside `with Sheet[I,J] do' (t79 extended): a string
field addressed through DI is already in DI, so the write pushes DI and
the read path uses arg.cls (the expression's type) instead of the
containing symbol's.  The constant-kind-5 path already worked.

Exec86 gained D0-D3 (ROL/ROR/RCL/RCR/SHL/SHR/SAL/SAR), because the new
set test emits D1 (SHR AX,1) and D2 (SHL DL,CL).  qemu ran the program;
Exec86 faulted on 0xD1 - the second oracle doing exactly its job.  The
count is not masked, as on the 8086; CF is the last bit out.

Non-vacuity: UpCase subtracting 33, two SHRs instead of three (membership
divides by 4), and the restored string-write refusal.

The ladder moves 15911 -> 18267, now `Write(Value:FW:DEC)': REAL OUTPUT
and arithmetic - the 6-byte MBF value must be formatted with a width and
decimals.

shell/Compiler.mod

@@ -120,7 +120,7 @@ CONST
       not implemented yet is a loud ENoLib, never a silent no-op. *)
    BI_ClrScr  = 6 ;  BI_GotoXY = 7 ;  BI_LowVideo = 8 ;
    BI_NormVideo = 9 ; BI_ClrEol = 10 ; BI_Delay = 11 ;
-   BI_KeyPressed = 12 ;
+   BI_KeyPressed = 12 ; BI_UpCase = 13 ;
    (* the sub-codes EmCrtSeq takes *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -1408,6 +1408,48 @@ BEGIN
    Ebyte (8AH) ; Ebyte (45H) ; Ebyte (VAL (BYTE, off))
 END EmLdAlDiOff ;
 
+PROCEDURE EmCmpAlImm (v : CARDINAL) ;
+BEGIN Ebyte (3CH) ; Ebyte (VAL (BYTE, v)) END EmCmpAlImm ;  (* CMP AL,imm8 *)
+
+PROCEDURE EmSubAlImm (v : CARDINAL) ;
+BEGIN Ebyte (2CH) ; Ebyte (VAL (BYTE, v)) END EmSubAlImm ;  (* SUB AL,imm8 *)
+
+PROCEDURE EmMovClAl () ;
+BEGIN Ebyte (88H) ; Ebyte (0C1H) END EmMovClAl ;        (* MOV CL,AL *)
+
+PROCEDURE EmAndClImm (v : CARDINAL) ;
+BEGIN Ebyte (80H) ; Ebyte (0E1H) ; Ebyte (VAL (BYTE, v)) END EmAndClImm ;
+
+PROCEDURE EmShrAx1 () ;
+BEGIN Ebyte (0D1H) ; Ebyte (0E8H) END EmShrAx1 ;        (* SHR AX,1 *)
+
+PROCEDURE EmMovBxi (v : CARDINAL) ;
+BEGIN Ebyte (0BBH) ; Eword (v MOD 10000H) END EmMovBxi ; (* MOV BX,imm16 *)
+
+PROCEDURE EmLeaBx (off : CARDINAL) ;
+(* LEA BX,[BP+off]: the address of a local set. *)
+BEGIN
+   Ebyte (8DH) ; EmBpDisp (off, 3)
+END EmLeaBx ;
+
+PROCEDURE EmMovBxDi () ;
+BEGIN Ebyte (89H) ; Ebyte (0FBH) END EmMovBxDi ;        (* MOV BX,DI *)
+
+PROCEDURE EmAddBxAx () ;
+BEGIN Ebyte (01H) ; Ebyte (0C3H) END EmAddBxAx ;        (* ADD BX,AX *)
+
+PROCEDURE EmLdAlBx () ;
+BEGIN Ebyte (8AH) ; Ebyte (07H) END EmLdAlBx ;         (* MOV AL,[BX] *)
+
+PROCEDURE EmMovDlImm (v : CARDINAL) ;
+BEGIN Ebyte (0B2H) ; Ebyte (VAL (BYTE, v)) END EmMovDlImm ;
+
+PROCEDURE EmShlDlCl () ;
+BEGIN Ebyte (0D2H) ; Ebyte (0E2H) END EmShlDlCl ;       (* SHL DL,CL *)
+
+PROCEDURE EmAndAlDl () ;
+BEGIN Ebyte (20H) ; Ebyte (0D0H) END EmAndAlDl ;        (* AND AL,DL *)
+
 PROCEDURE EmAndAlImm (v : CARDINAL) ;
 BEGIN Ebyte (24H) ; Ebyte (VAL (BYTE, v)) END EmAndAlImm ;  (* AND AL,imm8 *)
 
@@ -3001,15 +3043,74 @@ PROCEDURE FoldSetIn (left, right : ERes ; VAR res : ERes) ;
    it must stay LOUD rather than silently answer wrong. *)
 VAR off, base, size, rel, bidx, bit, m, o : CARDINAL ;
     isIn, foldable : BOOLEAN ;
+    jl, jg, jmp : CARDINAL ;
 BEGIN
    res.kind := 0 ;
    res.imm := 0 ;
    res.cls := TBool ;
    res.chr := FALSE ;
-   IF (left.kind # 0) OR (right.cls # TSet) THEN
+   IF right.cls # TSet THEN
       Err (ENoLib) ;
       RETURN
    END ;
+   IF left.kind # 0 THEN
+      (* A RUN-TIME element (`Upcase(Ch) in ['Y','N']', `Ch in ['a'..'z']').
+         Materialise it in AX, subtract the set's base, reject the out-of-range
+         values with the two signed tests the compiler declares (L and G), then
+         index the bit array: byte = (e-base) DIV 8, bit = (e-base) MOD 8.
+         The set's address is formed according to where its bytes live: an
+         inline literal or typed constant is code-resident (image offset +
+         LoadBias), a data set is an absolute or BP-relative address.  A set
+         already addressed through DI and an element that itself needs DI are
+         refused: the address would be lost. *)
+      IF right.kind = 5 THEN
+         Err (ENoLib) ;
+         RETURN
+      END ;
+      LoadAtom (left) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF right.setbase # 0 THEN
+         EmMovCxi (W16 (right.setbase)) ;
+         EmSubAxCx ()
+      END ;
+      EmCmpAxi (0) ;
+      jl := EmJcc (8CH, 0) ;                (* JL -> false *)
+      EmCmpAxi (W16 (right.setsize * 8)) ;
+      jg := EmJcc (8FH, 0) ;                (* JG -> false *)
+      EmMovClAl () ;
+      EmAndClImm (7) ;
+      EmShrAx1 () ; EmShrAx1 () ; EmShrAx1 () ;   (* AX := byte index *)
+      IF right.kind = 7 THEN
+         EmMovBxi (W16 (right.setoff + LoadBias))
+      ELSIF right.kind = 1 THEN
+         IF symtab [right.idx].local THEN
+            EmLeaBx ((right.setoff + right.boff) MOD 10000H)
+         ELSE
+            EmMovBxi ((right.setoff + right.boff + LoadBias) MOD 10000H)
+         END
+      ELSE
+         Err (ENoLib) ;
+         RETURN
+      END ;
+      EmAddBxAx () ;                        (* BX := the set's byte *)
+      EmLdAlBx () ;
+      EmMovDlImm (1) ;
+      EmShlDlCl () ;                        (* DL := 1 << bit *)
+      EmAndAlDl () ;
+      EmMovAh0 () ;
+      EmOrAxAx () ;
+      EmRelSetcc (2) ;                      (* SETNE: the bit was set *)
+      jmp := EmJmpNear (0) ;
+      SetPatTgt (jl, pc) ;
+      SetPatTgt (jg, pc) ;
+      EmMovAxi (0) ;
+      SetPatTgt (jmp, pc) ;
+      res.kind := 2 ;
+      res.cls := TBool ;
+      RETURN
+   END ;
    (* A code-resident set (an inline literal or a typed constant) folds at
       compile time.  A DATA set - a record field, local or global, or one
       addressed through DI - must be tested at run time: its byte is in the
@@ -3503,6 +3604,7 @@ VAR idx : CARDINAL ;
     quoted : BOOLEAN ;
     ssize, sbase : CARDINAL ;
     sbuf : ARRAY [0..31] OF CHAR ;
+    uj1, uj2 : CARDINAL ;
 BEGIN
    r.chr := FALSE ;            (* default: not a quoted char literal *)
    Skip () ;
@@ -3589,6 +3691,48 @@ BEGIN
          fixture had ever exercised the fold. *)
       ParseVar (r) ;
       RETURN
+   ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_UpCase) THEN
+      (* UpCase(c): a CHAR function.  A constant folds; otherwise AL is
+         mapped 'a'..'z' -> 'A'..'Z' and left alone outside that range.  The
+         test is JL/JG (signed), which is the same answer for 0..127 chars and
+         leaves 128..255 unchanged; it also stays inside the four branch
+         conditions this compiler declares (check_8086's set). *)
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      ParseExpr (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF (r.cls # TChar) AND (r.cls # TScalar) THEN
+         Err (ETypeErr) ;           (* the STRING form is not implemented *)
+         RETURN
+      END ;
+      IF r.kind = 0 THEN
+         IF (r.imm >= VAL (LONGINT, ORD ('a')))
+            AND (r.imm <= VAL (LONGINT, ORD ('z'))) THEN
+            r.imm := r.imm - 32
+         END ;
+         r.kind := 0 ;
+         r.cls := TChar ;
+         r.chr := TRUE ;
+         RETURN
+      END ;
+      LoadAtom (r) ;
+      EmCmpAlImm (ORD ('a')) ;
+      uj1 := EmJcc (8CH, 0) ;       (* JL -> leave it *)
+      EmCmpAlImm (ORD ('z')) ;
+      uj2 := EmJcc (8FH, 0) ;       (* JG -> leave it *)
+      EmSubAlImm (32) ;
+      SetPatTgt (uj1, pc) ;
+      SetPatTgt (uj2, pc) ;
+      EmMovAh0 () ;
+      r.kind := 2 ;
+      r.cls := TChar ;
+      r.chr := FALSE ;
+      RETURN
    ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_KeyPressed) THEN
       (* KeyPressed: a boolean FUNCTION with no argument, and TP3 lets it be
          written without a parameter list (`until KeyPressed'). *)
@@ -4434,20 +4578,23 @@ BEGIN
                   Err (ETypeErr) ;                  (* READ needs a variable *)
                   RETURN
                END ;
-               acls := symtab [arg.idx].cls ;
-               (* s[i] is a CHAR variable, so read(s[i]) must read one byte at
-                  off+boff, not the whole string at off.  arg.cls is TChar
-                  (set by ParseSub) while the symbol's own class is still
-                  TString, which is exactly how the element is told from the
-                  whole string; the address push has to carry boff.  For a
-                  plain variable arg.boff is 0, so nothing changes. *)
-               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
+               IF arg.kind = 5 THEN
+                  (* A DI-addressed element: its TYPE is on the expression
+                     (WithLookup/ParseSub set it), because the symbol is the
+                     containing array/record.  s[i] is TChar; a WITH string
+                     field is TString. *)
+                  acls := arg.cls
+               ELSE
+                  acls := symtab [arg.idx].cls ;
+                  (* s[i] is a CHAR variable, so read(s[i]) must read one byte
+                     at off+boff, not the whole string at off.  arg.cls is
+                     TChar (set by ParseSub) while the symbol's own class is
+                     still TString, which is exactly how the element is told
+                     from the whole string; the address push has to carry boff.
+                     For a plain variable arg.boff is 0, so nothing changes. *)
+                  IF (acls = TString) AND (arg.cls = TChar) THEN
+                     acls := TChar
+                  END
                END ;
                IF arg.kind = 5 THEN
                   (* A variable index: ParseSub computed the element's address
@@ -4536,12 +4683,6 @@ 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
@@ -4556,9 +4697,15 @@ BEGIN
                      (* off + boff: a string FIELD of a record/array has a
                         non-zero boff, and the address is the field's, not the
                         containing variable's.  `writeln (g[2,3].S)' printed
-                        the empty first element before this. *)
-                     EmPushVarAddr (symtab [arg.idx].local,
-                                    (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
+                        the empty first element before this.
+                        A DI-addressed field (`with Sheet[I,J] do
+                        Write(Contents)') already HAS its address in DI. *)
+                     IF arg.kind = 5 THEN
+                        EmPushDi ()
+                     ELSE
+                        EmPushVarAddr (symtab [arg.idx].local,
+                                       (symtab [arg.idx].off + arg.boff) MOD 10000H)
+                     END ;
                      ent := TU_WrStr
                   ELSE
                      LoadAtom (arg) ;
@@ -6152,6 +6299,8 @@ BEGIN
    symtab [i].defnd := TRUE ;
    i := NewSym ("KEYPRESSED", KBuiltin, BI_KeyPressed, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
+   i := NewSym ("UPCASE", KBuiltin, BI_UpCase, 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
    (* KBD: the console keyboard as a TEXT file.  This runtime's read entries
       already read the console, so `Read(Kbd, Ch)' drops the file argument and
       reads a character exactly as `Read(Ch)' does. *)

shell/Exec86.mod

@@ -676,6 +676,84 @@ BEGIN
 END DoInt21 ;
 
 
+(* --------------------------------------------------------- D0-D3 shifts *)
+
+PROCEDURE DoShiftGroup (w, cnt : CARDINAL) ;
+(* D0-D3, after DoModRM.  reg selects ROL/ROR/RCL/RCR/SHL/SHR/SAL/SAR; D0/D1
+   shift by one, D2/D3 by CL.  The count is not masked (the 8086 does not),
+   so a count at or beyond the width shifts everything out, which the loop
+   gives for free.  CF is the last bit shifted out; OF is only defined for a
+   count of 1 and nothing here reads it, so it is cleared. *)
+VAR k, i, v, sz, signbit, bit, carryin : CARDINAL ;
+BEGIN
+   k := rmReg ;
+   IF cnt = 0 THEN
+      RETURN                       (* no operation, no flag change *)
+   END ;
+   v := RmRd (w) ;
+   sz := Sz (w) ;
+   signbit := sz DIV 2 ;
+   IF (k = 4) OR (k = 6) THEN
+      (* SHL / SAL *)
+      FOR i := 1 TO cnt DO
+         IF v >= signbit THEN bit := 1 ELSE bit := 0 END ;
+         v := (v * 2) MOD sz ;
+         CF := bit # 0
+      END
+   ELSIF k = 5 THEN
+      (* SHR *)
+      FOR i := 1 TO cnt DO
+         bit := v MOD 2 ;
+         v := v DIV 2 ;
+         CF := bit # 0
+      END
+   ELSIF k = 7 THEN
+      (* SAR *)
+      FOR i := 1 TO cnt DO
+         bit := v MOD 2 ;
+         IF v >= signbit THEN
+            v := v DIV 2 + signbit
+         ELSE
+            v := v DIV 2
+         END ;
+         CF := bit # 0
+      END
+   ELSIF k = 0 THEN
+      (* ROL *)
+      FOR i := 1 TO cnt DO
+         IF v >= signbit THEN bit := 1 ELSE bit := 0 END ;
+         v := (v * 2) MOD sz + bit ;
+         CF := bit # 0
+      END
+   ELSIF k = 1 THEN
+      (* ROR *)
+      FOR i := 1 TO cnt DO
+         bit := v MOD 2 ;
+         v := v DIV 2 + bit * signbit ;
+         CF := bit # 0
+      END
+   ELSIF k = 2 THEN
+      (* RCL *)
+      FOR i := 1 TO cnt DO
+         IF v >= signbit THEN bit := 1 ELSE bit := 0 END ;
+         IF CF THEN carryin := 1 ELSE carryin := 0 END ;
+         v := (v * 2) MOD sz + carryin ;
+         CF := bit # 0
+      END
+   ELSE
+      (* RCR *)
+      FOR i := 1 TO cnt DO
+         bit := v MOD 2 ;
+         IF CF THEN carryin := 1 ELSE carryin := 0 END ;
+         v := v DIV 2 + carryin * signbit ;
+         CF := bit # 0
+      END
+   END ;
+   OFl := FALSE ;
+   SetZSF (v, w) ;
+   RmWr (v, w)
+END DoShiftGroup ;
+
 (* ------------------------------------------------------ F6/F7 unary group *)
 
 PROCEDURE DoUnaryGroup (w : CARDINAL) ;
@@ -878,7 +956,7 @@ END DoFFGroup ;
 (* ----------------------------------------------------------- one instruction *)
 
 PROCEDURE Step ;
-VAR op, w, f, alu, v, d, imm, res, n, k : CARDINAL ;
+VAR op, w, f, alu, v, d, imm, res, n, k, cnt : CARDINAL ;
     cfSave : BOOLEAN ;
 BEGIN
    faultIP := IP ;                           (* what to report if we fault *)
@@ -1106,6 +1184,16 @@ BEGIN
       d := Fetch8 () ;
       IP := (IP + SE8 (d)) MOD 65536
 
+   ELSIF (op >= 0D0H) AND (op <= 0D3H) THEN
+      w := op MOD 2 ;
+      IF op < 0D2H THEN
+         cnt := 1
+      ELSE
+         cnt := CX MOD 32
+      END ;
+      DoModRM (w) ;
+      DoShiftGroup (w, cnt)
+
    ELSIF (op = 0F6H) OR (op = 0F7H) THEN
       DoModRM (op - 0F6H) ;
       DoUnaryGroup (op - 0F6H)

shell/tests/audit_helpers.py

@@ -170,6 +170,14 @@ NON_ONE_LINE = {
         "AndAlImm": COMP,
         # A real copy through DI: one byte of the six.
         "StDiAlOff": COMP,
+        # UpCase's byte tests and the 'a'..'z' fold.
+        "CmpAlImm": COMP,
+        "SubAlImm": COMP,
+        # The run-time set bit test (`e in set'): shift/mask/index helpers.
+        "MovClAl": COMP, "AndClImm": COMP,
+        "MovBxi": COMP, "LeaBx": COMP, "MovBxDi": COMP,
+        "AddBxAx": COMP, "LdAlBx": COMP, "MovDlImm": COMP,
+        "AndAlDl": COMP,
     },
 }
 # The Vx family is NOT here: those four are audited by audit_vx_helpers,
@@ -361,6 +369,10 @@ PATTERNS = [
     # B4 imm8 is MOV AH,imm8 and is NOT B0+reg, so AH and AL are listed
     # separately with their own opcodes rather than sharing one pattern that
     # would accept B4 under the name MovAl0.
+    # --- shifts: by one, and by CL.  The set membership test uses both:
+    # D1 E8 (SHR AX,1) three times, and D2 E2 (SHL DL,CL) for the mask.
+    (re.compile(r"^ShrAx(1)$"), "shr", ["r:Ax", "i:%(1)s"], {0xD1}),
+    (re.compile(r"^ShlDlCl$"),  "shl", ["r:Dl", "r:Cl"],     {0xD2}),
     (re.compile(r"^MovAh(0|1)$"),
      "mov", ["r:Ah", "i:%(1)s"], {0xB4}),
     (re.compile(r"^MovAl(0|1)$"),

shell/tests/fixtures/calc_ladder.tsv

@@ -25,9 +25,9 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-21): `Upcase(Ch)' in CALC.INC's Clear - an unknown
-# builtin.  The REAL field assignment landed (t80_realconst: the measured
-# 6-byte MBF layout, integer constants and 6-byte copies), moving 15272 ->
-# 15911 past Init's `Value := 0', `DEC := 2' and `FW := 10'.  UpCase is the
-# next rung; the big real-arithmetic stage waits further ahead.
-CALC.PAS	ERR	41	15911
+# Current rung (2026-10-21): `Write(Value:FW:DEC)' in CALC.INC's GotoCell - a
+# REAL write with a field width and decimals.  UpCase (t81_upcase), run-time
+# set membership (t82_setin) and a string field written through DI (t79
+# extended) moved the ladder 15911 -> 18267.  The blocker is now REAL
+# OUTPUT/ARITHMETIC: formatting a 6-byte MBF value with FW:DEC.
+CALC.PAS	ERR	102	18267

shell/tests/fixtures/expected.tsv

@@ -598,9 +598,16 @@ t78_setfield	OK	279	23
 #                   <len><chars> truncated to the field, a string-variable
 #                   source via strstore, and a short literal length (not the
 #                   capacity).  Also pins the field offset in writeln.
-t79_strfield	OK	307	78
+t79_strfield	OK	361	80
 #   t80_realconst          a REAL field assigned integer constants: the
 #                   measured 6-byte MBF layout, symbol and DI stores, a
 #                   6-byte copy; the integer fields on either side pin the
 #                   width.  tests/check_realconst.py asserts the bytes.
 t80_realconst	OK	462	73
+#   t81_upcase            UpCase on a CHAR: constant fold and the run-time
+#                   'a'..'z' fold, with the out-of-range values unchanged.
+t81_upcase	OK	273	6
+#   t82_setin             `in' with a RUN-TIME element against an inline
+#                   literal, a range literal, a typed constant and a data
+#                   set (a record field); the byte/bit index is computed.
+t82_setin	OK	1052	26

shell/tests/fixtures/t79_strfield.out

@@ -1,5 +1,6 @@
 abc
 xy
+xy
 hello
 abcde
 4

shell/tests/fixtures/t79_strfield.pas

@@ -44,6 +44,8 @@ begin
       N := 9
    end;
    writeln (g[2,3].S);
+   with g[i,j] do
+      writeln (S);        (* the write arm, address in DI *)
 
    t := 'hello';
    with r do

shell/tests/fixtures/t81_upcase.out

@@ -0,0 +1,6 @@
+A
+Z
+A
+5
+Q
+same

shell/tests/fixtures/t81_upcase.pas

@@ -0,0 +1,24 @@
+program t81_upcase;
+
+{ t81 -- UpCase on a CHAR.
+
+  CALC.INC's Clear ends `until Upcase(Ch) in ['Y','N']'.  TP3's UpCase is a
+  CHAR function here (later versions also accept a string, which stays ENoLib
+  until a string implementation exists): 'a'..'z' fold to 'A'..'Z', everything
+  else is unchanged.  A constant folds at compile time; a variable is compared
+  and decremented at run time. }
+
+var
+   c : char;
+begin
+   c := 'a';
+   writeln (Upcase (c));
+   c := 'z';
+   writeln (Upcase (c));
+   c := 'A';
+   writeln (Upcase (c));
+   c := '5';
+   writeln (Upcase (c));
+   writeln (Upcase ('q'));
+   if Upcase (c) = '5' then writeln ('same') else writeln ('diff')
+end.

shell/tests/fixtures/t82_setin.out

@@ -0,0 +1,8 @@
+yes
+no
+lower
+not
+not-locked
+locked
+digit
+not

shell/tests/fixtures/t82_setin.pas

@@ -0,0 +1,50 @@
+program t82_setin;
+
+{ t82 -- `in' with a RUN-TIME element.
+
+  CALC.INC's Clear loop is `until Upcase(Ch) in ['Y','N']': the element is a
+  value in AX, not a compile-time constant, so the bit test has to run.  The
+  set may be an inline literal (code-resident), a typed constant (also
+  code-resident) or a data set (a record field): the address is chosen
+  accordingly, then byte = (e - base) DIV 8 and bit = (e - base) MOD 8.
+
+  Also covers `Ch in ['a'..'z']' (a range in a literal) and an enumerated data
+  set with both a present and an absent element. }
+
+const
+   Digits : set of Char = ['0'..'9'];
+
+type
+   Attr = (Constant, Formula, Txt, OverWritten, Locked, Calculated);
+   Cell = record
+      S : set of Attr;
+      N : integer;
+   end;
+
+var
+   c : char;
+   i : integer;
+   sh : array [1..2, 1..3] of Cell;
+
+begin
+   c := 'Y';
+   if Upcase (c) in ['Y', 'N'] then writeln ('yes') else writeln ('no');
+   c := 'x';
+   if Upcase (c) in ['Y', 'N'] then writeln ('yes') else writeln ('no');
+
+   c := 'a';
+   if c in ['a'..'z'] then writeln ('lower') else writeln ('not');
+   c := 'A';
+   if c in ['a'..'z'] then writeln ('lower') else writeln ('not');
+
+   sh[1,1].S := [Locked];
+   i := 1;
+   if i in sh[1,1].S then writeln ('locked') else writeln ('not-locked');
+   i := 4;
+   if i in sh[1,1].S then writeln ('locked') else writeln ('not-locked');
+
+   c := '7';
+   if c in Digits then writeln ('digit') else writeln ('not');
+   c := 'x';
+   if c in Digits then writeln ('digit') else writeln ('not')
+end.

shell/tests/nonvacuity.sh

@@ -1128,8 +1128,12 @@ cp "$SAVED_C" Compiler.mod
 if python3 - <<'PYX'
 p = 'Compiler.mod'
 s = open(p).read()
-old = """                     EmPushVarAddr (symtab [arg.idx].local,
-                                    (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
+old = """                     IF arg.kind = 5 THEN
+                        EmPushDi ()
+                     ELSE
+                        EmPushVarAddr (symtab [arg.idx].local,
+                                       (symtab [arg.idx].off + arg.boff) MOD 10000H)
+                     END ;
                      ent := TU_WrStr"""
 assert s.count(old) == 1, 'the string-write arm found %d times -- update this mutation' % s.count(old)
 rep = """                     Err (ENoLib) ;
@@ -2039,6 +2043,39 @@ else
 fi
 cp "$SAVED_C" Compiler.mod
 
+# --- UpCase subtracts 32, not 33 ------------------------------------------
+# The run-time fold; 'a' becomes '@'.  t81 prints A for 'a'.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|      EmSubAlImm (32) ;|      EmSubAlImm (33) ;|'; then
+    if rebuild_compiler; then
+        expect_red "t81 red when UpCase subtracts 33"             "FAIL" python3 tests/run_com_exec.py t81_upcase
+    else
+        echo "  FAIL: the compiler would not rebuild with a 33 fold"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the UpCase-fold mutation did not apply"
+    fail=$((fail + 1))
+fi
+cp "$SAVED_C" Compiler.mod
+
+# --- a set membership indexes bytes with DIV 8 ----------------------------
+# Two SHRs instead of three divide by 4: 'Y' (89) picks byte 22 of a 32-byte
+# literal, whose bits are clear.  t82 expects the first line to be 'yes'.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|      EmShrAx1 () ; EmShrAx1 () ; EmShrAx1 () ;|      EmShrAx1 () ; EmShrAx1 () ;|'; then
+    if rebuild_compiler; then
+        expect_red "t82 red when set membership divides by 4, not 8"             "FAIL" python3 tests/run_com_exec.py t82_setin
+    else
+        echo "  FAIL: the compiler would not rebuild with two shifts"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the set-index shift 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"