Simon Jakobi pushed to branch wip/sjakobi/mr16259 at Glasgow Haskell Compiler / GHC Commits: 781b0ee3 by Simon Jakobi at 2026-07-10T14:56:38+02:00 Compile-time perf: convey only correctness-relevant LFInfos at -O0 Attaching LFInfo to every IfaceId at every optimisation level (needed so imported value references carry their pointer tag) regressed compiler allocations at -O0. Only LFCon/LFScalar/LFPrim are correctness-relevant (values without enterable entry code); functions and thunks are safely enterable and their LFInfo is a mere optimisation, so omit it under -fomit-interface-pragmas, and restore the pre-existing gating of CAF-info and tag sigs. Also drop a dead warnPprTrace in updateDecl. Measured (quick flavour): T1969 -0.26%; most of the remaining regression comes from the enforcement code itself (see the MR discussion). Assisted-by: Claude Fable 5 - - - - - a26c7358 by Simon Jakobi at 2026-07-10T14:56:53+02:00 Don't emit the enter-taggable check when profiling LDV profiling relies on entering closures to mark them as used, so under profiling the RTS deliberately does not shortcut ENTER() on the tag (rts/include/Cmm.h) and tagged constructors are legitimately entered. With checkEnteredTaggable in every taggable constructor's entry code this aborted (under the temporary fatal default) or warned in every profiled program — ~140 prof-way failures in the fedora release CI job. Emit the check only when not profiling. The tag-test in emitEnter is kept under profiling: the scrutinee path (AssignTo) has always had one, so LDV never saw those enters anyway. Assisted-by: Claude Fable 5 - - - - - 2d19d76a by Simon Jakobi at 2026-07-10T14:57:07+02:00 Boot indirections: derive a fresh unique and make redirect suppression explicit mkBootIndName reused the original Name's unique, making the indirection's CLabel equal to the original's under Eq (by unique) but distinct under Ord (stableNameCmp) — an Eq/Ord incoherence. Worse, the guards that keep the emit-time static-indirection elimination (#15155 .equiv) from collapsing the $bi IND_STATIC onto a static constructor closure (which would make SOURCE importers enter the constructor) matched the $bi label in the boot-exports NameSet only via that unique collision. Give boot-ind names a retagged unique (new BootIndTag, deterministic) and suppress redirection via an explicit isBootIndName test in ncgLabelMayBeRedirected/llvmLabelMayBeRedirected. Also divert a reference to the boot indirection only when the Id really carries no LFInfo: if the real interface was loaded anyway, the value's own closure with its proper tag is both correct and cheaper, whereas combining the LFCon tag with the indirection's symbol would mistag an IND_STATIC. Assisted-by: Claude Fable 5 - - - - - 85c2b5ac by Simon Jakobi at 2026-07-10T14:57:27+02:00 RTS: preserve boxed-unlifted-primitive tags in compact regions and mark-compact GC; tag more producers Boxed unlifted primitives are tagged with 1, but several RTS paths still produced or laundered untagged references (tolerated by mask-untag, yet silently breaking the tags-at-rest invariant): - stg_compactAddWorkerzh stored the compacted ARR_WORDS pointer untagged and every SHOULDCOMPACT_IN_CNF early-out stored the untagged scrutinee; - the mark-compact collector recomputes tags in unthread() via get_iptr_tag, which knew only constructors and functions, so a compacting GC untagged every reference to these primitives (unthread only re-tags fields that were tagged before threading, so returning 1 for these closure types cannot invent tags); - stg_compactFixupPointerszh and stg_cloneMyStackzh returned their results untagged. Found via segfaults in compact_gc/compact_simple_array/T14497-compact under a strict (subtract-1) untag prototype. Assisted-by: Claude Fable 5 - - - - - b7a5055e by Simon Jakobi at 2026-07-10T14:57:38+02:00 Enter-taggable check: changelog entry, relaxed atomics, wasm note Add the changelog.d entry for --fatal-enter-taggable (lint-changelog failed without one), use relaxed atomics for checkEnteredTaggable's one-shot warning latch, and document that the wasm dynamic linker path hands out untagged constructor closures. Assisted-by: Claude Fable 5 - - - - - 13 changed files: - + changelog.d/enter-taggable-invariant-23173 - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToLlvm/Config.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Unique.hs - libraries/ghc-internal/cbits/StackCloningDecoding.cmm - libraries/ghci/GHCi/ObjLink.hs - rts/Compact.cmm - rts/RtsMessages.c - rts/sm/Compact.c Changes: ===================================== changelog.d/enter-taggable-invariant-23173 ===================================== @@ -0,0 +1,15 @@ +section: codegen +synopsis: Pointers to boxed unlifted primitives (``ByteArray#``, ``Array#``, + ``MVar#``, ...) are now tagged, and entering a taggable normal form is + reported. +issues: #23173 +mrs: !16259 + +description: { + References to boxed unlifted primitive values such as ``ByteArray#``, + ``Array#`` or ``MVar#`` now carry pointer tag 1, like single-constructor + data types. Together with this, GHC now enforces the invariant that the + entry code of a taggable normal form is unreachable: entering such a + closure prints a one-shot warning at runtime, or aborts the program when + the new RTS flag ``--fatal-enter-taggable`` is given. +} ===================================== compiler/GHC/CmmToAsm/Config.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Cmm.Type (Width(..)) import GHC.Cmm.CLabel (CLabel, hasHaskellName) import GHC.CmmToAsm.CFG.Weight import GHC.Unit.Module (Module) +import GHC.Types.Name (isBootIndName) import GHC.Types.Name.Set (NameSet, elemNameSet) import GHC.Utils.Outputable @@ -66,12 +67,13 @@ data NCGConfig = NCGConfig -- | May a static indirection labelled @symbol@ be eliminated by redirecting it -- to its indirectee (the @.equiv@ trick, see Note [emit-time elimination of -- static indirections] in "GHC.Cmm.CLabel")? No, if @symbol@ is exported by --- this module's hs-boot file: SOURCE importers reference it untagged and must be +-- this module's hs-boot file, or is itself a boot indirection ('mkBootIndName' +-- in "GHC.Types.Name"): SOURCE importers reference it untagged and must be -- able to enter it to obtain the (tagged) indirectee. ncgLabelMayBeRedirected :: NCGConfig -> CLabel -> Bool ncgLabelMayBeRedirected config symbol = case hasHaskellName symbol of - Just nm -> not (nm `elemNameSet` ncgBootExports config) + Just nm -> not (isBootIndName nm || nm `elemNameSet` ncgBootExports config) Nothing -> True -- | Return Word size ===================================== compiler/GHC/CmmToLlvm/Config.hs ===================================== @@ -12,6 +12,7 @@ import GHC.Prelude import GHC.Platform import GHC.Cmm.CLabel (CLabel, hasHaskellName) +import GHC.Types.Name (isBootIndName) import GHC.Types.Name.Set (NameSet, elemNameSet) import GHC.Utils.Outputable import GHC.Settings.Utils @@ -40,13 +41,14 @@ data LlvmCgConfig = LlvmCgConfig -- | May a static indirection labelled @symbol@ be eliminated by redirecting it -- to its indirectee (the alias trick, see Note [emit-time elimination of static -- indirections] in "GHC.Cmm.CLabel")? No, if @symbol@ is exported by this --- module's hs-boot file: SOURCE importers reference it untagged and must be able +-- module's hs-boot file, or is itself a boot indirection ('mkBootIndName' in +-- "GHC.Types.Name"): SOURCE importers reference it untagged and must be able -- to enter it to obtain the (tagged) indirectee. Mirrors 'ncgLabelMayBeRedirected' -- in "GHC.CmmToAsm.Config". llvmLabelMayBeRedirected :: LlvmCgConfig -> CLabel -> Bool llvmLabelMayBeRedirected config symbol = case hasHaskellName symbol of - Just nm -> not (nm `elemNameSet` llvmCgBootExports config) + Just nm -> not (isBootIndName nm || nm `elemNameSet` llvmCgBootExports config) Nothing -> True data LlvmTarget = LlvmTarget ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -68,7 +68,6 @@ import GHC.Types.TyThing import GHC.Types.CompleteMatch import GHC.Types.Name.Cache -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Logger import GHC.Utils.Binary @@ -139,7 +138,12 @@ mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos stubs foreign_files -- value must carry the value's pointer tag, which needs its LambdaFormInfo), -- not an inlining pragma. Attach it regardless of -fomit-interface-pragmas -- so imported value references are tagged at every optimisation level. - let decls = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos + -- (At -O0 the code generator only conveys the correctness-relevant + -- LFInfos; see generatedInfo in GHC.StgToCmm.) CAF-info and tag sigs + -- remain ordinary pragmas, omitted under -fomit-interface-pragmas. + let omit_prags = gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) + mb_stg_infos' = if omit_prags then Nothing else mb_stg_infos + decls = updateDecl (mi_decls partial_iface) mb_stg_infos' omit_prags mb_cmm_infos -- See Note [Foreign stubs and TH bytecode linking] mi_simplified_core <- for (mi_simplified_core partial_iface) $ \simpl_core -> do @@ -189,13 +193,15 @@ shareIface nc compressionLevel mi = do initBinMemSize :: Int initBinMemSize = 1024 * 1024 -- 1 MB -updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl] -updateDecl decls Nothing Nothing = decls -updateDecl decls m_stg_infos m_cmm_infos +updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Bool -> Maybe CmmCgInfos -> [IfaceDecl] +updateDecl decls Nothing _ Nothing = decls +updateDecl decls m_stg_infos omit_prags m_cmm_infos = map update_decl decls where (non_cafs,lf_infos) = maybe (mempty, mempty) - (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info)) + (\cmm_info -> ( if omit_prags then mempty + else ncs_nameSet (cgNonCafs cmm_info) + , cgLFInfos cmm_info )) m_cmm_infos tag_sigs = fromMaybe mempty m_stg_infos @@ -203,9 +209,8 @@ updateDecl decls m_stg_infos m_cmm_infos | let not_caffy = elemNameSet nm non_cafs , let mb_lf_info = lookupNameEnv lf_infos nm , let sig = lookupNameEnv tag_sigs nm - -- NB: with LFInfo now attached at every optimisation level, a missing - -- LFInfo is unremarkable (e.g. at -O0), so we do not trace it here. - , warnPprTrace False "updateDecl" (text "Name without LFInfo:" <+> ppr nm) True + -- A missing LFInfo is unremarkable: at -O0 only the + -- correctness-relevant LFInfos are conveyed (see GHC.StgToCmm). -- Only allocate a new IfaceId if we're going to update the infos , isJust mb_lf_info || not_caffy || isJust sig = IfaceId nm ty details $ ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -21,9 +21,11 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Config import GHC.StgToCmm.Ticky -import GHC.StgToCmm.Types (ModuleLFInfos) +import GHC.StgToCmm.Types (ModuleLFInfos, LambdaFormInfo(..)) import GHC.StgToCmm.CgUtils (CgStream) +import GHC.Platform.Profile (profileIsProfiling) + import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.CLabel @@ -137,11 +139,21 @@ codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) tycons !lf = cg_lf info -- LFInfo is part of the STG-ABI (a reference to an imported value - -- must carry its pointer tag), not an inlining pragma, so collect - -- it for every binding regardless of -fomit-interface-pragmas. - -- (Only LFInfo is conveyed here, never unfoldings.) + -- must carry its pointer tag), not an inlining pragma, so even + -- under -fomit-interface-pragmas we must convey the LFInfos that + -- pointer-tagging correctness depends on: values without entry + -- code that may be entered (LFCon under the tag-test in + -- emitEnter; LFScalar/LFPrim never). Functions and thunks are + -- safely enterable, so their LFInfo remains a mere optimisation + -- and is omitted at -O0 to keep interfaces small. + keep_lf_info lf = case lf of + LFCon{} -> True + LFScalar -> True + LFPrim -> True + _ -> not (stgToCmmOmitIfPragmas cfg) !generatedInfo - = mkNameEnv (Prelude.map extractInfo (nonDetEltsUFM cg_id_infos)) + = mkNameEnv [ i | i@(_, lf) <- Prelude.map extractInfo (nonDetEltsUFM cg_id_infos) + , keep_lf_info lf ] ; rn_mapping <- liftIO (readIORef uniqRnRef) ; liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping) @@ -376,7 +388,11 @@ cgDataCon mn data_con -- Larger families have no spare tag, so their values are entered -- as normal and the entry returns them tagged with the -- family-saturating tag. - ; when taggable $ + -- When profiling, entering tagged constructors is sanctioned: + -- LDV profiling relies on it to mark closures as used (ENTER() + -- in rts/include/Cmm.h does not shortcut on the tag), so the + -- check would fire on every constructor use. + ; when (taggable && not (profileIsProfiling profile)) $ emitCheckEnteredTaggable (showPprUnsafe data_con) ; void $ emitReturn [cmmOffsetB platform node (fromDynTag (tagForCon platform data_con))] ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -45,6 +45,8 @@ import GHC.Types.Var.Env import GHC.Utils.Outputable import GHC.Utils.Panic +import Data.Maybe (isNothing) + import GHC.Builtin.Names (getUnique) @@ -151,7 +153,12 @@ getCgIdInfo id -- cgTopBinding, so no indirection exists for them; reference them -- directly. See Note [Boot-exported constructors and pointer -- tagging] in "GHC.StgToCmm.DataCon". + -- If the Id does carry LFInfo (its real interface got loaded for + -- some other reason), reference the value's own closure with its + -- proper tag: diverting would combine that tag with the + -- indirection's symbol, mistagging an IND_STATIC. use_boot_ind = needsBootInd id + && isNothing (idLFInfo_maybe id) && not (isDataConWorkId id) && nameModule name `elemModuleSet` stgToCmmSourceImports cfg ; if isExternalName name then ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -47,7 +47,7 @@ module GHC.Types.Name ( mkInternalName, mkClonedInternalName, mkDerivedInternalName, mkSystemVarName, mkSysTvName, mkFCallName, - mkExternalName, mkWiredInName, mkBootIndName, + mkExternalName, mkWiredInName, mkBootIndName, isBootIndName, -- ** Manipulating and deconstructing 'Name's nameUnique, setNameUnique, @@ -545,9 +545,20 @@ mkExternalName uniq mod occ loc -- pointer tagging] in "GHC.StgToCmm.DataCon". mkBootIndName :: Name -> Name mkBootIndName name = - mkExternalName (nameUnique name) (nameModule name) + -- Retag the unique rather than reuse it: reusing would make the indirection's + -- Name (and hence its CLabels) equal to the original's under Eq (by unique) + -- yet distinct under Ord (stableNameCmp, by occ). Retagging stays + -- deterministic, so the external symbol is still a pure function of module + -- and occurrence. + mkExternalName (newTagUnique (nameUnique name) BootIndTag) (nameModule name) (mkBootIndOcc (nameOccName name)) (nameSrcSpan name) +-- | Is this a name made by 'mkBootIndName'? Recognised by its unique's tag, +-- so it works on names reconstructed from labels as well. +isBootIndName :: Name -> Bool +isBootIndName name = case unpkUnique (nameUnique name) of + (tag, _) -> tag == BootIndTag + -- | Create a name which is actually defined by the compiler itself mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name {-# INLINE mkWiredInName #-} ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -133,6 +133,7 @@ data UniqueTag = AlphaTyVarTag | BcoTag | BlockIdTag + | BootIndTag | BoxedTupleDataTag | BoxedTupleTyConTag | BoxingTyConTag @@ -184,6 +185,7 @@ uniqueTag :: UniqueTag -> Char uniqueTag AlphaTyVarTag = '1' uniqueTag BcoTag = 'I' uniqueTag BlockIdTag = 'L' +uniqueTag BootIndTag = 'h' uniqueTag BoxedTupleDataTag = '7' uniqueTag BoxedTupleTyConTag = '4' uniqueTag BoxingTyConTag = 'b' @@ -253,6 +255,7 @@ charToUniqueTag 'D' = DsTag charToUniqueTag 'E' = PseudoTag charToUniqueTag 'f' = FldNSTag charToUniqueTag 'g' = StgPTag +charToUniqueTag 'h' = BootIndTag charToUniqueTag 'H' = VirtualRegTag charToUniqueTag 'i' = IfaceTag charToUniqueTag 'I' = BcoTag ===================================== libraries/ghc-internal/cbits/StackCloningDecoding.cmm ===================================== @@ -9,7 +9,8 @@ stg_cloneMyStackzh () { ("ptr" clonedStack) = ccall cloneStack(MyCapability() "ptr", stgStack "ptr"); - return (clonedStack); + // Boxed unlifted primitives are tagged with 1. + return (clonedStack + 1); } stg_sendCloneStackMessagezh (gcptr threadId, gcptr mVarStablePtr) { ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -302,6 +302,10 @@ isWindowsHost = False #endif #if defined(wasm32_HOST_ARCH) +-- The wasm dynamic linker resolves symbols out of process, so the RTS +-- helper below is unavailable; looked-up constructor closures stay +-- untagged and forcing one triggers the (non-fatal) enter-taggable +-- warning. tagClosurePtr :: Ptr a -> Ptr a tagClosurePtr = id #else ===================================== rts/Compact.cmm ===================================== @@ -143,7 +143,7 @@ eval: case ARR_WORDS: { (should) = ccall shouldCompact(compact "ptr", p "ptr"); - if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); } + if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = tag | p; return(); } if (should == SHOULDCOMPACT_PINNED) { jump stg_raisezh(HsIface_cannotCompactPinned_closure(W_[ghc_hs_iface])); } @@ -154,7 +154,7 @@ eval: W_ size; size = SIZEOF_StgArrBytes + StgArrBytes_bytes(p); ALLOCATE(compact, ROUNDUP_BYTES_TO_WDS(size), p, to, tag); - P_[pp] = to; + P_[pp] = tag | to; prim %memcpy(to, p, size, 1); return(); } @@ -164,7 +164,7 @@ eval: MUT_ARR_PTRS_FROZEN_CLEAN: { (should) = ccall shouldCompact(compact "ptr", p "ptr"); - if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); } + if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = tag | p; return(); } CHECK_HASH(); @@ -196,7 +196,7 @@ eval: SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: { (should) = ccall shouldCompact(compact "ptr", p "ptr"); - if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); } + if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = tag | p; return(); } CHECK_HASH(); @@ -459,5 +459,6 @@ stg_compactFixupPointerszh ( W_ first_block, W_ root ) // guaranteed to be valid // (this is true even if the fixup phase failed) gcstr = str; - return (gcstr, ok); + // Boxed unlifted primitives are tagged with 1. + return (gcstr + 1, ok); } ===================================== rts/RtsMessages.c ===================================== @@ -88,9 +88,9 @@ checkEnteredTaggable(const char *con) ssbarf("entered a taggable normal form: %s", con); // ssbarf does not return } - static int warned = 0; - if (!warned) { - warned = 1; + static StgWord warned = 0; + if (!RELAXED_LOAD(&warned)) { + RELAXED_STORE(&warned, 1); debugBelch("warning: entered a taggable normal form: %s\n" "(further occurrences suppressed; rerun with " "+RTS --fatal-enter-taggable to abort)\n", ===================================== rts/sm/Compact.c ===================================== @@ -122,6 +122,30 @@ get_iptr_tag(StgInfoTable *iptr) } } + // Boxed unlifted primitives are tagged with 1 (see Note [Pointer tagging + // of unlifted boxed primitives] in GHC.StgToCmm.Prim). unthread() applies + // this tag only to fields that were tagged before threading, so a type + // listed here never gains a tag it did not have. + 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: + case WEAK: + case PRIM: + case MUT_PRIM: + case BLOCKING_QUEUE: + return 1; + default: return 0; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/706f80fc03553579ad5aebbd20c913c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/706f80fc03553579ad5aebbd20c913c... You're receiving this email because of your account on gitlab.haskell.org.