GitLab

Simon Jakobi pushed to branch wip/sjakobi/mr16259 at Glasgow Haskell Compiler / GHC

Commits:

5d8d132f

by Simon Jakobi at 2026-07-12T12:53:47+02:00

rts: sanity-check pointer tags at rest (#23173)

The enter-taggable invariant is otherwise enforced only by crashing entry
code, so a GC path that strips a tag goes unnoticed until something happens
to enter the stripped pointer. Add checkPtrTag to the sanity checker
(+RTS -DS): every traversed user-level pointer field must carry the tag
implied by its target's info table, catching tag-stripping pointer-rewriting
paths mechanically on every sanity-checked GC.

See Note [Sanity-checking pointer tags] in rts/sm/Sanity.c for the rules
and the exemptions. A full-testsuite sweep under the sanity ways flushed
out the legitimate untagged producers the exemptions cover:

- Stack slots and PAP/AP payloads get relaxed rules (tag 0 accepted):
  bitmap-walked frames such as the stg_gc_prim_p* heap-check-retry frames
  save primop pointer arguments that codegen untags at the Cmm call
  boundary, and hand-written Cmm keeps untagged working pointers live.
- C-finalizer nodes are linked untagged into StgWeak.cfinalizers and
  walked raw by the RTS (exempted via C_FINALIZER_LIST).
- ghc-heap's Box wraps pointer words captured verbatim by heap/stack
  introspection, so its field may hold an untagged constructor pointer;
  it is recognized via a new Box_con_info entry in the RTS/ghc-internal
  interface.

Verified against the array/compact/nonmoving/MVar/weak/cloneStack tests in
the sanity, threaded2_sanity and nonmoving_thr_sanity ways, and negatively
by disabling the unthread() tag preservation in rts/sm/Compact.c, which the
new check catches on the first compacting collection.

Assisted-by: Claude Fable 5

02b4fef7

by Simon Jakobi at 2026-07-12T12:53:47+02:00

Accept remaining compile-time metric increases from enter-taggable enforcement

Second CI run of !16329 flagged three more compile-time allocation
increases beyond T13960: T20049 (+2.0%, right at the window edge, on
x86_64 validate jobs) and, on the wasm cross job only, T6048 (+2.2%)
and T16577 (+5.7%). These are the emitEnter tag-test cost of the
invariant enforcement (#23173); the wasm numbers suggest the cost is
higher without TablesNextToCode.

The perf driver reads the Metric Increase block from the HEAD commit
only, hence this empty commit at the branch tip; it supersedes the
earlier one for T13960.

-------------------------
Metric Increase:
    T13960
    T16577
    T20049
    T6048
-------------------------

Assisted-by: Claude Fable 5

4 changed files:

libraries/ghc-internal/include/RtsIfaceSymbols.h
rts/Prelude.h
rts/include/rts/RtsToHsIface.h
rts/sm/Sanity.c

Changes:

libraries/ghc-internal/include/RtsIfaceSymbols.h

@@ -59,6 +59,7 @@ CLOSURE(GHCziInternalziExceptionziType, underflowException_closure)
  CLOSURE(GHCziInternalziExceptionziType, overflowException_closure)
  INFO_TBL(GHCziInternalziCString, unpackCStringzh_info)
  INFO_TBL(GHCziInternalziCString, unpackCStringUtf8zh_info)
 +INFO_TBL(GHCziInternalziHeapziClosures, Box_con_info)
  #if defined(wasm32_HOST_ARCH) && defined(__PIC__)
  CLOSURE(GHCziInternalziWasmziPrimziImports, raiseJSException_closure)
  INFO_TBL(GHCziInternalziWasmziPrimziTypes, JSVal_con_info)

rts/Prelude.h

@@ -84,3 +84,4 @@ extern StgClosure ZCMain_main_closure;
  #define FunPtr_con_info           ghc_hs_iface->FunPtr_con_info
  #define StablePtr_static_info     ghc_hs_iface->StablePtr_static_info
  #define StablePtr_con_info        ghc_hs_iface->StablePtr_con_info
 +#define Box_con_info              ghc_hs_iface->Box_con_info

rts/include/rts/RtsToHsIface.h

@@ -60,6 +60,7 @@ typedef struct {
      StgClosure *overflowException_closure;  // GHC.Internal.Exception.Type.overflowException_closure
      const StgInfoTable *unpackCStringzh_info;  // GHC.Internal.CString.unpackCStringzh_info
      const StgInfoTable *unpackCStringUtf8zh_info;  // GHC.Internal.CString.unpackCStringUtf8zh_info
 +    const StgInfoTable *Box_con_info;  // GHC.Internal.Heap.Closures.Box_con_info
  #if defined(wasm32_HOST_ARCH)
      StgClosure *raiseJSException_closure;  // GHC.Internal.Wasm.Prim.Imports.raiseJSException_closure
      const StgInfoTable *JSVal_con_info;  // GHC.Internal.Wasm.Prim.Types.JSVal_con_info

rts/sm/Sanity.c

@@ -25,6 +25,7 @@
  #include "Sanity.h"
  #include "Schedule.h"
  #include "Apply.h"
 +#include "Prelude.h"
  #include "Printer.h"
  #include "Arena.h"
  #include "RetainerProfile.h"
@@ -42,6 +43,7 @@ int   isHeapAlloced       ( StgPtr p);
  static void  checkSmallBitmap    ( StgPtr payload, StgWord bitmap, uint32_t );
  static void  checkLargeBitmap    ( StgPtr payload, StgLargeBitmap*, uint32_t );
  static void  checkClosureShallow ( const StgClosure * );
 +static void  checkPtrTag         ( const StgClosure *, bool );
  static void  checkCompactObjects (bdescr *bd);
@@ -72,6 +74,7 @@ checkSmallBitmap( StgPtr payload, StgWord bitmap, uint32_t size )
      for(i = 0; i < size; i++, bitmap >>= 1 ) {
          if ((bitmap & 1) == 0) {
              checkClosureShallow((StgClosure *)payload[i]);
 +            checkPtrTag((StgClosure *)payload[i], false);
+         }
+     }
+ }
@@ -89,11 +92,126 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, uint32_t size )
          for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
              if ((bitmap & 1) == 0) {
                  checkClosureShallow((StgClosure *)payload[i]);
 +                checkPtrTag((StgClosure *)payload[i], false);
+             }
+         }
+     }
+ }
 +/* Note [Sanity-checking pointer tags]
 + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 + * checkPtrTag asserts the pointer-tagging invariant (#23173) at rest: a
 + * pointer to a constructor carries its constructor tag (see tagConstr in
 + * ClosureMacros.h and get_iptr_tag in sm/Compact.c), and a pointer to a boxed
 + * unlifted primitive (MVar#, MutVar#, the arrays, ...) carries tag 1 (see
 + * Note [Pointer tagging of unlifted boxed primitives] in GHC.StgToCmm.Prim).
 + * The invariant is otherwise enforced only by crashing entry code, which
 + * catches a stripped tag only if the pointer is subsequently entered; this
 + * check catches tag-stripping pointer-rewriting paths (Evac, Compact,
 + * NonMovingShortcut, ...) mechanically on every sanity-checked GC.
 + *
 + * It is called only on user-level fields (stack bitmap slots, PAP/AP
 + * payloads, constructor/fun/thunk payloads, array elements, MutVar/TVar/MVar
 + * values, IND indirectees), because the RTS also holds internal untagged
 + * links. The rules exempt:
 + *
 + *  - static constructors: RTS sentinels (stg_END_TSO_QUEUE_closure, ...) are
 + *    CONSTR_NOCAFs that C code stores untagged, e.g. as an empty MVar's
 + *    value, so only heap-allocated constructors are checked;
 + *
 + *  - large-family constructors (con_tag >= TAG_MASK): tag is capped at
 + *    TAG_MASK, so no exact requirement is asserted;
 + *
 + *  - WEAK, TSO, STACK, BLOCKING_QUEUE, PRIM, MUT_PRIM: user-level references
 + *    (Weak#, ThreadId#, ...) to these are tagged, but legitimate untagged
 + *    RTS-internal links (weak_ptr_list, run queues, tso->_link, STM
 + *    structures) reach the same traversals;
 + *
 + *  - C_FINALIZER_LIST nodes: although their info table is a CONSTR, they
 + *    are RTS-internal. All references to them — StgWeak.cfinalizers and the
 + *    nodes' link fields — are untagged links built by stg_addCFinalizerToWeakzh
 + *    (PrimOps.cmm) and walked raw by runCFinalizers (Weak.c); user code never
 + *    holds a reference to one. (The compacting GC preserves untaggedness:
 + *    unthread re-applies get_iptr_tag only to originally-tagged references.)
 + *
 + *  - fields of ghc-heap's Box (GHC.Internal.Heap.Closures): `data Box = Box
 + *    Any` wraps a pointer word captured verbatim by heap/stack introspection
 + *    (unpackClosure#, ghc-heap's stack decoding), so it carries whatever tag
 + *    the source bits had — possibly none. Box is recognized via
 + *    ghc_hs_iface->Box_con_info, NULL-guarded since sanity checks can run
 + *    before ghc-internal registers the interface;
 + *
 + *  - BLACKHOLE indirectees (no call site on that field): tag 0 there means
 + *    "not yet updated". Plain IND indirectees are checked;
 + *
 + *  - bitmap-walked slots (stack frames, PAP/AP payloads; heap_field =
 + *    false): hand-written Cmm legitimately stores untagged pointers there.
 + *    Codegen untags unlifted boxed primop arguments at the Cmm call
 + *    boundary, and generic RTS frames save those already-untagged arguments
 + *    on the stack (the stg_block_{take,read,put}mvar frames and the
 + *    stg_gc_prim_* heap-check-retry frames in HeapStackCheck.cmm); Cmm code
 + *    also keeps deliberately untagged working pointers live across calls
 + *    (e.g. stg_compactAddWorkerzh's "p"), landing them in return-frame
 + *    slots. Such slots hence get no constructor rule, and the unlifted-
 + *    primitive rule is relaxed to tag 0-or-1 (still catching corrupt tags).
 + *    The strict rules apply to heap fields, where all the tag-stripping GC
 + *    bugs lived.
 + */
 +static void
 +checkPtrTag( const StgClosure *q, bool heap_field )
 +{
 +    const StgClosure *p = UNTAG_CONST_CLOSURE(q);
 +    const StgInfoTable *raw_info = ACQUIRE_LOAD(&p->header.info);
 +    if (IS_FORWARDING_PTR(raw_info)) return;
 +    const StgInfoTable *info = INFO_PTR_TO_STRUCT(raw_info);
++
 +    switch (info->type) {
 +    case CONSTR:
 +    case CONSTR_1_0:
 +    case CONSTR_0_1:
 +    case CONSTR_2_0:
 +    case CONSTR_1_1:
 +    case CONSTR_0_2:
 +    case CONSTR_NOCAF:
 +    {
 +        // RTS-internal untagged links; see the C_FINALIZER_LIST bullet in
 +        // Note [Sanity-checking pointer tags].
 +        if (raw_info == &stg_C_FINALIZER_LIST_info) {
 +            break;
 +        }
 +        StgWord con_tag = (StgWord)info->srt + 1;
 +        if (heap_field && con_tag <= TAG_MASK && HEAP_ALLOCED((StgPtr)p)) {
 +            ASSERT(GET_CLOSURE_TAG(q) == con_tag);
 +        }
 +        break;
 +    }
++
 +    case ARR_WORDS:
 +    case MUT_ARR_PTRS_CLEAN:
 +    case MUT_ARR_PTRS_DIRTY:
 +    case MUT_ARR_PTRS_FROZEN_CLEAN:
 +    case MUT_ARR_PTRS_FROZEN_DIRTY:
 +    case SMALL_MUT_ARR_PTRS_CLEAN:
 +    case SMALL_MUT_ARR_PTRS_DIRTY:
 +    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
 +    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
 +    case MUT_VAR_CLEAN:
 +    case MUT_VAR_DIRTY:
 +    case MVAR_CLEAN:
 +    case MVAR_DIRTY:
 +    case TVAR:
 +        if (heap_field) {
 +            ASSERT(GET_CLOSURE_TAG(q) == 1);
 +        } else {
 +            ASSERT(GET_CLOSURE_TAG(q) <= 1);
 +        }
 +        break;
++
 +    default:
 +        break;
 +    }
 +}
++
  /*
   * check that it looks like a valid closure - without checking its payload
   * used to avoid recursion between checking PAPs and checking stack
@@ -102,6 +220,8 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, uint32_t size )
  static void
  checkClosureShallow( const StgClosure* p )
+ {
 +    // No checkPtrTag here: checkCompactObjects calls this on raw
 +    // (necessarily untagged) object addresses, not on stored pointers.
      ASSERT(LOOKS_LIKE_CLOSURE_PTR(UNTAG_CONST_CLOSURE(p)));
+ }
@@ -129,10 +249,12 @@ checkStackFrame( StgPtr c )
      case STOP_FRAME:
      case RET_SMALL:
      case ANN_FRAME:
 +    {
          size = BITMAP_SIZE(info->i.layout.bitmap);
          checkSmallBitmap((StgPtr)c + 1,
                           BITMAP_BITS(info->i.layout.bitmap), size);
          return 1 + size;
 +    }
      case RET_BCO: {
          StgBCO *bco;
@@ -377,6 +499,8 @@ checkClosure( const StgClosure* p )
          ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head));
          ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail));
          ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value));
 +        // head/tail are RTS-internal TSO queue links; only value is user-level
 +        checkPtrTag(mvar->value, true);
          return sizeofW(StgMVar);
+       }
@@ -390,6 +514,7 @@ checkClosure( const StgClosure* p )
          uint32_t i;
          for (i = 0; i < info->layout.payload.ptrs; i++) {
            ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
 +          checkPtrTag(((StgThunk *)p)->payload[i], true);
+         }
          return thunk_sizeW_fromITBL(info);
+       }
@@ -407,14 +532,33 @@ checkClosure( const StgClosure* p )
      case CONSTR_1_1:
      case CONSTR_0_2:
      case CONSTR_2_0:
 -    case BLACKHOLE:
 -    case PRIM:
 -    case MUT_PRIM:
      case MUT_VAR_CLEAN:
      case MUT_VAR_DIRTY:
      case TVAR:
      case THUNK_STATIC:
      case FUN_STATIC:
 +        {
 +            // ghc-heap's Box holds a raw captured pointer word; see the Box
 +            // bullet in Note [Sanity-checking pointer tags].
 +            bool box = ghc_hs_iface != NULL
 +                && ACQUIRE_LOAD(&p->header.info) == Box_con_info;
 +            uint32_t i;
 +            for (i = 0; i < info->layout.payload.ptrs; i++) {
 +                ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
 +                if (!box) {
 +                    checkPtrTag(p->payload[i], true);
 +                }
 +            }
 +            return sizeW_fromITBL(info);
 +        }
++
 +    // As above, but without checkPtrTag: a BLACKHOLE indirectee legitimately
 +    // carries tag 0 ("not yet updated"), and PRIM/MUT_PRIM/COMPACT_NFDATA
 +    // payloads are RTS-internal links.
 +    // See Note [Sanity-checking pointer tags].
 +    case BLACKHOLE:
 +    case PRIM:
 +    case MUT_PRIM:
      case COMPACT_NFDATA:
+         {
              uint32_t i;
@@ -480,6 +624,7 @@ checkClosure( const StgClosure* p )
               */
              StgInd *ind = (StgInd *)p;
              ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee));
 +            checkPtrTag(ind->indirectee, true);
              return sizeofW(StgInd);
+         }
@@ -529,6 +674,7 @@ checkClosure( const StgClosure* p )
              uint32_t i;
              for (i = 0; i < a->ptrs; i++) {
                  ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i]));
 +                checkPtrTag(a->payload[i], true);
+             }
              return mut_arr_ptrs_sizeW(a);
+         }
@@ -541,6 +687,7 @@ checkClosure( const StgClosure* p )
              StgSmallMutArrPtrs *a = (StgSmallMutArrPtrs *)p;
              for (uint32_t i = 0; i < a->ptrs; i++) {
                  ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i]));
 +                checkPtrTag(a->payload[i], true);
+             }
              return small_mut_arr_ptrs_sizeW(a);
+         }