Sebastian Graf pushed to branch wip/sg/enter-taggable-invariant at Glasgow Haskell Compiler / GHC

Commits:

• 5ba72999
  by Sebastian Graf at 2026-07-31T18:25:31+02:00

  rts: retag constructors in the nonmoving selector shortcut
  
  nonmoving_eval_thunk_selector_ strips the tag from the selected field
  and from every indirectee it follows, so update_selector_chain installed
  untagged constructor references as the indirectees of the selector chain
  and in the origin field. Forcing such a selector then entered the
  constructor, which the enter-taggable check reports.
  
  Reproduced with a list of snd-selector thunks over pair thunks with
  evaluated components, promoted to the nonmoving generation before the
  pairs are forced: the following mark resolves the selectors and the
  mutator aborts under --fatal-enter-taggable with "entered a taggable
  normal form: I#".
  
  Tag the selected value like eval_thunk_selector (rts/sm/Evac.c) does
  before it is installed.
  

• 3b6d6c34
  by Sebastian Graf at 2026-07-31T18:25:31+02:00

  rts: tag the StackSnapshot# handed to Haskell
  
  stg_cloneMyStackzh returns the cloned stack with the
  boxed-unlifted-primitive pointer tag, and handleCloneStackMessage tags
  the stack it applies the StackSnapshot constructor to. Observed via
  ghc-heap: the StackSnapshot field now carries tag 1 at rest.
  

• 3f7072d7
  by Sebastian Graf at 2026-07-31T18:28:22+02:00

  rts: untag the forwarded STACK reference after copyPart
  
  copyPart stores the forwarded reference with the tag of the incoming
  reference. The STACK case of evacuate reads that reference back to
  adjust the cloned stack's pointers with move_STACK, so it strips the
  tag first. StackSnapshot# references carry tag 1, and move_STACK on
  the tagged pointer corrupted the stack fields, crashing the following
  scavenge.
  

4 changed files:

• libraries/ghc-internal/cbits/StackCloningDecoding.cmm
• rts/CloneStack.c
• rts/sm/Evac.c
• rts/sm/NonMovingShortcut.c

Changes:

     ("ptr" clonedStack) = ccall cloneStack(MyCapability() "ptr", stgStack "ptr");

-    return (clonedStack);

+    // The StackSnapshot# result carries the boxed-unlifted-primitive pointer

+    // tag; see Note [Pointer tagging of unlifted boxed primitives] in

+    // GHC.StgToCmm.Prim.

+    return (clonedStack + 1);

 }

 stg_sendCloneStackMessagezh (gcptr threadId, gcptr mVarStablePtr) {

   // Lift StackSnapshot# to StackSnapshot by applying it's constructor.

   // This is necessary because performTryPutMVar() puts the closure onto the

   // stack for evaluation and stacks can not be evaluated (entered).

-  HaskellObj result = rts_apply(cap, StackSnapshot_constructor_closure, (HaskellObj) newStackClosure);

+  // The constructor argument is a StackSnapshot#, which carries the

+  // boxed-unlifted-primitive pointer tag.

+  HaskellObj result = rts_apply(cap, StackSnapshot_constructor_closure,

+                                TAG_CLOSURE(1, (StgClosure *) newStackClosure));

   bool putMVarWasSuccessful = performTryPutMVar(cap, msg->result, result);

           mine = copyPart(p,(StgClosure *)stack, stack_sizeW(stack),

                           sizeofW(StgStack), gen_no, tag);

           if (mine) {

-              new_stack = (StgStack *)*p;

+              // copyPart stores the forwarded reference with its tag.

+              new_stack = (StgStack *)UNTAG_CLOSURE(*p);

               move_STACK(stack, new_stack);

               for (r = stack->sp, s = new_stack->sp;

                    r < stack->stack + stack->stack_size;) {

                 chain = p;

                 p = val;

                 goto selector_changed;

-            default:

+            default: {

                 // Found a value, add the current selector to the chain and

                 // update it.

+                // Re-establish the pointer tag for an evaluated constructor,

+                // as in eval_thunk_selector (rts/sm/Evac.c): the indirectees

+                // and the origin field installed by update_selector_chain

+                // carry the constructor tag.

+                const StgInfoTable *val_info = get_itbl(val);

+                if (val_info->type >= CONSTR && val_info->type <= CONSTR_NOCAF) {

+                    val = TAG_CLOSURE(stg_min(TAG_MASK, 1 + val_info->srt), val);

+                }

                 p->payload[0] = chain;

                 chain = p;

                 update_selector_chain(chain, origin, p0, val);

                 return val;

             }

+            }

         }

         case IND: