[Git][ghc/ghc][wip/T26709] 2 commits: Refactor srutOkForBinderSwap
by Simon Peyton Jones (＠simonpj) 31 Dec '25
by Simon Peyton Jones (＠simonpj) 31 Dec '25
31 Dec '25
Simon Peyton Jones pushed to branch wip/T26709 at Glasgow Haskell Compiler / GHC
Commits:
c3555d08 by Simon Peyton Jones at 2025-12-31T09:25:09+00:00
Refactor srutOkForBinderSwap
This MR does a small refactor:
* Moves `scrutOkForBinderSwap` and `BinderSwapDecision`
to GHC.Core.Utils
* Inverts the sense of the coercion it returns, which makes
more sense
No effect on behaviour
- - - - -
b5544586 by Simon Peyton Jones at 2025-12-31T09:27:03+00:00
Improve case merging
This small MR makes case merging happen a bit more often than
it otherwise could, by getting join points out of the way.
See #26709 and GHC.Core.Utils
Note [Floating join points out of DEFAULT alternatives]
- - - - -
7 changed files:
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Utils.hs
- + testsuite/tests/simplCore/should_compile/T26709.hs
- + testsuite/tests/simplCore/should_compile/T26709.stderr
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -28,7 +28,7 @@ core expression with (hopefully) improved usage information.
module GHC.Core.Opt.OccurAnal (
occurAnalysePgm,
occurAnalyseExpr,
- zapLambdaBndrs, BinderSwapDecision(..), scrutOkForBinderSwap
+ zapLambdaBndrs
) where
import GHC.Prelude hiding ( head, init, last, tail )
@@ -36,7 +36,7 @@ import GHC.Prelude hiding ( head, init, last, tail )
import GHC.Core
import GHC.Core.FVs
import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp,
- mkCastMCo, mkTicks )
+ mkCastMCo, mkTicks, BinderSwapDecision(..), scrutOkForBinderSwap )
import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr )
import GHC.Core.Coercion
import GHC.Core.Type
@@ -3537,6 +3537,7 @@ doesn't use it. So this is only to satisfy the perhaps-over-picky Lint.
-}
addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv
+-- See Note [Binder swap]
-- See Note [The binder-swap substitution]
addBndrSwap scrut case_bndr
env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars })
@@ -3544,7 +3545,7 @@ addBndrSwap scrut case_bndr
, scrut_var /= case_bndr
-- Consider: case x of x { ... }
-- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop
- = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco)
+ = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mkSymMCo mco)
, occ_bs_rng = rng_vars `extendVarSet` case_bndr'
`unionVarSet` tyCoVarsOfMCo mco }
@@ -3554,27 +3555,6 @@ addBndrSwap scrut case_bndr
case_bndr' = zapIdOccInfo case_bndr
-- See Note [Zap case binders in proxy bindings]
--- | See bBinderSwaOk.
-data BinderSwapDecision
- = NoBinderSwap
- | DoBinderSwap OutVar MCoercion
-
-scrutOkForBinderSwap :: OutExpr -> BinderSwapDecision
--- If (scrutOkForBinderSwap e = DoBinderSwap v mco, then
--- v = e |> mco
--- See Note [Case of cast]
--- See Historical Note [Care with binder-swap on dictionaries]
---
--- We use this same function in SpecConstr, and Simplify.Iteration,
--- when something binder-swap-like is happening
-scrutOkForBinderSwap e
- = case e of
- Tick _ e -> scrutOkForBinderSwap e -- Drop ticks
- Var v -> DoBinderSwap v MRefl
- Cast (Var v) co -> DoBinderSwap v (MCo (mkSymCo co))
- -- Cast: see Note [Case of cast]
- _ -> NoBinderSwap
-
lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id)
-- See Note [The binder-swap substitution]
-- Returns an expression of the same type as Id
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -22,7 +22,7 @@ import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.Opt.Simplify.Env
import GHC.Core.Opt.Simplify.Inline
import GHC.Core.Opt.Simplify.Utils
-import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) )
+import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs )
import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr )
import qualified GHC.Core.Make
import GHC.Core.Coercion hiding ( substCo, substCoVar )
@@ -3601,11 +3601,13 @@ addAltUnfoldings env case_bndr bndr_swap con_app
env1 = addBinderUnfolding env case_bndr con_app_unf
-- See Note [Add unfolding for scrutinee]
+ -- e.g. case (x |> co) of K a b -> blah
+ -- We add to `x` the unfolding (K a b |> sym co)
env2 | DoBinderSwap v mco <- bndr_swap
= addBinderUnfolding env1 v $
if isReflMCo mco -- isReflMCo: avoid calling mk_simple_unf
then con_app_unf -- twice in the common case
- else mk_simple_unf (mkCastMCo con_app mco)
+ else mk_simple_unf (mkCastMCo con_app (mkSymMCo mco))
| otherwise = env1
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -2693,7 +2693,7 @@ mkCase, mkCase1, mkCase2, mkCase3
mkCase mode scrut outer_bndr alts_ty alts
| sm_case_merge mode
- , Just (joins, alts') <- mergeCaseAlts outer_bndr alts
+ , Just (joins, alts') <- mergeCaseAlts scrut outer_bndr alts
= do { tick (CaseMerge outer_bndr)
; case_expr <- mkCase1 mode scrut outer_bndr alts_ty alts'
; return (mkLets joins case_expr) }
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -19,6 +19,7 @@ module GHC.Core.Utils (
mergeAlts, mergeCaseAlts, trimConArgs,
filterAlts, combineIdenticalAlts, refineDefaultAlt,
scaleAltsBy,
+ BinderSwapDecision(..), scrutOkForBinderSwap,
-- * Properties of expressions
exprType, coreAltType, coreAltsType,
@@ -72,7 +73,7 @@ import GHC.Platform
import GHC.Core
import GHC.Core.Ppr
-import GHC.Core.FVs( bindFreeVars )
+import GHC.Core.FVs( exprFreeVars, bindFreeVars )
import GHC.Core.DataCon
import GHC.Core.Type as Type
import GHC.Core.Predicate( isEqPred )
@@ -112,11 +113,11 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
+import Control.Monad ( guard )
import Data.ByteString ( ByteString )
import Data.Function ( on )
import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL )
import Data.Ord ( comparing )
-import Control.Monad ( guard )
import qualified Data.Set as Set
{-
@@ -590,6 +591,28 @@ The default alternative must be first, if it exists at all.
This makes it easy to find, though it makes matching marginally harder.
-}
+data BinderSwapDecision
+ = NoBinderSwap
+ | DoBinderSwap OutVar MCoercion
+
+scrutOkForBinderSwap :: OutExpr -> BinderSwapDecision
+-- If (scrutOkForBinderSwap e = DoBinderSwap v mco, then
+-- e = v |> mco
+-- See Note [Case of cast]
+-- See Historical Note [Care with binder-swap on dictionaries]
+--
+-- We use this same function in SpecConstr, and Simplify.Iteration,
+-- when something binder-swap-like is happening
+--
+-- See Note [Binder swap] in GHC.Core.Opt.OccurAnal
+scrutOkForBinderSwap e
+ = case e of
+ Tick _ e -> scrutOkForBinderSwap e -- Drop ticks
+ Var v -> DoBinderSwap v MRefl
+ Cast (Var v) co -> DoBinderSwap v (MCo co)
+ -- Cast: see Note [Case of cast]
+ _ -> NoBinderSwap
+
-- | Extract the default case alternative
findDefault :: [Alt b] -> ([Alt b], Maybe (Expr b))
findDefault (Alt DEFAULT args rhs : alts) = assert (null args) (alts, Just rhs)
@@ -651,11 +674,12 @@ filters down the matching alternatives in GHC.Core.Opt.Simplify.rebuildCase.
-}
---------------------------------
-mergeCaseAlts :: Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])
+mergeCaseAlts :: CoreExpr -> Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])
-- See Note [Merge Nested Cases]
-mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
+mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
| Just (joins, inner_alts) <- go deflt_rhs
- = Just (joins, mergeAlts outer_alts inner_alts)
+ , Just aux_binds <- mk_aux_binds joins
+ = Just ( aux_binds ++ joins, mergeAlts outer_alts inner_alts )
-- NB: mergeAlts gives priority to the left
-- case x of
-- A -> e1
@@ -665,6 +689,20 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
-- When we merge, we must ensure that e1 takes
-- precedence over e2 as the value for A!
where
+ scrut_fvs = exprFreeVars scrut
+
+ -- See Note [Floating join points out of DEFAULT alternatives]
+ mk_aux_binds join_binds
+ | not (any mentions_outer_bndr join_binds)
+ = Just [] -- Good! No auxiliary bindings needed
+ | exprIsTrivial scrut
+ , not (outer_bndr `elemVarSet` scrut_fvs)
+ = Just [NonRec outer_bndr scrut] -- Need a fixup binding
+ | otherwise
+ = Nothing -- Can't do it
+
+ mentions_outer_bndr bind = outer_bndr `elemVarSet` bindFreeVars bind
+
go :: CoreExpr -> Maybe ([CoreBind], [CoreAlt])
-- Whizzo: we can merge!
@@ -702,11 +740,10 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
= do { (joins, alts) <- go body
-- Check for capture; but only if we could otherwise do a merge
- ; let capture = outer_bndr `elem` bindersOf bind
- || outer_bndr `elemVarSet` bindFreeVars bind
- ; guard (not capture)
+ -- (i.e. the recursive `go` succeeds)
+ ; guard (okToFloatJoin scrut_fvs outer_bndr bind)
- ; return (bind:joins, alts ) }
+ ; return (bind : joins, alts ) }
| otherwise
= Nothing
@@ -718,7 +755,19 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
go _ = Nothing
-mergeCaseAlts _ _ = Nothing
+mergeCaseAlts _ _ _ = Nothing
+
+okToFloatJoin :: VarSet -> Id -> CoreBind -> Bool
+-- Check a join-point binding to see if it can be floated out of
+-- the DEFAULT branch of a `case`. A Just result means "yes",
+-- and the [CoreBInd] are the extra fix-up bindings to add.
+-- See Note [Floating join points out of DEFAULT alternatives]
+okToFloatJoin scrut_fvs outer_bndr bind
+ = not (any bad_bndr (bindersOf bind))
+ where
+ bad_bndr bndr = bndr == outer_bndr -- (a)
+ || bndr `elemVarSet` scrut_fvs -- (b)
+
---------------------------------
mergeAlts :: [Alt a] -> [Alt a] -> [Alt a]
@@ -927,10 +976,46 @@ Wrinkles
non-join-points unless the /outer/ case has just one alternative; doing
so would risk more allocation
+ Floating out join points isn't entirely straightforward.
+ See Note [Floating join points out of DEFAULT alternatives]
+
(MC5) See Note [Cascading case merge]
See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils
+Note [Floating join points out of DEFAULT alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this, from (MC4) of Note [Merge Nested Cases]
+ case x of r
+ DEFAULT -> join j = rhs in case r of ...
+ alts
+
+We want to float that join point out to give this
+ join j = rhs
+ case x of r
+ DEFAULT -> case r of ...
+ alts
+
+But doing so is flat-out wrong if the scoping gets messed up:
+ (a) case x of r { DEFAULT -> join r = ... in ...r... }
+ (b) case j of r { DEFAULT -> join j = ... in ... }
+ (c) case x of r { DEFAULT -> join j = ...r.. in ... }
+In all these cases we can't float the join point out because r changes its
+meaning. For (a) and (b) the Simplifier removes shadowing, so they'll
+be solved in the next iteration. But case (c) will persist.
+
+Happily, we can fix up case (c) by adding an auxiliary binding, like this
+ let r = e in
+ join j = rhs[r]
+ case e of r
+ DEFAULT -> ...r...
+ ...other alts...
+
+We can only do this if
+ * We don't introduce shadowing: that is `j` and `r` do not appear free in `e`.
+ (Again the Simplifier will eliminate such shadowing.)
+ * The scrutinee `e` is trivial so that the transformation doesn't duplicate work.
+
Note [Cascading case merge]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
testsuite/tests/simplCore/should_compile/T26709.hs
=====================================
@@ -0,0 +1,11 @@
+module T26709 where
+
+data T = A | B | C
+
+f x = case x of
+ A -> True
+ _ -> let {-# NOINLINE j #-}
+ j y = y && not (f x)
+ in case x of
+ B -> j True
+ C -> j False
=====================================
testsuite/tests/simplCore/should_compile/T26709.stderr
=====================================
@@ -0,0 +1,32 @@
+[1 of 1] Compiling T26709 ( T26709.hs, T26709.o )
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 26, types: 9, coercions: 0, joins: 1/1}
+
+Rec {
+-- RHS size: {terms: 25, types: 7, coercions: 0, joins: 1/1}
+f [Occ=LoopBreaker] :: T -> Bool
+[GblId, Arity=1, Str=<SL>, Unf=OtherCon []]
+f = \ (x :: T) ->
+ join {
+ j [InlPrag=NOINLINE, Dmd=MC(1,L)] :: Bool -> Bool
+ [LclId[JoinId(1)(Just [!])], Arity=1, Str=<1L>, Unf=OtherCon []]
+ j (eta [OS=OneShot] :: Bool)
+ = case eta of {
+ False -> GHC.Internal.Types.False;
+ True ->
+ case f x of {
+ False -> GHC.Internal.Types.True;
+ True -> GHC.Internal.Types.False
+ }
+ } } in
+ case x of {
+ A -> GHC.Internal.Types.True;
+ B -> jump j GHC.Internal.Types.True;
+ C -> jump j GHC.Internal.Types.False
+ }
+end Rec }
+
+
+
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -563,3 +563,8 @@ test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl -dsuppress-uni
test('T26116', normal, compile, ['-O -ddump-rules'])
test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T26349', normal, compile, ['-O -ddump-rules'])
+
+# T26709: we expect three `case` expressions not four
+test('T26709', [grep_errmsg(r'case')],
+ multimod_compile,
+ ['T26709', '-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b2f2236af8214ccdefdd643d1f2fa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b2f2236af8214ccdefdd643d1f2fa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Cheng Shao pushed new branch wip/sm-no-sweep at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sm-no-sweep
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/terrorjack/asan] 9 commits: hadrian: add support for building with AddressSanitizer
by Cheng Shao (＠TerrorJack) 31 Dec '25
by Cheng Shao (＠TerrorJack) 31 Dec '25
31 Dec '25
Cheng Shao pushed to branch wip/terrorjack/asan at Glasgow Haskell Compiler / GHC
Commits:
5a4b35fe by Cheng Shao at 2025-12-31T00:42:20+01:00
hadrian: add support for building with AddressSanitizer
This patch adds a +asan flavour transformer to hadrian to build all
stage1+ C/C++ code with AddressBehaviorSanitizer. This is particularly
useful to catch potential out-of-bounds and use-after-free bugs in the
RTS codebase.
- - - - -
1d590073 by Cheng Shao at 2025-12-31T00:42:26+01:00
ci: add ubsan+asan job
We now have a
`x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan`
validate/nightly job with both UBSan/ASan enabled. We build with
`quick-validate` instead of `validate` since the extra
assertion/linting is already provided by other jobs anyway and it's
better to reserve the CI time budget for UBSan/ASan overhead.
- - - - -
b403daa5 by Cheng Shao at 2025-12-31T00:42:26+01:00
rts: add ASAN instrumentation to mblock allocator
- - - - -
ab8980aa by Cheng Shao at 2025-12-31T00:42:26+01:00
rts: add ASAN instrumentation to mgroup allocator
- - - - -
02c6adb7 by Cheng Shao at 2025-12-31T00:42:27+01:00
rts: add ASAN instrumentation to block allocator
- - - - -
cfb18774 by Cheng Shao at 2025-12-31T00:42:27+01:00
rts: add ASAN instrumentation to cap->pinned_object_empty
- - - - -
85b30265 by Cheng Shao at 2025-12-31T00:42:27+01:00
rts: add ASAN instrumentation to gc_thread->free_blocks
- - - - -
307d8096 by Cheng Shao at 2025-12-31T00:42:27+01:00
rts: add ASAN instrumentation to hash table free list
- - - - -
7ee92c62 by Cheng Shao at 2025-12-31T00:42:27+01:00
rts: add ASAN instrumentation to per-Task InCall free list
- - - - -
18 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- hadrian/doc/flavours.md
- hadrian/src/Flavour.hs
- rts/Hash.c
- rts/Task.c
- rts/include/Stg.h
- + rts/include/rts/ASANUtils.h
- rts/rts.cabal
- rts/sm/BlockAlloc.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/Storage.c
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/rts/T18623/all.T
- testsuite/tests/rts/all.T
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -162,6 +162,7 @@ data BuildConfig
, tablesNextToCode :: Bool
, threadSanitiser :: Bool
, ubsan :: Bool
+ , asan :: Bool
, noSplitSections :: Bool
, validateNonmovingGc :: Bool
, textWithSIMDUTF :: Bool
@@ -173,7 +174,7 @@ configureArgsStr :: BuildConfig -> String
configureArgsStr bc = unwords $
["--enable-unregisterised"| unregisterised bc ]
++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ]
- ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ]
+ ++ ["--with-intree-gmp" | isJust (crossTarget bc) || ubsan bc || asan bc ]
++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ]
++ ["--enable-ipe-data-compression" | withZstd bc ]
++ ["--enable-strict-ghc-toolchain-check"]
@@ -188,6 +189,7 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts
[HostFullyStatic | hostFullyStatic] ++
[ThreadSanitiser | threadSanitiser] ++
[UBSan | ubsan] ++
+ [ASan | asan] ++
[NoSplitSections | noSplitSections, buildFlavour == Release ] ++
[BootNonmovingGc | validateNonmovingGc ] ++
[TextWithSIMDUTF | textWithSIMDUTF]
@@ -201,11 +203,12 @@ data FlavourTrans =
| HostFullyStatic
| ThreadSanitiser
| UBSan
+ | ASan
| NoSplitSections
| BootNonmovingGc
| TextWithSIMDUTF
-data BaseFlavour = Release | Validate | SlowValidate deriving Eq
+data BaseFlavour = Release | QuickValidate | Validate | SlowValidate deriving Eq
-----------------------------------------------------------------------------
-- Build Configurations
@@ -230,6 +233,7 @@ vanilla = BuildConfig
, tablesNextToCode = True
, threadSanitiser = False
, ubsan = False
+ , asan = False
, noSplitSections = False
, validateNonmovingGc = False
, textWithSIMDUTF = False
@@ -283,8 +287,14 @@ llvm = vanilla { llvmBootstrap = True }
tsan :: BuildConfig
tsan = vanilla { threadSanitiser = True }
-enableUBSan :: BuildConfig
-enableUBSan = vanilla { withDwarf = True, ubsan = True }
+enableUBSanASan :: BuildConfig
+enableUBSanASan =
+ vanilla
+ { buildFlavour = QuickValidate,
+ withDwarf = True,
+ ubsan = True,
+ asan = True
+ }
noTntc :: BuildConfig
noTntc = vanilla { tablesNextToCode = False }
@@ -372,6 +382,7 @@ flavourString :: Flavour -> String
flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans
where
base_string Release = "release"
+ base_string QuickValidate = "quick-validate"
base_string Validate = "validate"
base_string SlowValidate = "slow-validate"
@@ -381,6 +392,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f
flavour_string HostFullyStatic = "host_fully_static"
flavour_string ThreadSanitiser = "thread_sanitizer_cmm"
flavour_string UBSan = "ubsan"
+ flavour_string ASan = "asan"
flavour_string NoSplitSections = "no_split_sections"
flavour_string BootNonmovingGc = "boot_nonmoving_gc"
flavour_string TextWithSIMDUTF = "text_simdutf"
@@ -1213,15 +1225,24 @@ fedora_x86 =
, hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) releaseConfig))
, disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) dwarf)
, disableValidate (standardBuilds Amd64 (Linux Fedora43))
- -- For UBSan jobs, only enable for validate/nightly pipelines.
- -- Also disable docs since it's not the point for UBSan jobs.
+ -- For UBSan/ASan jobs, only enable for validate/nightly
+ -- pipelines. Also disable docs since it's not the point for
+ -- UBSan/ASan jobs.
+ --
+ -- See
+ -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/compiler-rt/lib/sa…
+ -- for ASAN options help, for now these are required to pass the
+ -- testsuite
, modifyJobs
( setVariable "HADRIAN_ARGS" "--docs=none"
. addVariable
"UBSAN_OPTIONS"
"suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
+ . addVariable
+ "ASAN_OPTIONS"
+ "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false"
)
- $ validateBuilds Amd64 (Linux Fedora43) enableUBSan
+ $ validateBuilds Amd64 (Linux Fedora43) enableUBSanASan
]
where
hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
=====================================
.gitlab/jobs.yaml
=====================================
@@ -2942,7 +2942,7 @@
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-release": {
+ "nightly-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -2953,7 +2953,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-release.tar.xz",
+ "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -2995,17 +2995,20 @@
"x86_64-linux"
],
"variables": {
+ "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "BUILD_FLAVOUR": "quick-validate+debug_info+ubsan+asan",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-release",
+ "TEST_ENV": "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-release-hackage": {
+ "nightly-x86_64-linux-fedora43-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3062,14 +3065,13 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "x86_64-linux-fedora43-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate": {
+ "nightly-x86_64-linux-fedora43-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3080,7 +3082,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate.tar.xz",
+ "ghc-x86_64-linux-fedora43-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3123,16 +3125,17 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
+ "BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate",
+ "TEST_ENV": "x86_64-linux-fedora43-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate+debug_info": {
+ "nightly-x86_64-linux-fedora43-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3143,7 +3146,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3186,16 +3189,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info",
+ "TEST_ENV": "x86_64-linux-fedora43-validate",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate+debug_info+ubsan": {
+ "nightly-x86_64-linux-fedora43-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3206,7 +3209,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3249,14 +3252,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
- "BUILD_FLAVOUR": "validate+debug_info+ubsan",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
- "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
+ "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info",
"XZ_OPT": "-9"
}
},
@@ -7097,7 +7098,7 @@
"TEST_ENV": "x86_64-linux-deb9-validate"
}
},
- "x86_64-linux-fedora43-release": {
+ "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7108,7 +7109,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-release.tar.xz",
+ "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7134,7 +7135,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-quick-validate\\+debug_info\\+ubsan\\+asan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7150,16 +7151,19 @@
"x86_64-linux"
],
"variables": {
+ "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "BUILD_FLAVOUR": "quick-validate+debug_info+ubsan+asan",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-release"
+ "TEST_ENV": "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
}
},
- "x86_64-linux-fedora43-release-hackage": {
+ "x86_64-linux-fedora43-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7196,7 +7200,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7216,13 +7220,12 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "x86_64-linux-fedora43-release"
}
},
- "x86_64-linux-fedora43-validate": {
+ "x86_64-linux-fedora43-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7233,7 +7236,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate.tar.xz",
+ "ghc-x86_64-linux-fedora43-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7259,7 +7262,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7276,15 +7279,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
+ "BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate"
+ "TEST_ENV": "x86_64-linux-fedora43-release"
}
},
- "x86_64-linux-fedora43-validate+debug_info": {
+ "x86_64-linux-fedora43-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7295,7 +7299,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7321,7 +7325,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7338,15 +7342,15 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
+ "TEST_ENV": "x86_64-linux-fedora43-validate"
}
},
- "x86_64-linux-fedora43-validate+debug_info+ubsan": {
+ "x86_64-linux-fedora43-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7357,7 +7361,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7383,7 +7387,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info\\+ubsan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7400,14 +7404,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
- "BUILD_FLAVOUR": "validate+debug_info+ubsan",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
- "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
+ "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
}
},
"x86_64-linux-rocky8-validate": {
=====================================
hadrian/doc/flavours.md
=====================================
@@ -242,6 +242,10 @@ The supported transformers are listed below:
<td><code>ubsan</code></td>
<td>Build all stage1+ C/C++ code with UndefinedBehaviorSanitizer support</td>
</tr>
+ <tr>
+ <td><code>asan</code></td>
+ <td>Build all stage1+ C/C++ code with AddressSanitizer support</td>
+ </tr>
<tr>
<td><code>llvm</code></td>
<td>Use GHC's LLVM backend (`-fllvm`) for all stage1+ compilation.</td>
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -8,6 +8,7 @@ module Flavour
, splitSections
, enableThreadSanitizer
, enableUBSan
+ , enableASan
, enableLateCCS
, enableHashUnitIds
, enableDebugInfo, enableTickyGhc
@@ -57,6 +58,7 @@ flavourTransformers = M.fromList
, "thread_sanitizer" =: enableThreadSanitizer False
, "thread_sanitizer_cmm" =: enableThreadSanitizer True
, "ubsan" =: enableUBSan
+ , "asan" =: enableASan
, "llvm" =: viaLlvmBackend
, "profiled_ghc" =: enableProfiledGhc
, "no_dynamic_ghc" =: disableDynamicGhcPrograms
@@ -306,6 +308,37 @@ enableUBSan =
builder Testsuite ? arg "--config=have_ubsan=True"
]
+-- | Build all stage1+ C/C++ code with AddressSanitizer support:
+-- https://clang.llvm.org/docs/AddressSanitizer.html
+enableASan :: Flavour -> Flavour
+enableASan =
+ addArgs $
+ notStage0
+ ? mconcat
+ [ package rts
+ ? builder (Cabal Flags)
+ ? arg "+asan"
+ <> (needSharedLibSAN ? arg "+shared-libsan"),
+ builder (Ghc CompileHs) ? arg "-optc-fno-omit-frame-pointer"
+ <> arg
+ "-optc-fsanitize=address",
+ builder (Ghc CompileCWithGhc) ? arg "-optc-fno-omit-frame-pointer"
+ <> arg
+ "-optc-fsanitize=address",
+ builder (Ghc CompileCppWithGhc)
+ ? arg "-optcxx-fno-omit-frame-pointer"
+ <> arg "-optcxx-fsanitize=address",
+ builder (Ghc LinkHs)
+ ? arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address"
+ <> arg "-optl-fsanitize=address"
+ <> (needSharedLibSAN ? arg "-optl-shared-libsan"),
+ builder (Cc CompileC) ? arg "-fno-omit-frame-pointer"
+ <> arg
+ "-fsanitize=address",
+ builder Testsuite ? arg "--config=have_asan=True"
+ ]
+
-- | Use the LLVM backend in stages 1 and later.
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
=====================================
rts/Hash.c
=====================================
@@ -283,6 +283,7 @@ allocHashList (HashTable *table)
if (table->freeList != NULL) {
HashList *hl = table->freeList;
table->freeList = hl->next;
+ __ghc_asan_unpoison_memory_region(hl, offsetof(HashList, next));
return hl;
} else {
/* We allocate one block of memory which contains:
@@ -302,8 +303,11 @@ allocHashList (HashTable *table)
table->freeList = hl + 1;
HashList *p = table->freeList;
- for (; p < hl + HCHUNK - 1; p++)
+ for (; p < hl + HCHUNK - 1; p++) {
+ __ghc_asan_poison_memory_region(p, offsetof(HashList, next));
p->next = p + 1;
+ }
+ __ghc_asan_poison_memory_region(p, offsetof(HashList, next));
p->next = NULL;
return hl;
}
@@ -318,6 +322,7 @@ freeHashList (HashTable *table, HashList *hl)
// HashListChunks.
hl->next = table->freeList;
table->freeList = hl;
+ __ghc_asan_poison_memory_region(hl, offsetof(HashList, next));
}
STATIC_INLINE void
@@ -388,9 +393,10 @@ removeHashTable_inlined(HashTable *table, StgWord key, const void *data,
table->dir[segment][index] = hl->next;
else
prev->next = hl->next;
+ void *hl_data = (void*)hl->data;
freeHashList(table,hl);
table->kcount--;
- return (void *) hl->data;
+ return hl_data;
}
prev = hl;
}
=====================================
rts/Task.c
=====================================
@@ -183,6 +183,7 @@ freeTask (Task *task)
stgFree(incall);
}
for (incall = task->spare_incalls; incall != NULL; incall = next) {
+ __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
next = incall->next;
stgFree(incall);
}
@@ -252,6 +253,7 @@ newInCall (Task *task)
if (task->spare_incalls != NULL) {
incall = task->spare_incalls;
+ __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
task->spare_incalls = incall->next;
task->n_spare_incalls--;
} else {
@@ -283,6 +285,7 @@ endInCall (Task *task)
stgFree(incall);
} else {
incall->next = task->spare_incalls;
+ __ghc_asan_poison_memory_region(incall, sizeof(InCall));
task->spare_incalls = incall;
task->n_spare_incalls++;
}
=====================================
rts/include/Stg.h
=====================================
@@ -335,6 +335,7 @@ external prototype return neither of these types to workaround #11395.
#include "stg/MachRegsForHost.h"
#include "stg/Regs.h"
#include "stg/Ticky.h"
+#include "rts/ASANUtils.h"
#include "rts/TSANUtils.h"
#if IN_STG_CODE
=====================================
rts/include/rts/ASANUtils.h
=====================================
@@ -0,0 +1,33 @@
+#pragma once
+
+#if defined(__SANITIZE_ADDRESS__)
+#define ASAN_ENABLED
+#elif defined(__has_feature)
+#if __has_feature(address_sanitizer)
+#define ASAN_ENABLED
+#endif
+#endif
+
+#if defined(ASAN_ENABLED)
+#include <sanitizer/asan_interface.h>
+#define USED_IF_ASAN
+#else
+#include <stdlib.h>
+#define USED_IF_ASAN __attribute__((unused))
+#endif
+
+static inline void
+__ghc_asan_poison_memory_region(void const volatile *addr USED_IF_ASAN,
+ size_t size USED_IF_ASAN) {
+#if defined(ASAN_ENABLED)
+ __asan_poison_memory_region(addr, size);
+#endif
+}
+
+static inline void
+__ghc_asan_unpoison_memory_region(void const volatile *addr USED_IF_ASAN,
+ size_t size USED_IF_ASAN) {
+#if defined(ASAN_ENABLED)
+ __asan_unpoison_memory_region(addr, size);
+#endif
+}
=====================================
rts/rts.cabal
=====================================
@@ -97,6 +97,12 @@ flag ubsan
UndefinedBehaviorSanitizer.
default: False
manual: True
+flag asan
+ description:
+ Link with -fsanitize=address, to be enabled when building with
+ AddressSanitizer.
+ default: False
+ manual: True
flag shared-libsan
description:
Link with -shared-libsan, to guarantee only one copy of the
@@ -216,6 +222,9 @@ library
if flag(ubsan)
ld-options: -fsanitize=undefined
+ if flag(asan)
+ ld-options: -fsanitize=address
+
if flag(shared-libsan)
ld-options: -shared-libsan
@@ -280,6 +289,7 @@ library
-- ^ generated
rts/ghc_ffi.h
rts/Adjustor.h
+ rts/ASANUtils.h
rts/ExecPage.h
rts/BlockSignals.h
rts/Bytecodes.h
=====================================
rts/sm/BlockAlloc.c
=====================================
@@ -261,6 +261,8 @@ initGroup(bdescr *head)
head[i].flags = 0;
}
#endif
+
+ __ghc_asan_unpoison_memory_region(head->start, (W_)head->blocks * BLOCK_SIZE);
}
#if SIZEOF_VOID_P == SIZEOF_LONG
@@ -474,6 +476,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
bd = alloc_mega_group_from_free_list(&deferred_free_mblock_list[node], n, &best);
if(bd)
{
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
return bd;
}
else if(!best)
@@ -490,6 +493,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
if (bd)
{
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
return bd;
}
else if (best)
@@ -500,6 +504,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
(best_mblocks-mblocks)*MBLOCK_SIZE);
best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
+ __ghc_asan_unpoison_memory_region(MBLOCK_ROUND_DOWN(bd), mblocks * MBLOCK_SIZE);
initMBlock(MBLOCK_ROUND_DOWN(bd), node);
}
else
@@ -878,6 +883,8 @@ free_mega_group (bdescr *mg)
IF_DEBUG(sanity, checkFreeListSanity());
}
+
+ __ghc_asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
}
static void
@@ -925,6 +932,8 @@ free_deferred_mega_groups (uint32_t node)
// coalesce forwards
coalesce_mblocks(mg);
+ __ghc_asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
+
// initialize search for next round
prev = mg;
bd = prev->link;
@@ -1045,6 +1054,8 @@ freeGroup(bdescr *p)
setup_tail(p);
free_list_insert(node,p);
+ __ghc_asan_poison_memory_region(p->start, (W_)p->blocks * BLOCK_SIZE);
+
IF_DEBUG(sanity, checkFreeListSanity());
}
=====================================
rts/sm/GCUtils.c
=====================================
@@ -348,6 +348,7 @@ alloc_todo_block (gen_workspace *ws, uint32_t size)
} else {
if (gct->free_blocks) {
bd = gct->free_blocks;
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
gct->free_blocks = bd->link;
} else {
// We allocate in chunks of at most 16 blocks, use one
@@ -357,6 +358,9 @@ alloc_todo_block (gen_workspace *ws, uint32_t size)
StgWord n_blocks = stg_min(chunk_size, 1 << (MBLOCK_SHIFT - BLOCK_SHIFT - 1));
allocBlocks_sync(n_blocks, &bd);
gct->free_blocks = bd->link;
+ for (bdescr *bd = gct->free_blocks; bd; bd = bd->link) {
+ __ghc_asan_poison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
+ }
}
}
initBdescr(bd, ws->gen, ws->gen->to);
=====================================
rts/sm/MBlock.c
=====================================
@@ -579,6 +579,8 @@ getMBlocks(uint32_t n)
ret = getCommittedMBlocks(n);
+ __ghc_asan_unpoison_memory_region(ret, (W_)n * MBLOCK_SIZE);
+
debugTrace(DEBUG_gc, "allocated %d megablock(s) at %p",n,ret);
mblocks_allocated += n;
@@ -611,6 +613,8 @@ freeMBlocks(void *addr, uint32_t n)
mblocks_allocated -= n;
+ __ghc_asan_poison_memory_region(addr, (W_)n * MBLOCK_SIZE);
+
decommitMBlocks(addr, n);
}
=====================================
rts/sm/Storage.c
=====================================
@@ -1242,6 +1242,10 @@ start_new_pinned_block(Capability *cap)
ACQUIRE_SM_LOCK;
bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE);
RELEASE_SM_LOCK;
+
+ for (bdescr *pbd = bd; pbd; pbd = pbd->link) {
+ __ghc_asan_poison_memory_region(pbd->start, (W_)pbd->blocks * BLOCK_SIZE);
+ }
}
// Bump up the nursery pointer to avoid the pathological situation
@@ -1267,6 +1271,7 @@ start_new_pinned_block(Capability *cap)
}
cap->pinned_object_empty = bd->link;
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
newNurseryBlock(bd);
if (bd->link != NULL) {
bd->link->u.back = cap->pinned_object_empty;
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -189,6 +189,9 @@ class TestConfig:
# Are we running with UndefinedBehaviorSanitizer enabled?
self.have_ubsan = False
+ # Are we running with AddressSanitizer enabled?
+ self.have_asan = False
+
# Do symbols use leading underscores?
self.leading_underscore = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1093,6 +1093,9 @@ def have_thread_sanitizer( ) -> bool:
def have_ubsan( ) -> bool:
return config.have_ubsan
+def have_asan( ) -> bool:
+ return config.have_asan
+
def gcc_as_cmmp() -> bool:
return config.cmm_cpp_is_gcc
=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -192,6 +192,9 @@ test('rts_clearMemory', [
extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc', 'sanity']),
# On windows, nonmoving way fails with bad exit code (2816)
when(opsys('mingw32'), fragile(23091)),
+ # For simplicity, ASAN poisoning/unpoisoning logic is omitted
+ # from rts_clearMemory implementation
+ when(have_asan(), skip),
req_c,
pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ],
# Same hack as ffi023
=====================================
testsuite/tests/rts/T18623/all.T
=====================================
@@ -8,6 +8,8 @@ test('T18623',
# Recent versions of osx report an error when running `ulimit -v`
when(opsys('darwin'), skip),
when(arch('powerpc64le'), skip),
+ # ASan can't allocate shadow memory
+ when(have_asan(), skip),
cmd_prefix('ulimit -v ' + str(8 * 1024 ** 2) + ' && '),
ignore_stdout],
run_command,
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -105,6 +105,8 @@ def remove_parenthesis(s):
return re.sub(r'\s+\([^)]*\)', '', s)
test('outofmem', [ when(opsys('darwin'), skip),
+ # ASan shadow memory allocation blows up
+ when(have_asan(), skip),
# this is believed to cause other processes to die
# that happen concurrently while the outofmem test
# runs in CI. As such we'll need to disable it on
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b0e4a52056d8e3f9a99b6c426b424…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b0e4a52056d8e3f9a99b6c426b424…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26682] Fix scoping errors in specialisation
by Simon Peyton Jones (＠simonpj) 31 Dec '25
by Simon Peyton Jones (＠simonpj) 31 Dec '25
31 Dec '25
Simon Peyton Jones pushed to branch wip/T26682 at Glasgow Haskell Compiler / GHC
Commits:
57219df7 by Simon Peyton Jones at 2025-12-30T23:25:49+00:00
Fix scoping errors in specialisation
Using -fspecialise-aggressively in #26682 showed up a couple of
subtle errors in the type-class specialiser.
* dumpBindUDs failed to call `deleteCallsMentioning`, resulting in a
call that mentioned a dictionary that was not in scope. This call
has been missing since 2009!
commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe
Author: Simon Peyton Jones <simonpj(a)microsoft.com>
Date: Fri Oct 23 16:15:51 2009 +0000
Fixed by re-combining `dumpBindUDs` and `dumpUDs`.
* I think there was another bug involving the quantified type
variables in polymorphic specialisation. In any case I refactored
`specHeader` and `spec_call` so that the former looks for the
extra quantified type variables rather than the latter. This
is quite a worthwhile simplification: less code, easier to grok.
Test case in simplCore/should_compile/T26682,
brilliantly minimised by @sheaf.
- - - - -
4 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- + testsuite/tests/simplCore/should_compile/T26682.hs
- + testsuite/tests/simplCore/should_compile/T26682a.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -654,9 +654,7 @@ specProgram guts@(ModGuts { mg_module = this_mod
-- Easiest thing is to do it all at once, as if all the top-level
-- decls were mutually recursive
; let top_env = SE { se_subst = Core.mkEmptySubst $
- mkInScopeSetBndrs binds
- -- mkInScopeSetList $
- -- bindersOfBinds binds
+ mkInScopeSetBndrs binds
, se_module = this_mod
, se_rules = rule_env
, se_dflags = dflags }
@@ -816,9 +814,12 @@ spec_imports env callers dict_binds calls
go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind])
go env [] = return (env, [], [])
go env (cis : other_calls)
- = do { -- debugTraceMsg (text "specImport {" <+> ppr cis)
+ = do {
+-- debugTraceMsg (text "specImport {" <+> vcat [ ppr cis
+-- , text "callers" <+> ppr callers
+-- , text "dict_binds" <+> ppr dict_binds ])
; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis
- ; -- debugTraceMsg (text "specImport }" <+> ppr cis)
+-- ; debugTraceMsg (text "specImport }" <+> ppr cis)
; (env, rules2, spec_binds2) <- go env other_calls
; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) }
@@ -835,13 +836,18 @@ spec_import :: SpecEnv -- Passed in so that all top-level Ids are
, [CoreBind] ) -- Specialised bindings
spec_import env callers dict_binds cis@(CIS fn _)
| isIn "specImport" fn callers
- = return (env, [], []) -- No warning. This actually happens all the time
- -- when specialising a recursive function, because
- -- the RHS of the specialised function contains a recursive
- -- call to the original function
+ = do {
+-- debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers))
+ ; return (env, [], []) }
+ -- No warning. This actually happens all the time
+ -- when specialising a recursive function, because
+ -- the RHS of the specialised function contains a recursive
+ -- call to the original function
| null good_calls
- = return (env, [], [])
+ = do {
+-- debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds))
+ ; return (env, [], []) }
| Just rhs <- canSpecImport dflags fn
= do { -- Get rules from the external package state
@@ -890,7 +896,10 @@ spec_import env callers dict_binds cis@(CIS fn _)
; return (env, rules2 ++ rules1, final_binds) }
| otherwise
- = do { tryWarnMissingSpecs dflags callers fn good_calls
+ = do {
+-- debugTraceMsg (hang (text "specImport1-missed")
+-- 2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)]))
+ ; tryWarnMissingSpecs dflags callers fn good_calls
; return (env, [], [])}
where
@@ -1455,7 +1464,9 @@ specBind top_lvl env (NonRec fn rhs) do_body
; (fn4, spec_defns, body_uds1) <- specDefn env body_uds fn3 rhs
- ; let (free_uds, dump_dbs, float_all) = dumpBindUDs [fn4] body_uds1
+ ; let can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
+ -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
+ (free_uds, dump_dbs, float_all) = dumpBindUDs can_float_this_one [fn4] body_uds1
all_free_uds = free_uds `thenUDs` rhs_uds
pairs = spec_defns ++ [(fn4, rhs')]
@@ -1471,10 +1482,8 @@ specBind top_lvl env (NonRec fn rhs) do_body
= [mkDB $ NonRec b r | (b,r) <- pairs]
++ fromOL dump_dbs
- can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
- -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
- ; if float_all && can_float_this_one then
+ ; if float_all then
-- Rather than discard the calls mentioning the bound variables
-- we float this (dictionary) binding along with the others
return ([], body', all_free_uds `snocDictBinds` final_binds)
@@ -1509,7 +1518,7 @@ specBind top_lvl env (Rec pairs) do_body
<- specDefns rec_env uds2 (bndrs2 `zip` rhss)
; return (bndrs3, spec_defns3 ++ spec_defns2, uds3) }
- ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs1 uds3
+ ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs True bndrs1 uds3
final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss')
dumped_dbs
@@ -1630,7 +1639,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
dflags = se_dflags env
this_mod = se_module env
subst = se_subst env
- in_scope = Core.substInScopeSet subst
-- Figure out whether the function has an INLINE pragma
-- See Note [Inline specialisations]
@@ -1646,9 +1654,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
| otherwise
= inl_prag
- not_in_scope :: InterestingVarFun
- not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope)
-
----------------------------------------------------------
-- Specialise to one particular call pattern
spec_call :: SpecInfo -- Accumulating parameter
@@ -1662,47 +1667,34 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType
| otherwise = UnspecArg
- -- Find qvars, the type variables to add to the binders for the rule
- -- Namely those free in `ty` that aren't in scope
- -- See (MP2) in Note [Specialising polymorphic dictionaries]
- ; let poly_qvars = scopedSort $ fvVarList $ specArgsFVs not_in_scope call_args
- subst' = subst `Core.extendSubstInScopeList` poly_qvars
- -- Maybe we should clone the poly_qvars telescope?
-
- -- Any free Ids will have caused the call to be dropped
- ; massertPpr (all isTyCoVar poly_qvars)
- (ppr fn $$ ppr all_call_args $$ ppr poly_qvars)
-
- ; (useful, subst'', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
- <- specHeader subst' rhs_bndrs all_call_args
- ; let all_rule_bndrs = poly_qvars ++ rule_bndrs
- env' = env { se_subst = subst'' }
+ ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
+ <- specHeader subst rhs_bndrs all_call_args
+ ; let env' = env { se_subst = subst' }
-- Check for (a) usefulness and (b) not already covered
-- See (SC1) in Note [Specialisations already covered]
; let all_rules = rules_acc ++ existing_rules
-- all_rules: we look both in the rules_acc (generated by this invocation
-- of specCalls), and in existing_rules (passed in to specCalls)
- already_covered = alreadyCovered env' all_rule_bndrs fn
+ already_covered = alreadyCovered env' rule_bndrs fn
rule_lhs_args is_active all_rules
-{- ; pprTrace "spec_call" (vcat
- [ text "fun: " <+> ppr fn
- , text "call info: " <+> ppr _ci
- , text "useful: " <+> ppr useful
- , text "already_covered:" <+> ppr already_covered
- , text "poly_qvars: " <+> ppr poly_qvars
- , text "useful: " <+> ppr useful
- , text "all_rule_bndrs:" <+> ppr all_rule_bndrs
- , text "rule_lhs_args:" <+> ppr rule_lhs_args
- , text "spec_bndrs:" <+> ppr spec_bndrs
- , text "dx_binds:" <+> ppr dx_binds
- , text "spec_args: " <+> ppr spec_args
- , text "rhs_bndrs" <+> ppr rhs_bndrs
- , text "rhs_body" <+> ppr rhs_body
- , text "subst''" <+> ppr subst'' ]) $
- return ()
--}
+-- ; pprTrace "spec_call" (vcat
+-- [ text "fun: " <+> ppr fn
+-- , text "call info: " <+> ppr _ci
+-- , text "useful: " <+> ppr useful
+-- , text "already_covered:" <+> ppr already_covered
+-- , text "useful: " <+> ppr useful
+-- , text "rule_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) rule_bndrs))
+-- , text "rule_lhs_args:" <+> ppr rule_lhs_args
+-- , text "spec_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) spec_bndrs))
+-- , text "dx_binds:" <+> ppr dx_binds
+-- , text "spec_args: " <+> ppr spec_args
+-- , text "rhs_bndrs" <+> ppr (sep (map (pprBndr LambdaBind) rhs_bndrs))
+-- , text "rhs_body" <+> ppr rhs_body
+-- , text "subst'" <+> ppr subst'
+-- ]) $ return ()
+
; if not useful -- No useful specialisation
|| already_covered -- Useful, but done already
@@ -1716,23 +1708,15 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- Run the specialiser on the specialised RHS
; (rhs_body', rhs_uds) <- specExpr env'' rhs_body
-{- ; pprTrace "spec_call2" (vcat
- [ text "fun:" <+> ppr fn
- , text "rhs_body':" <+> ppr rhs_body' ]) $
- return ()
--}
-
-- Make the RHS of the specialised function
; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs'
- (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds
- (rhs_uds2, outer_dumped_dbs) = dumpUDs poly_qvars (dx_binds `consDictBinds` rhs_uds1)
- -- dx_binds comes from the arguments to the call, and so can mention
- -- poly_qvars but no other local binders
- spec_rhs = mkLams poly_qvars $
- wrapDictBindsE outer_dumped_dbs $
- mkLams spec_rhs_bndrs $
+ (rhs_uds2, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs $
+ dx_binds `consDictBinds` rhs_uds
+ -- dx_binds comes from the arguments to the call,
+ -- and so can mention poly_qvars but no other local binders
+ spec_rhs = mkLams spec_rhs_bndrs $
wrapDictBindsE inner_dumped_dbs rhs_body'
- rule_rhs_args = poly_qvars ++ spec_bndrs
+ rule_rhs_args = spec_bndrs
-- Maybe add a void arg to the specialised function,
-- to avoid unlifted bindings
@@ -1787,7 +1771,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
text "SPEC"
spec_rule = mkSpecRule dflags this_mod True inl_act
- herald fn all_rule_bndrs rule_lhs_args
+ herald fn rule_bndrs rule_lhs_args
(mkVarApps (Var spec_fn) rule_rhs_args1)
_rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type
@@ -1798,8 +1782,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
, text "existing" <+> ppr existing_rules
]
- ; -- pprTrace "spec_call: rule" _rule_trace_doc
- return ( spec_rule : rules_acc
+-- ; pprTrace "spec_call: rule" (vcat [ -- text "poly_qvars" <+> ppr poly_qvars
+-- text "rule_bndrs" <+> ppr rule_bndrs
+-- , text "rule_lhs_args" <+> ppr rule_lhs_args
+-- , text "all_call_args" <+> ppr all_call_args
+-- , ppr spec_rule ]) $
+ ; return ( spec_rule : rules_acc
, (spec_fn, spec_rhs1) : pairs_acc
, rhs_uds2 `thenUDs` uds_acc
) } }
@@ -1946,6 +1934,16 @@ floating to top level anyway; but that is hard to spot (since we don't know what
the non-top-level in-scope binders are) and rare (since the binding must satisfy
Note [Core let-can-float invariant] in GHC.Core).
+Arguably we'd be better off if we had left that `x` in the RHS of `n`, thus
+ f x = let n::Natural = let x::ByteArray# = <some literal> in
+ NB x
+ in wombat @192827 (n |> co)
+Now we could float `n` happily. But that's in conflict with exposing the `NB`
+data constructor in the body of the `let`, so I'm leaving this unresolved.
+
+Another case came up in #26682, where the binding had an unlifted sum type
+(# Word# | ByteArray# #), itself arising from an UNPACK pragma. Test case
+T26682.
Note [Specialising Calls]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2593,12 +2591,22 @@ specHeader subst _ [] = pure (False, subst, [], [], [], [], [])
-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding
-- details.
specHeader subst (bndr:bndrs) (SpecType ty : args)
- = do { let subst1 = Core.extendTvSubst subst bndr ty
- ; (useful, subst2, rule_bs, rule_args, spec_bs, dx, spec_args)
- <- specHeader subst1 bndrs args
- ; pure ( useful, subst2
- , rule_bs, Type ty : rule_args
- , spec_bs, dx, Type ty : spec_args ) }
+ = do { -- Find free_tvs, the type variables to add to the binders for the rule
+ -- Namely those free in `ty` that aren't in scope
+ -- See (MP2) in Note [Specialising polymorphic dictionaries]
+ let in_scope = Core.substInScopeSet subst
+ not_in_scope tv = not (tv `elemInScopeSet` in_scope)
+ free_tvs = scopedSort $ fvVarList $
+ filterFV not_in_scope $
+ tyCoFVsOfType ty
+ subst1 = subst `Core.extendSubstInScopeList` free_tvs
+
+ ; let subst2 = Core.extendTvSubst subst1 bndr ty
+ ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args)
+ <- specHeader subst2 bndrs args
+ ; pure ( useful, subst3
+ , free_tvs ++ rule_bs, Type ty : rule_args
+ , free_tvs ++ spec_bs, dx, Type ty : spec_args ) }
-- Next we have a type that we don't want to specialise. We need to perform
-- a substitution on it (in case the type refers to 'a'). Additionally, we need
@@ -2682,7 +2690,7 @@ bindAuxiliaryDict subst orig_dict_id fresh_dict_id dict_arg
-- don’t bother creating a new dict binding; just substitute
| exprIsTrivial dict_arg
, let subst' = Core.extendSubst subst orig_dict_id dict_arg
- = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_id) $
+ = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_arg) $
(subst', Nothing, dict_arg)
| otherwise -- Non-trivial dictionary arg; make an auxiliary binding
@@ -2978,7 +2986,8 @@ pprCallInfo fn (CI { ci_key = key })
instance Outputable CallInfo where
ppr (CI { ci_key = key, ci_fvs = _fvs })
- = text "CI" <> braces (sep (map ppr key))
+ = text "CI" <> braces (text "fvs" <+> ppr _fvs
+ $$ sep (map ppr key))
unionCalls :: CallDetails -> CallDetails -> CallDetails
unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2
@@ -3394,38 +3403,49 @@ wrapDictBindsE dbs expr
----------------------
dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind)
--- Used at a lambda or case binder; just dump anything mentioning the binder
+-- Used at binder; just dump anything mentioning the binder
dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
| null bndrs = (uds, nilOL) -- Common in case alternatives
| otherwise = -- pprTrace "dumpUDs" (vcat
- -- [ text "bndrs" <+> ppr bndrs
- -- , text "uds" <+> ppr uds
- -- , text "free_uds" <+> ppr free_uds
- -- , text "dump-dbs" <+> ppr dump_dbs ]) $
+ -- [ text "bndrs" <+> ppr bndrs
+ -- , text "uds" <+> ppr uds
+ -- , text "free_uds" <+> ppr free_uds
+ -- , text "dump_dbs" <+> ppr dump_dbs ]) $
(free_uds, dump_dbs)
where
free_uds = uds { ud_binds = free_dbs, ud_calls = free_calls }
bndr_set = mkVarSet bndrs
(free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
- free_calls = deleteCallsMentioning dump_set $ -- Drop calls mentioning bndr_set on the floor
- deleteCallsFor bndrs orig_calls -- Discard calls for bndr_set; there should be
- -- no calls for any of the dicts in dump_dbs
-dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind, Bool)
+ -- Delete calls:
+ -- * For any binder in `bndrs`
+ -- * That mention a dictionary bound in `dump_set`
+ -- These variables aren't in scope "above" the binding and the `dump_dbs`,
+ -- so no call should mention them. (See #26682.)
+ free_calls = deleteCallsMentioning dump_set $
+ deleteCallsFor bndrs orig_calls
+
+dumpBindUDs :: Bool -- Main binding can float to top
+ -> [CoreBndr] -> UsageDetails
+ -> (UsageDetails, OrdList DictBind, Bool)
-- Used at a let(rec) binding.
--- We return a boolean indicating whether the binding itself is mentioned,
--- directly or indirectly, by any of the ud_calls; in that case we want to
--- float the binding itself;
--- See Note [Floated dictionary bindings]
-dumpBindUDs bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
- = -- pprTrace "dumpBindUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs $$ ppr float_all) $
- (free_uds, dump_dbs, float_all)
+-- We return a boolean indicating whether the binding itself
+-- is mentioned, directly or indirectly, by any of the ud_calls;
+-- in that case we want to float the binding itself.
+-- See Note [Floated dictionary bindings]
+-- If the boolean is True, then the returned ud_calls can mention `bndrs`;
+-- if False, then returned ud_calls must not mention `bndrs`
+dumpBindUDs can_float_bind bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
+ = ( MkUD { ud_binds = free_dbs, ud_calls = free_calls2 }
+ , dump_dbs
+ , can_float_bind && calls_mention_bndrs )
where
- free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls }
bndr_set = mkVarSet bndrs
(free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
- free_calls = deleteCallsFor bndrs orig_calls
- float_all = dump_set `intersectsVarSet` callDetailsFVs free_calls
+ free_calls1 = deleteCallsFor bndrs orig_calls
+ calls_mention_bndrs = dump_set `intersectsVarSet` callDetailsFVs free_calls1
+ free_calls2 | can_float_bind = free_calls1
+ | otherwise = deleteCallsMentioning dump_set free_calls1
callsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo])
callsForMe fn uds@MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }
=====================================
testsuite/tests/simplCore/should_compile/T26682.hs
=====================================
@@ -0,0 +1,105 @@
+{-# LANGUAGE Haskell2010 #-}
+
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -fspecialise-aggressively #-}
+
+-- This is the result of @sheaf's work in minimising
+-- @mikolaj's original bug report for #26682
+
+module T26682 ( tensorADOnceMnistTests2 ) where
+
+import Prelude
+
+import Data.Proxy
+ ( Proxy (Proxy) )
+
+import GHC.TypeNats
+import Data.Kind
+
+import T26682a
+
+
+data Concrete2 x = Concrete2
+
+instance Eq ( Concrete2 a ) where
+ _ == _ = error "no"
+ {-# OPAQUE (==) #-}
+
+type X :: Type -> TK
+type family X a
+
+type instance X (target y) = y
+type instance X (a, b) = TKProduct (X a) (X b)
+type instance X (a, b, c) = TKProduct (TKProduct (X a) (X b)) (X c)
+
+tensorADOnceMnistTests2 :: Int -> Bool
+tensorADOnceMnistTests2 seed0 =
+ withSomeSNat 999 $ \ _ ->
+ let seed1 =
+ randomValue2
+ @(Concrete2 (X (ADFcnnMnist2ParametersShaped Concrete2 101 101 Double Double)))
+ seed0
+ art = mnistTrainBench2VTOGradient3 seed1
+
+ gg :: Concrete2
+ (TKProduct
+ (TKProduct
+ (TKProduct
+ (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double)))
+ (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double))))
+ (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double))))
+ (TKProduct (TKR 1 Double) (TKR 1 Double)))
+ gg = undefined
+ value1 = revInterpretArtifact2 art gg
+ in
+ value1 == value1
+
+mnistTrainBench2VTOGradient3
+ :: Int
+ -> AstArtifactRev2
+ (TKProduct
+ (XParams2 Double Double)
+ (TKProduct (TKR2 1 (TKScalar Double))
+ (TKR2 1 (TKScalar Double))))
+ (TKScalar Double)
+mnistTrainBench2VTOGradient3 !_
+ | Dict0 <- lemTKScalarAllNumAD2 (Proxy @Double)
+ = undefined
+
+type ADFcnnMnist2ParametersShaped
+ (target :: TK -> Type) (widthHidden :: Nat) (widthHidden2 :: Nat) r q =
+ ( ( target (TKS '[widthHidden, 784] r)
+ , target (TKS '[widthHidden] r) )
+ , ( target (TKS '[widthHidden2, widthHidden] q)
+ , target (TKS '[widthHidden2] r) )
+ , ( target (TKS '[10, widthHidden2] r)
+ , target (TKS '[10] r) )
+ )
+
+-- | The differentiable type of all trainable parameters of this nn.
+type ADFcnnMnist2Parameters (target :: TK -> Type) r q =
+ ( ( target (TKR 2 r)
+ , target (TKR 1 r) )
+ , ( target (TKR 2 q)
+ , target (TKR 1 r) )
+ , ( target (TKR 2 r)
+ , target (TKR 1 r) )
+ )
+
+type XParams2 r q = X (ADFcnnMnist2Parameters Concrete2 r q)
+
+data AstArtifactRev2 x z = AstArtifactRev2
+
+revInterpretArtifact2
+ :: AstArtifactRev2 x z
+ -> Concrete2 x
+ -> Concrete2 z
+{-# OPAQUE revInterpretArtifact2 #-}
+revInterpretArtifact2 _ _ = error "no"
=====================================
testsuite/tests/simplCore/should_compile/T26682a.hs
=====================================
@@ -0,0 +1,109 @@
+{-# LANGUAGE Haskell2010 #-}
+
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module T26682a
+ ( TK(..), TKR, TKS, TKX
+ , Dict0(..)
+ , randomValue2
+ , lemTKScalarAllNumAD2
+ ) where
+
+import Prelude
+
+
+import GHC.TypeLits ( KnownNat(..), Nat, SNat )
+import Data.Kind ( Type, Constraint )
+import Data.Typeable ( Typeable )
+import Data.Proxy ( Proxy )
+
+import Type.Reflection
+import Data.Type.Equality
+
+ifDifferentiable2 :: forall r a. Typeable r
+ => (Num r => a) -> a -> a
+{-# INLINE ifDifferentiable2 #-}
+ifDifferentiable2 ra _
+ | Just Refl <- testEquality (typeRep @r) (typeRep @Double) = ra
+ifDifferentiable2 ra _
+ | Just Refl <- testEquality (typeRep @r) (typeRep @Float) = ra
+ifDifferentiable2 _ a = a
+
+data Dict0 c where
+ Dict0 :: c => Dict0 c
+
+type ShS2 :: [Nat] -> Type
+data ShS2 ns where
+ Z :: ShS2 '[]
+ S :: {-# UNPACK #-} !( SNat n ) -> !( ShS2 ns ) -> ShS2 (n ': ns)
+
+type KnownShS2 :: [Nat] -> Constraint
+class KnownShS2 ns where
+ knownShS2 :: ShS2 ns
+
+instance KnownShS2 '[] where
+ knownShS2 = Z
+instance ( KnownNat n, KnownShS2 ns ) => KnownShS2 ( n ': ns ) where
+ knownShS2 =
+ case natSing @n of
+ !i ->
+ case knownShS2 @ns of
+ !j ->
+ S i j
+
+type RandomValue2 :: Type -> Constraint
+class RandomValue2 vals where
+ randomValue2 :: Int -> Int
+
+
+type IsDouble :: Type -> Constraint
+type family IsDouble a where
+ IsDouble Double = ( () :: Constraint )
+
+class ( Typeable r, IsDouble r ) => NumScalar2 r
+instance ( Typeable r, IsDouble r ) => NumScalar2 r
+
+instance forall sh r target. (KnownShS2 sh, NumScalar2 r)
+ => RandomValue2 (target (TKS sh r)) where
+ randomValue2 g =
+ ifDifferentiable2 @r
+ ( case knownShS2 @sh of
+ !_ -> g )
+ g
+
+instance (RandomValue2 (target a), RandomValue2 (target b))
+ => RandomValue2 (target (TKProduct a b)) where
+ randomValue2 g =
+ let g1 = randomValue2 @(target a) g
+ g2 = randomValue2 @(target b) g1
+ in g2
+
+lemTKScalarAllNumAD2 :: Proxy r -> Dict0 ( IsDouble r )
+lemTKScalarAllNumAD2 _ = undefined
+{-# OPAQUE lemTKScalarAllNumAD2 #-}
+
+
+type data TK =
+ TKScalar Type
+ | TKR2 Nat TK
+ | TKS2 [Nat] TK
+ | TKX2 [Maybe Nat] TK
+ | TKProduct TK TK
+
+type TKR n r = TKR2 n (TKScalar r)
+type TKS sh r = TKS2 sh (TKScalar r)
+type TKX sh r = TKX2 sh (TKScalar r)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -563,3 +563,4 @@ test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl -dsuppress-uni
test('T26116', normal, compile, ['-O -ddump-rules'])
test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T26349', normal, compile, ['-O -ddump-rules'])
+test('T26682', normal, multimod_compile, ['T26682', '-O -v0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57219df7a1bad8d247c6a5ebb33fd5a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57219df7a1bad8d247c6a5ebb33fd5a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/terrorjack/asan] 9 commits: hadrian: add support for building with AddressSanitizer
by Cheng Shao (＠TerrorJack) 31 Dec '25
by Cheng Shao (＠TerrorJack) 31 Dec '25
31 Dec '25
Cheng Shao pushed to branch wip/terrorjack/asan at Glasgow Haskell Compiler / GHC
Commits:
665fe978 by Cheng Shao at 2025-12-30T23:55:09+01:00
hadrian: add support for building with AddressSanitizer
This patch adds a +asan flavour transformer to hadrian to build all
stage1+ C/C++ code with AddressBehaviorSanitizer. This is particularly
useful to catch potential out-of-bounds and use-after-free bugs in the
RTS codebase.
- - - - -
8b81e8e6 by Cheng Shao at 2025-12-30T23:55:13+01:00
ci: add ubsan+asan job
We now have a
`x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan`
validate/nightly job with both UBSan/ASan enabled. We build with
`quick-validate` instead of `validate` since the extra
assertion/linting is already provided by other jobs anyway and it's
better to reserve the CI time budget for UBSan/ASan overhead.
- - - - -
c46bff1a by Cheng Shao at 2025-12-30T23:55:13+01:00
rts: add ASAN instrumentation to mblock allocator
- - - - -
24241167 by Cheng Shao at 2025-12-30T23:55:13+01:00
rts: add ASAN instrumentation to mgroup allocator
- - - - -
c0e0d29f by Cheng Shao at 2025-12-30T23:55:13+01:00
rts: add ASAN instrumentation to block allocator
- - - - -
f6c82546 by Cheng Shao at 2025-12-30T23:55:13+01:00
rts: add ASAN instrumentation to cap->pinned_object_empty
- - - - -
9e99be9c by Cheng Shao at 2025-12-30T23:55:14+01:00
rts: add ASAN instrumentation to gc_thread->free_blocks
- - - - -
067ae300 by Cheng Shao at 2025-12-30T23:55:14+01:00
rts: add ASAN instrumentation to hash table free list
- - - - -
7b0e4a52 by Cheng Shao at 2025-12-30T23:55:14+01:00
rts: add ASAN instrumentation to per-Task InCall free list
- - - - -
18 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- hadrian/doc/flavours.md
- hadrian/src/Flavour.hs
- rts/Hash.c
- rts/Task.c
- rts/include/Stg.h
- + rts/include/rts/ASANUtils.h
- rts/rts.cabal
- rts/sm/BlockAlloc.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/Storage.c
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/rts/T18623/all.T
- testsuite/tests/rts/all.T
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -162,6 +162,7 @@ data BuildConfig
, tablesNextToCode :: Bool
, threadSanitiser :: Bool
, ubsan :: Bool
+ , asan :: Bool
, noSplitSections :: Bool
, validateNonmovingGc :: Bool
, textWithSIMDUTF :: Bool
@@ -173,7 +174,7 @@ configureArgsStr :: BuildConfig -> String
configureArgsStr bc = unwords $
["--enable-unregisterised"| unregisterised bc ]
++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ]
- ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ]
+ ++ ["--with-intree-gmp" | isJust (crossTarget bc) || ubsan bc || asan bc ]
++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ]
++ ["--enable-ipe-data-compression" | withZstd bc ]
++ ["--enable-strict-ghc-toolchain-check"]
@@ -188,6 +189,7 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts
[HostFullyStatic | hostFullyStatic] ++
[ThreadSanitiser | threadSanitiser] ++
[UBSan | ubsan] ++
+ [ASan | asan] ++
[NoSplitSections | noSplitSections, buildFlavour == Release ] ++
[BootNonmovingGc | validateNonmovingGc ] ++
[TextWithSIMDUTF | textWithSIMDUTF]
@@ -201,11 +203,12 @@ data FlavourTrans =
| HostFullyStatic
| ThreadSanitiser
| UBSan
+ | ASan
| NoSplitSections
| BootNonmovingGc
| TextWithSIMDUTF
-data BaseFlavour = Release | Validate | SlowValidate deriving Eq
+data BaseFlavour = Release | QuickValidate | Validate | SlowValidate deriving Eq
-----------------------------------------------------------------------------
-- Build Configurations
@@ -230,6 +233,7 @@ vanilla = BuildConfig
, tablesNextToCode = True
, threadSanitiser = False
, ubsan = False
+ , asan = False
, noSplitSections = False
, validateNonmovingGc = False
, textWithSIMDUTF = False
@@ -283,8 +287,14 @@ llvm = vanilla { llvmBootstrap = True }
tsan :: BuildConfig
tsan = vanilla { threadSanitiser = True }
-enableUBSan :: BuildConfig
-enableUBSan = vanilla { withDwarf = True, ubsan = True }
+enableUBSanASan :: BuildConfig
+enableUBSanASan =
+ vanilla
+ { buildFlavour = QuickValidate,
+ withDwarf = True,
+ ubsan = True,
+ asan = True
+ }
noTntc :: BuildConfig
noTntc = vanilla { tablesNextToCode = False }
@@ -372,6 +382,7 @@ flavourString :: Flavour -> String
flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans
where
base_string Release = "release"
+ base_string QuickValidate = "quick-validate"
base_string Validate = "validate"
base_string SlowValidate = "slow-validate"
@@ -381,6 +392,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f
flavour_string HostFullyStatic = "host_fully_static"
flavour_string ThreadSanitiser = "thread_sanitizer_cmm"
flavour_string UBSan = "ubsan"
+ flavour_string ASan = "asan"
flavour_string NoSplitSections = "no_split_sections"
flavour_string BootNonmovingGc = "boot_nonmoving_gc"
flavour_string TextWithSIMDUTF = "text_simdutf"
@@ -1213,15 +1225,24 @@ fedora_x86 =
, hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) releaseConfig))
, disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) dwarf)
, disableValidate (standardBuilds Amd64 (Linux Fedora43))
- -- For UBSan jobs, only enable for validate/nightly pipelines.
- -- Also disable docs since it's not the point for UBSan jobs.
+ -- For UBSan/ASan jobs, only enable for validate/nightly
+ -- pipelines. Also disable docs since it's not the point for
+ -- UBSan/ASan jobs.
+ --
+ -- See
+ -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/compiler-rt/lib/sa…
+ -- for ASAN options help, for now these are required to pass the
+ -- testsuite
, modifyJobs
( setVariable "HADRIAN_ARGS" "--docs=none"
. addVariable
"UBSAN_OPTIONS"
"suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
+ . addVariable
+ "ASAN_OPTIONS"
+ "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false"
)
- $ validateBuilds Amd64 (Linux Fedora43) enableUBSan
+ $ validateBuilds Amd64 (Linux Fedora43) enableUBSanASan
]
where
hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
=====================================
.gitlab/jobs.yaml
=====================================
@@ -2942,7 +2942,7 @@
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-release": {
+ "nightly-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -2953,7 +2953,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-release.tar.xz",
+ "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -2995,17 +2995,20 @@
"x86_64-linux"
],
"variables": {
+ "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "BUILD_FLAVOUR": "quick-validate+debug_info+ubsan+asan",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-release",
+ "TEST_ENV": "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-release-hackage": {
+ "nightly-x86_64-linux-fedora43-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3062,14 +3065,13 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "x86_64-linux-fedora43-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate": {
+ "nightly-x86_64-linux-fedora43-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3080,7 +3082,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate.tar.xz",
+ "ghc-x86_64-linux-fedora43-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3123,16 +3125,17 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
+ "BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate",
+ "TEST_ENV": "x86_64-linux-fedora43-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate+debug_info": {
+ "nightly-x86_64-linux-fedora43-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3143,7 +3146,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3186,16 +3189,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info",
+ "TEST_ENV": "x86_64-linux-fedora43-validate",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate+debug_info+ubsan": {
+ "nightly-x86_64-linux-fedora43-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3206,7 +3209,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3249,14 +3252,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
- "BUILD_FLAVOUR": "validate+debug_info+ubsan",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
- "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
+ "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info",
"XZ_OPT": "-9"
}
},
@@ -7097,7 +7098,7 @@
"TEST_ENV": "x86_64-linux-deb9-validate"
}
},
- "x86_64-linux-fedora43-release": {
+ "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7108,7 +7109,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-release.tar.xz",
+ "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7134,7 +7135,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-quick-validate\\+debug_info\\+ubsan\\+asan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7150,16 +7151,19 @@
"x86_64-linux"
],
"variables": {
+ "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "BUILD_FLAVOUR": "quick-validate+debug_info+ubsan+asan",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-release"
+ "TEST_ENV": "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
}
},
- "x86_64-linux-fedora43-release-hackage": {
+ "x86_64-linux-fedora43-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7196,7 +7200,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7216,13 +7220,12 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "x86_64-linux-fedora43-release"
}
},
- "x86_64-linux-fedora43-validate": {
+ "x86_64-linux-fedora43-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7233,7 +7236,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate.tar.xz",
+ "ghc-x86_64-linux-fedora43-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7259,7 +7262,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7276,15 +7279,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
+ "BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate"
+ "TEST_ENV": "x86_64-linux-fedora43-release"
}
},
- "x86_64-linux-fedora43-validate+debug_info": {
+ "x86_64-linux-fedora43-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7295,7 +7299,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7321,7 +7325,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7338,15 +7342,15 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
+ "TEST_ENV": "x86_64-linux-fedora43-validate"
}
},
- "x86_64-linux-fedora43-validate+debug_info+ubsan": {
+ "x86_64-linux-fedora43-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7357,7 +7361,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7383,7 +7387,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info\\+ubsan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7400,14 +7404,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
- "BUILD_FLAVOUR": "validate+debug_info+ubsan",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
- "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
+ "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
}
},
"x86_64-linux-rocky8-validate": {
=====================================
hadrian/doc/flavours.md
=====================================
@@ -242,6 +242,10 @@ The supported transformers are listed below:
<td><code>ubsan</code></td>
<td>Build all stage1+ C/C++ code with UndefinedBehaviorSanitizer support</td>
</tr>
+ <tr>
+ <td><code>asan</code></td>
+ <td>Build all stage1+ C/C++ code with AddressSanitizer support</td>
+ </tr>
<tr>
<td><code>llvm</code></td>
<td>Use GHC's LLVM backend (`-fllvm`) for all stage1+ compilation.</td>
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -8,6 +8,7 @@ module Flavour
, splitSections
, enableThreadSanitizer
, enableUBSan
+ , enableASan
, enableLateCCS
, enableHashUnitIds
, enableDebugInfo, enableTickyGhc
@@ -57,6 +58,7 @@ flavourTransformers = M.fromList
, "thread_sanitizer" =: enableThreadSanitizer False
, "thread_sanitizer_cmm" =: enableThreadSanitizer True
, "ubsan" =: enableUBSan
+ , "asan" =: enableASan
, "llvm" =: viaLlvmBackend
, "profiled_ghc" =: enableProfiledGhc
, "no_dynamic_ghc" =: disableDynamicGhcPrograms
@@ -306,6 +308,32 @@ enableUBSan =
builder Testsuite ? arg "--config=have_ubsan=True"
]
+-- | Build all stage1+ C/C++ code with AddressSanitizer support:
+-- https://clang.llvm.org/docs/AddressSanitizer.html
+enableASan :: Flavour -> Flavour
+enableASan =
+ addArgs $
+ notStage0
+ ? mconcat
+ [ package rts
+ ? builder (Cabal Flags)
+ ? arg "+asan"
+ <> (needSharedLibSAN ? arg "+shared-libsan"),
+ builder (Ghc CompileHs) arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address",
+ builder (Ghc CompileCWithGhc) arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address",
+ builder (Ghc CompileCppWithGhc) arg "-optcxx-fno-omit-frame-pointer"
+ <> arg "-optcxx-fsanitize=address",
+ builder (Ghc LinkHs) arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address"
+ <> arg "-optl-fsanitize=address"
+ <> (needSharedLibSAN ? arg "-optl-shared-libsan"),
+ builder (Cc CompileC) arg "-fno-omit-frame-pointer"
+ <> arg "-fsanitize=address",
+ builder Testsuite ? arg "--config=have_asan=True"
+ ]
+
-- | Use the LLVM backend in stages 1 and later.
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
=====================================
rts/Hash.c
=====================================
@@ -283,6 +283,7 @@ allocHashList (HashTable *table)
if (table->freeList != NULL) {
HashList *hl = table->freeList;
table->freeList = hl->next;
+ __ghc_asan_unpoison_memory_region(hl, offsetof(HashList, next));
return hl;
} else {
/* We allocate one block of memory which contains:
@@ -302,8 +303,11 @@ allocHashList (HashTable *table)
table->freeList = hl + 1;
HashList *p = table->freeList;
- for (; p < hl + HCHUNK - 1; p++)
+ for (; p < hl + HCHUNK - 1; p++) {
+ __ghc_asan_poison_memory_region(p, offsetof(HashList, next));
p->next = p + 1;
+ }
+ __ghc_asan_poison_memory_region(p, offsetof(HashList, next));
p->next = NULL;
return hl;
}
@@ -318,6 +322,7 @@ freeHashList (HashTable *table, HashList *hl)
// HashListChunks.
hl->next = table->freeList;
table->freeList = hl;
+ __ghc_asan_poison_memory_region(hl, offsetof(HashList, next));
}
STATIC_INLINE void
@@ -388,9 +393,10 @@ removeHashTable_inlined(HashTable *table, StgWord key, const void *data,
table->dir[segment][index] = hl->next;
else
prev->next = hl->next;
+ void *hl_data = (void*)hl->data;
freeHashList(table,hl);
table->kcount--;
- return (void *) hl->data;
+ return hl_data;
}
prev = hl;
}
=====================================
rts/Task.c
=====================================
@@ -183,6 +183,7 @@ freeTask (Task *task)
stgFree(incall);
}
for (incall = task->spare_incalls; incall != NULL; incall = next) {
+ __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
next = incall->next;
stgFree(incall);
}
@@ -252,6 +253,7 @@ newInCall (Task *task)
if (task->spare_incalls != NULL) {
incall = task->spare_incalls;
+ __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
task->spare_incalls = incall->next;
task->n_spare_incalls--;
} else {
@@ -283,6 +285,7 @@ endInCall (Task *task)
stgFree(incall);
} else {
incall->next = task->spare_incalls;
+ __ghc_asan_poison_memory_region(incall, sizeof(InCall));
task->spare_incalls = incall;
task->n_spare_incalls++;
}
=====================================
rts/include/Stg.h
=====================================
@@ -335,6 +335,7 @@ external prototype return neither of these types to workaround #11395.
#include "stg/MachRegsForHost.h"
#include "stg/Regs.h"
#include "stg/Ticky.h"
+#include "rts/ASANUtils.h"
#include "rts/TSANUtils.h"
#if IN_STG_CODE
=====================================
rts/include/rts/ASANUtils.h
=====================================
@@ -0,0 +1,33 @@
+#pragma once
+
+#if defined(__SANITIZE_ADDRESS__)
+#define ASAN_ENABLED
+#elif defined(__has_feature)
+#if __has_feature(address_sanitizer)
+#define ASAN_ENABLED
+#endif
+#endif
+
+#if defined(ASAN_ENABLED)
+#include <sanitizer/asan_interface.h>
+#define USED_IF_ASAN
+#else
+#include <stdlib.h>
+#define USED_IF_ASAN __attribute__((unused))
+#endif
+
+static inline void
+__ghc_asan_poison_memory_region(void const volatile *addr USED_IF_ASAN,
+ size_t size USED_IF_ASAN) {
+#if defined(ASAN_ENABLED)
+ __asan_poison_memory_region(addr, size);
+#endif
+}
+
+static inline void
+__ghc_asan_unpoison_memory_region(void const volatile *addr USED_IF_ASAN,
+ size_t size USED_IF_ASAN) {
+#if defined(ASAN_ENABLED)
+ __asan_unpoison_memory_region(addr, size);
+#endif
+}
=====================================
rts/rts.cabal
=====================================
@@ -97,6 +97,12 @@ flag ubsan
UndefinedBehaviorSanitizer.
default: False
manual: True
+flag asan
+ description:
+ Link with -fsanitize=address, to be enabled when building with
+ AddressSanitizer.
+ default: False
+ manual: True
flag shared-libsan
description:
Link with -shared-libsan, to guarantee only one copy of the
@@ -216,6 +222,9 @@ library
if flag(ubsan)
ld-options: -fsanitize=undefined
+ if flag(asan)
+ ld-options: -fsanitize=address
+
if flag(shared-libsan)
ld-options: -shared-libsan
@@ -280,6 +289,7 @@ library
-- ^ generated
rts/ghc_ffi.h
rts/Adjustor.h
+ rts/ASANUtils.h
rts/ExecPage.h
rts/BlockSignals.h
rts/Bytecodes.h
=====================================
rts/sm/BlockAlloc.c
=====================================
@@ -261,6 +261,8 @@ initGroup(bdescr *head)
head[i].flags = 0;
}
#endif
+
+ __ghc_asan_unpoison_memory_region(head->start, (W_)head->blocks * BLOCK_SIZE);
}
#if SIZEOF_VOID_P == SIZEOF_LONG
@@ -474,6 +476,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
bd = alloc_mega_group_from_free_list(&deferred_free_mblock_list[node], n, &best);
if(bd)
{
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
return bd;
}
else if(!best)
@@ -490,6 +493,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
if (bd)
{
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
return bd;
}
else if (best)
@@ -500,6 +504,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
(best_mblocks-mblocks)*MBLOCK_SIZE);
best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
+ __ghc_asan_unpoison_memory_region(MBLOCK_ROUND_DOWN(bd), mblocks * MBLOCK_SIZE);
initMBlock(MBLOCK_ROUND_DOWN(bd), node);
}
else
@@ -878,6 +883,8 @@ free_mega_group (bdescr *mg)
IF_DEBUG(sanity, checkFreeListSanity());
}
+
+ __ghc_asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
}
static void
@@ -925,6 +932,8 @@ free_deferred_mega_groups (uint32_t node)
// coalesce forwards
coalesce_mblocks(mg);
+ __ghc_asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
+
// initialize search for next round
prev = mg;
bd = prev->link;
@@ -1045,6 +1054,8 @@ freeGroup(bdescr *p)
setup_tail(p);
free_list_insert(node,p);
+ __ghc_asan_poison_memory_region(p->start, (W_)p->blocks * BLOCK_SIZE);
+
IF_DEBUG(sanity, checkFreeListSanity());
}
=====================================
rts/sm/GCUtils.c
=====================================
@@ -348,6 +348,7 @@ alloc_todo_block (gen_workspace *ws, uint32_t size)
} else {
if (gct->free_blocks) {
bd = gct->free_blocks;
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
gct->free_blocks = bd->link;
} else {
// We allocate in chunks of at most 16 blocks, use one
@@ -357,6 +358,9 @@ alloc_todo_block (gen_workspace *ws, uint32_t size)
StgWord n_blocks = stg_min(chunk_size, 1 << (MBLOCK_SHIFT - BLOCK_SHIFT - 1));
allocBlocks_sync(n_blocks, &bd);
gct->free_blocks = bd->link;
+ for (bdescr *bd = gct->free_blocks; bd; bd = bd->link) {
+ __ghc_asan_poison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
+ }
}
}
initBdescr(bd, ws->gen, ws->gen->to);
=====================================
rts/sm/MBlock.c
=====================================
@@ -579,6 +579,8 @@ getMBlocks(uint32_t n)
ret = getCommittedMBlocks(n);
+ __ghc_asan_unpoison_memory_region(ret, (W_)n * MBLOCK_SIZE);
+
debugTrace(DEBUG_gc, "allocated %d megablock(s) at %p",n,ret);
mblocks_allocated += n;
@@ -611,6 +613,8 @@ freeMBlocks(void *addr, uint32_t n)
mblocks_allocated -= n;
+ __ghc_asan_poison_memory_region(addr, (W_)n * MBLOCK_SIZE);
+
decommitMBlocks(addr, n);
}
=====================================
rts/sm/Storage.c
=====================================
@@ -1242,6 +1242,10 @@ start_new_pinned_block(Capability *cap)
ACQUIRE_SM_LOCK;
bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE);
RELEASE_SM_LOCK;
+
+ for (bdescr *pbd = bd; pbd; pbd = pbd->link) {
+ __ghc_asan_poison_memory_region(pbd->start, (W_)pbd->blocks * BLOCK_SIZE);
+ }
}
// Bump up the nursery pointer to avoid the pathological situation
@@ -1267,6 +1271,7 @@ start_new_pinned_block(Capability *cap)
}
cap->pinned_object_empty = bd->link;
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
newNurseryBlock(bd);
if (bd->link != NULL) {
bd->link->u.back = cap->pinned_object_empty;
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -189,6 +189,9 @@ class TestConfig:
# Are we running with UndefinedBehaviorSanitizer enabled?
self.have_ubsan = False
+ # Are we running with AddressSanitizer enabled?
+ self.have_asan = False
+
# Do symbols use leading underscores?
self.leading_underscore = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1093,6 +1093,9 @@ def have_thread_sanitizer( ) -> bool:
def have_ubsan( ) -> bool:
return config.have_ubsan
+def have_asan( ) -> bool:
+ return config.have_asan
+
def gcc_as_cmmp() -> bool:
return config.cmm_cpp_is_gcc
=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -192,6 +192,9 @@ test('rts_clearMemory', [
extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc', 'sanity']),
# On windows, nonmoving way fails with bad exit code (2816)
when(opsys('mingw32'), fragile(23091)),
+ # For simplicity, ASAN poisoning/unpoisoning logic is omitted
+ # from rts_clearMemory implementation
+ when(have_asan(), skip),
req_c,
pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ],
# Same hack as ffi023
=====================================
testsuite/tests/rts/T18623/all.T
=====================================
@@ -8,6 +8,8 @@ test('T18623',
# Recent versions of osx report an error when running `ulimit -v`
when(opsys('darwin'), skip),
when(arch('powerpc64le'), skip),
+ # ASan can't allocate shadow memory
+ when(have_asan(), skip),
cmd_prefix('ulimit -v ' + str(8 * 1024 ** 2) + ' && '),
ignore_stdout],
run_command,
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -105,6 +105,8 @@ def remove_parenthesis(s):
return re.sub(r'\s+\([^)]*\)', '', s)
test('outofmem', [ when(opsys('darwin'), skip),
+ # ASan shadow memory allocation blows up
+ when(have_asan(), skip),
# this is believed to cause other processes to die
# that happen concurrently while the outofmem test
# runs in CI. As such we'll need to disable it on
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c86441c1dd4df93ce1c452c77aeded…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c86441c1dd4df93ce1c452c77aeded…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL] 10 commits: hadrian: Build stage 2 cross compilers
by Sven Tennie (＠supersven) 31 Dec '25
by Sven Tennie (＠supersven) 31 Dec '25
31 Dec '25
Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL at Glasgow Haskell Compiler / GHC
Commits:
b106d68d by Matthew Pickering at 2025-12-30T21:50:28+01:00
hadrian: Build stage 2 cross compilers
* Most of hadrian is abstracted over the stage in order to remove the
assumption that the target of all stages is the same platform. This
allows the RTS to be built for two different targets for example.
* Abstracts the bindist creation logic to allow building either normal
or cross bindists. Normal bindists use stage 1 libraries and a stage 2
compiler. Cross bindists use stage 2 libararies and a stage 2
compiler.
* hadrian: Make binary-dist-dir the default build target. This allows us
to have the logic in one place about which libraries/stages to build
with cross compilers. Fixes #24192
New hadrian target:
* `binary-dist-dir-cross`: Build a cross compiler bindist (compiler =
stage 1, libraries = stage 2)
This commit also contains various changes to make stage2 compilers
feasible.
-------------------------
Metric Decrease:
ManyAlternatives
MultiComponentModulesRecomp
MultiLayerModulesRecomp
T10421
T12425
T12707
T13035
T13379
T15703
T16577
T18698a
T18698b
T18923
T1969
T21839c
T3294
T4801
T5030
T5321Fun
T5642
T783
T9198
T9872d
T9961
parsing001
-------------------------
Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com>
Format
Cleanup
- - - - -
7b29fab7 by Sven Tennie at 2025-12-30T21:50:28+01:00
Align CI scripts with master
Fixup
- - - - -
4d616b9f by Matthew Pickering at 2025-12-30T21:50:28+01:00
ci: Test cross bindists
We remove the special logic for testing in-tree cross
compilers and instead test cross compiler bindists, like we do for all
other platforms.
- - - - -
f25b4400 by Matthew Pickering at 2025-12-30T21:50:28+01:00
ci: Introduce CROSS_STAGE variable
In preparation for building and testing stage3 bindists we introduce the
CROSS_STAGE variable which is used by a CI job to determine what kind of
bindist the CI job should produce.
At the moment we are only using CROSS_STAGE=2 but in the future we will
have some jobs which set CROSS_STAGE=3 to produce native bindists for a
target, but produced by a cross compiler, which can be tested on by
another CI job on the native platform.
CROSS_STAGE=2: Build a normal cross compiler bindist
CROSS_STAGE=3: Build a stage 3 bindist, one which is a native compiler and library for the target
- - - - -
7d299c8d by Matthew Pickering at 2025-12-30T21:50:28+01:00
hadrian: Refactor system-cxx-std-lib rules0
I noticed a few things wrong with the hadrian rules for `system-cxx-std-lib` rules.
* For `text` there is an ad-hoc check to depend on `system-cxx-std-lib` outside of `configurePackage`.
* The `system-cxx-std-lib` dependency is not read from cabal files.
* Recache is not called on the packge database after the `.conf` file is generated, a more natural place for this rule is `registerRules`.
Treating this uniformly like other packages is complicated by it not having any source code or a cabal file. However we can do a bit better by reporting the dependency firstly in `PackageData` and then needing the `.conf` file in the same place as every other package in `configurePackage`.
Fixes #25303
- - - - -
3c49d226 by Sven Tennie at 2025-12-30T21:50:28+01:00
ci: Increase timeout for emulators
Test runs with emulators naturally take longer than on native machines.
Generate jobs.yml
- - - - -
73159aee by Sven Tennie at 2025-12-30T21:50:28+01:00
ghc: Distinguish between having an interpreter and having an internal one
Otherwise, we fail with warnings when compiling tools. Actually, these
are related but different things:
- ghc can run an interpreter (either internal or external)
- ghc is compiled with an internal interpreter
- - - - -
91c49f4c by Matthew Pickering at 2025-12-30T21:50:28+01:00
ci: Javascript don't set CROSS_EMULATOR
There is no CROSS_EMULATOR needed to run javascript binaries, so we
don't set the CROSS_EMULATOR to some dummy value.
- - - - -
bca3ef66 by Sven Tennie at 2025-12-30T21:50:28+01:00
Javascript skip T23697
See #22355 about how HSC2HS and the Javascript target don't play well
together.
- - - - -
76629776 by Matthew Pickering at 2025-12-30T21:50:28+01:00
ci: Javascript don't set CROSS_EMULATOR
There is no CROSS_EMULATOR needed to run javascript binaries, so we
don't set the CROSS_EMULATOR to some dummy value.
We want to keep the increased timeout settings, though.
Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com>
- - - - -
68 changed files:
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- configure.ac
- distrib/configure.ac.in
- ghc/GHC/Driver/Session/Mode.hs
- ghc/GHCi/UI.hs
- ghc/Main.hs
- ghc/ghc-bin.cabal.in
- hadrian/README.md
- hadrian/bindist/config.mk.in
- + hadrian/cfg/system.config.host.in
- hadrian/cfg/system.config.in
- + hadrian/cfg/system.config.target.in
- hadrian/hadrian.cabal
- hadrian/src/Base.hs
- + hadrian/src/BindistConfig.hs
- hadrian/src/Builder.hs
- hadrian/src/Context.hs
- hadrian/src/Expression.hs
- hadrian/src/Flavour.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Oracles/TextFile.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Oracles/Flavour.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Gmp.hs
- hadrian/src/Rules/Libffi.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Common.hs
- hadrian/src/Settings/Builders/Configure.hs
- hadrian/src/Settings/Builders/DeriveConstants.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/Hsc2Hs.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Benchmark.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Performance.hs
- hadrian/src/Settings/Flavours/Quick.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Flavours/Quickest.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs
- hadrian/src/Settings/Program.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/tests/all.T
- testsuite/ghc-config/ghc-config.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94fb90c7b5d4c81389a5ac3c7a5e7b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94fb90c7b5d4c81389a5ac3c7a5e7b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/terrorjack/asan] 10 commits: ghc-internal: remove unused GMP macros
by Cheng Shao (＠TerrorJack) 31 Dec '25
by Cheng Shao (＠TerrorJack) 31 Dec '25
31 Dec '25
Cheng Shao pushed to branch wip/terrorjack/asan at Glasgow Haskell Compiler / GHC
Commits:
0c8c82ed by Cheng Shao at 2025-12-30T18:02:14+01:00
ghc-internal: remove unused GMP macros
This patch removes unused GMP related macros from `ghc-internal`. The
in-tree GMP version was hard coded and outdated, but it was not used
anywhere anyway.
- - - - -
b7e851e0 by Cheng Shao at 2025-12-30T18:02:24+01:00
hadrian: fix in-tree gmp configure error on newer c compilers
Building in-tree gmp on newer c compilers that default to c23 fails at
configure stage, this patch fixes it, see added comment for
explanation.
- - - - -
7dc91125 by Cheng Shao at 2025-12-30T20:36:50+01:00
hadrian: remove linting/assertion in quick-validate flavour
The `quick-validate` flavour is meant for testing ghc and passing the
testsuite locally with similar settings to `validate` but faster. This
patch removes the linting/assertion overhead in `quick-validate` to
improve developer experience. I also took the chance to simplify
redundant logic of rts/library way definition in `validate` flavour.
- - - - -
30112ec2 by Cheng Shao at 2025-12-30T20:36:50+01:00
rts: add is-valid-utf8.c to .ubsan-suppressions
A minor one in `bytestring` that might surface when building with
+ubsan using clang.
- - - - -
efeedb4b by Cheng Shao at 2025-12-30T20:36:50+01:00
hadrian: add support for building with AddressSanitizer
This patch adds a +asan flavour transformer to hadrian to build all
stage1+ C/C++ code with AddressBehaviorSanitizer. This is particularly
useful to catch potential out-of-bounds and use-after-free bugs in the
RTS codebase.
- - - - -
35fa0b3e by Cheng Shao at 2025-12-30T20:36:50+01:00
ci: add ubsan+asan job
We now have a
`x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan`
validate/nightly job with both UBSan/ASan enabled. We build with
`quick-validate` instead of `validate` since the extra
assertion/linting is already provided by other jobs anyway and it's
better to reserve the CI time budget for UBSan/ASan overhead.
- - - - -
3a579848 by Cheng Shao at 2025-12-30T20:36:50+01:00
rts: add ASAN instrumentation to mblock allocator
- - - - -
b07f9481 by Cheng Shao at 2025-12-30T20:36:50+01:00
rts: add ASAN instrumentation to mgroup allocator
- - - - -
00a25615 by Cheng Shao at 2025-12-30T20:36:50+01:00
rts: add ASAN instrumentation to block allocator
- - - - -
c86441c1 by Cheng Shao at 2025-12-30T20:36:50+01:00
rts: add ASAN instrumentation to per-Task InCall free list
- - - - -
20 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- hadrian/doc/flavours.md
- hadrian/src/Flavour.hs
- hadrian/src/Rules/Gmp.hs
- hadrian/src/Settings/Flavours/Validate.hs
- libraries/ghc-internal/configure.ac
- libraries/ghc-internal/include/HsIntegerGmp.h.in
- rts/.ubsan-suppressions
- rts/Task.c
- rts/include/Stg.h
- + rts/include/rts/ASANUtils.h
- rts/rts.cabal
- rts/sm/BlockAlloc.c
- rts/sm/MBlock.c
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/rts/T18623/all.T
- testsuite/tests/rts/all.T
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -162,6 +162,7 @@ data BuildConfig
, tablesNextToCode :: Bool
, threadSanitiser :: Bool
, ubsan :: Bool
+ , asan :: Bool
, noSplitSections :: Bool
, validateNonmovingGc :: Bool
, textWithSIMDUTF :: Bool
@@ -173,7 +174,7 @@ configureArgsStr :: BuildConfig -> String
configureArgsStr bc = unwords $
["--enable-unregisterised"| unregisterised bc ]
++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ]
- ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ]
+ ++ ["--with-intree-gmp" | isJust (crossTarget bc) || ubsan bc || asan bc ]
++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ]
++ ["--enable-ipe-data-compression" | withZstd bc ]
++ ["--enable-strict-ghc-toolchain-check"]
@@ -188,6 +189,7 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts
[HostFullyStatic | hostFullyStatic] ++
[ThreadSanitiser | threadSanitiser] ++
[UBSan | ubsan] ++
+ [ASan | asan] ++
[NoSplitSections | noSplitSections, buildFlavour == Release ] ++
[BootNonmovingGc | validateNonmovingGc ] ++
[TextWithSIMDUTF | textWithSIMDUTF]
@@ -201,11 +203,12 @@ data FlavourTrans =
| HostFullyStatic
| ThreadSanitiser
| UBSan
+ | ASan
| NoSplitSections
| BootNonmovingGc
| TextWithSIMDUTF
-data BaseFlavour = Release | Validate | SlowValidate deriving Eq
+data BaseFlavour = Release | QuickValidate | Validate | SlowValidate deriving Eq
-----------------------------------------------------------------------------
-- Build Configurations
@@ -230,6 +233,7 @@ vanilla = BuildConfig
, tablesNextToCode = True
, threadSanitiser = False
, ubsan = False
+ , asan = False
, noSplitSections = False
, validateNonmovingGc = False
, textWithSIMDUTF = False
@@ -283,8 +287,14 @@ llvm = vanilla { llvmBootstrap = True }
tsan :: BuildConfig
tsan = vanilla { threadSanitiser = True }
-enableUBSan :: BuildConfig
-enableUBSan = vanilla { withDwarf = True, ubsan = True }
+enableUBSanASan :: BuildConfig
+enableUBSanASan =
+ vanilla
+ { buildFlavour = QuickValidate,
+ withDwarf = True,
+ ubsan = True,
+ asan = True
+ }
noTntc :: BuildConfig
noTntc = vanilla { tablesNextToCode = False }
@@ -372,6 +382,7 @@ flavourString :: Flavour -> String
flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans
where
base_string Release = "release"
+ base_string QuickValidate = "quick-validate"
base_string Validate = "validate"
base_string SlowValidate = "slow-validate"
@@ -381,6 +392,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f
flavour_string HostFullyStatic = "host_fully_static"
flavour_string ThreadSanitiser = "thread_sanitizer_cmm"
flavour_string UBSan = "ubsan"
+ flavour_string ASan = "asan"
flavour_string NoSplitSections = "no_split_sections"
flavour_string BootNonmovingGc = "boot_nonmoving_gc"
flavour_string TextWithSIMDUTF = "text_simdutf"
@@ -1213,15 +1225,24 @@ fedora_x86 =
, hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) releaseConfig))
, disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) dwarf)
, disableValidate (standardBuilds Amd64 (Linux Fedora43))
- -- For UBSan jobs, only enable for validate/nightly pipelines.
- -- Also disable docs since it's not the point for UBSan jobs.
+ -- For UBSan/ASan jobs, only enable for validate/nightly
+ -- pipelines. Also disable docs since it's not the point for
+ -- UBSan/ASan jobs.
+ --
+ -- See
+ -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/compiler-rt/lib/sa…
+ -- for ASAN options help, for now these are required to pass the
+ -- testsuite
, modifyJobs
( setVariable "HADRIAN_ARGS" "--docs=none"
. addVariable
"UBSAN_OPTIONS"
"suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
+ . addVariable
+ "ASAN_OPTIONS"
+ "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false"
)
- $ validateBuilds Amd64 (Linux Fedora43) enableUBSan
+ $ validateBuilds Amd64 (Linux Fedora43) enableUBSanASan
]
where
hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
=====================================
.gitlab/jobs.yaml
=====================================
@@ -2942,7 +2942,7 @@
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-release": {
+ "nightly-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -2953,7 +2953,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-release.tar.xz",
+ "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -2995,17 +2995,20 @@
"x86_64-linux"
],
"variables": {
+ "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "BUILD_FLAVOUR": "quick-validate+debug_info+ubsan+asan",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-release",
+ "TEST_ENV": "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-release-hackage": {
+ "nightly-x86_64-linux-fedora43-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3062,14 +3065,13 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "x86_64-linux-fedora43-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate": {
+ "nightly-x86_64-linux-fedora43-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3080,7 +3082,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate.tar.xz",
+ "ghc-x86_64-linux-fedora43-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3123,16 +3125,17 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
+ "BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate",
+ "TEST_ENV": "x86_64-linux-fedora43-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate+debug_info": {
+ "nightly-x86_64-linux-fedora43-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3143,7 +3146,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3186,16 +3189,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info",
+ "TEST_ENV": "x86_64-linux-fedora43-validate",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora43-validate+debug_info+ubsan": {
+ "nightly-x86_64-linux-fedora43-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3206,7 +3209,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3249,14 +3252,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
- "BUILD_FLAVOUR": "validate+debug_info+ubsan",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
- "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
+ "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info",
"XZ_OPT": "-9"
}
},
@@ -7097,7 +7098,7 @@
"TEST_ENV": "x86_64-linux-deb9-validate"
}
},
- "x86_64-linux-fedora43-release": {
+ "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7108,7 +7109,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-release.tar.xz",
+ "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7134,7 +7135,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-quick-validate\\+debug_info\\+ubsan\\+asan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7150,16 +7151,19 @@
"x86_64-linux"
],
"variables": {
+ "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "BUILD_FLAVOUR": "quick-validate+debug_info+ubsan+asan",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-release"
+ "TEST_ENV": "x86_64-linux-fedora43-quick-validate+debug_info+ubsan+asan",
+ "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
}
},
- "x86_64-linux-fedora43-release-hackage": {
+ "x86_64-linux-fedora43-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7196,7 +7200,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7216,13 +7220,12 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
"TEST_ENV": "x86_64-linux-fedora43-release"
}
},
- "x86_64-linux-fedora43-validate": {
+ "x86_64-linux-fedora43-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7233,7 +7236,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate.tar.xz",
+ "ghc-x86_64-linux-fedora43-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7259,7 +7262,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7276,15 +7279,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-release",
+ "BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate"
+ "TEST_ENV": "x86_64-linux-fedora43-release"
}
},
- "x86_64-linux-fedora43-validate+debug_info": {
+ "x86_64-linux-fedora43-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7295,7 +7299,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7321,7 +7325,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7338,15 +7342,15 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
+ "TEST_ENV": "x86_64-linux-fedora43-validate"
}
},
- "x86_64-linux-fedora43-validate+debug_info+ubsan": {
+ "x86_64-linux-fedora43-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7357,7 +7361,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
+ "ghc-x86_64-linux-fedora43-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7383,7 +7387,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info\\+ubsan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7400,14 +7404,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
- "BUILD_FLAVOUR": "validate+debug_info+ubsan",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--docs=none",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
- "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
+ "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
}
},
"x86_64-linux-rocky8-validate": {
=====================================
hadrian/doc/flavours.md
=====================================
@@ -242,6 +242,10 @@ The supported transformers are listed below:
<td><code>ubsan</code></td>
<td>Build all stage1+ C/C++ code with UndefinedBehaviorSanitizer support</td>
</tr>
+ <tr>
+ <td><code>asan</code></td>
+ <td>Build all stage1+ C/C++ code with AddressSanitizer support</td>
+ </tr>
<tr>
<td><code>llvm</code></td>
<td>Use GHC's LLVM backend (`-fllvm`) for all stage1+ compilation.</td>
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -8,6 +8,7 @@ module Flavour
, splitSections
, enableThreadSanitizer
, enableUBSan
+ , enableASan
, enableLateCCS
, enableHashUnitIds
, enableDebugInfo, enableTickyGhc
@@ -57,6 +58,7 @@ flavourTransformers = M.fromList
, "thread_sanitizer" =: enableThreadSanitizer False
, "thread_sanitizer_cmm" =: enableThreadSanitizer True
, "ubsan" =: enableUBSan
+ , "asan" =: enableASan
, "llvm" =: viaLlvmBackend
, "profiled_ghc" =: enableProfiledGhc
, "no_dynamic_ghc" =: disableDynamicGhcPrograms
@@ -306,6 +308,42 @@ enableUBSan =
builder Testsuite ? arg "--config=have_ubsan=True"
]
+-- | Build all stage1+ C/C++ code with AddressSanitizer support:
+-- https://clang.llvm.org/docs/AddressSanitizer.html
+enableASan :: Flavour -> Flavour
+enableASan =
+ addArgs $
+ notStage0
+ ? mconcat
+ [ package rts
+ ? builder (Cabal Flags)
+ ? arg "+asan"
+ <> (needSharedLibSAN ? arg "+shared-libsan"),
+ builder (Ghc CompileHs)
+ ? arg "-optc-Og"
+ <> arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address",
+ builder (Ghc CompileCWithGhc)
+ ? ((not <$> input "**/Hash.c") ? arg "-optc-Og")
+ <> arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address",
+ builder (Ghc CompileCppWithGhc)
+ ? arg "-optcxx-Og"
+ <> arg "-optcxx-fno-omit-frame-pointer"
+ <> arg "-optcxx-fsanitize=address",
+ builder (Ghc LinkHs)
+ ? arg "-optc-Og"
+ <> arg "-optc-fno-omit-frame-pointer"
+ <> arg "-optc-fsanitize=address"
+ <> arg "-optl-fsanitize=address"
+ <> (needSharedLibSAN ? arg "-optl-shared-libsan"),
+ builder (Cc CompileC)
+ ? arg "-Og"
+ <> arg "-fno-omit-frame-pointer"
+ <> arg "-fsanitize=address",
+ builder Testsuite ? arg "--config=have_asan=True"
+ ]
+
-- | Use the LLVM backend in stages 1 and later.
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
=====================================
hadrian/src/Rules/Gmp.hs
=====================================
@@ -126,6 +126,12 @@ gmpRules = do
interpretInContext ctx $
mconcat
[ getStagedCCFlags
+ -- gmp fails to configure with newer compilers
+ -- that default to c23:
+ -- https://gmplib.org/list-archives/gmp-devel/2025-January/006279.html.
+ -- for now just manually specify -std=gnu11 until
+ -- next upstream release.
+ , arg "-std=gnu11"
-- gmp symbols are only used by bignum logic in
-- ghc-internal and shouldn't be exported by the
-- ghc-internal shared library.
=====================================
hadrian/src/Settings/Flavours/Validate.hs
=====================================
@@ -1,31 +1,16 @@
module Settings.Flavours.Validate (validateFlavour, slowValidateFlavour,
quickValidateFlavour) where
-import qualified Data.Set as Set
import Expression
import Flavour
-import Oracles.Flag
import {-# SOURCE #-} Settings.Default
-- Please update doc/flavours.md when changing this file.
validateFlavour :: Flavour
-validateFlavour = enableLinting $ werror $ defaultFlavour
+validateFlavour = enableLinting $ quickValidateFlavour
{ name = "validate"
, extraArgs = validateArgs <> defaultHaddockExtraArgs
- , libraryWays = Set.fromList <$>
- mconcat [ pure [vanilla]
- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
- ]
- , rtsWays = Set.fromList <$>
- mconcat [ pure [vanilla, debug]
- , targetSupportsThreadedRts ? pure [threaded, threadedDebug]
- , notStage0 ? platformSupportsSharedLibs ? pure
- [ dynamic, debugDynamic
- ]
- , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure
- [ threadedDynamic, threadedDebugDynamic ]
- ]
, ghcDebugAssertions = (<= Stage1)
}
@@ -59,6 +44,6 @@ quickValidateArgs = sourceArgs SourceArgs
}
quickValidateFlavour :: Flavour
-quickValidateFlavour = werror $ validateFlavour
+quickValidateFlavour = werror $ disableProfiledLibs $ defaultFlavour
{ name = "quick-validate"
, extraArgs = quickValidateArgs }
=====================================
libraries/ghc-internal/configure.ac
=====================================
@@ -195,28 +195,10 @@ dnl--------------------------------------------------------------------
if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"
then
AC_MSG_RESULT([no])
- UseIntreeGmp=0
AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])])
-
- AC_MSG_CHECKING([GMP version])
- AC_COMPUTE_INT(GhcGmpVerMj, __GNU_MP_VERSION, [#include <gmp.h>],
- AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION]))
- AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include <gmp.h>],
- AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR]))
- AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include <gmp.h>],
- AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_PATCHLEVEL]))
- AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
-
else
AC_MSG_RESULT([yes])
- UseIntreeGmp=1
HaveSecurePowm=1
-
- AC_MSG_CHECKING([GMP version])
- GhcGmpVerMj=6
- GhcGmpVerMi=1
- GhcGmpVerPl=2
- AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
fi
GMP_INSTALL_INCLUDES="HsIntegerGmp.h ghc-gmp.h"
@@ -231,10 +213,6 @@ AC_SUBST(GMP_INSTALL_INCLUDES)
AC_SUBST(HaveLibGmp)
AC_SUBST(HaveFrameworkGMP)
AC_SUBST(HaveSecurePowm)
-AC_SUBST(UseIntreeGmp)
-AC_SUBST(GhcGmpVerMj)
-AC_SUBST(GhcGmpVerMi)
-AC_SUBST(GhcGmpVerPl)
# Compute offsets/sizes used by jsbits/base.js
if test "$host" = "javascript-ghcjs"
=====================================
libraries/ghc-internal/include/HsIntegerGmp.h.in
=====================================
@@ -1,14 +1,4 @@
#pragma once
-/* Whether GMP is embedded into ghc-internal */
-#define GHC_GMP_INTREE @UseIntreeGmp@
-
-/* The following values denote the GMP version used during GHC build-time */
-#define GHC_GMP_VERSION_MJ @GhcGmpVerMj@
-#define GHC_GMP_VERSION_MI @GhcGmpVerMi@
-#define GHC_GMP_VERSION_PL @GhcGmpVerPl@
-#define GHC_GMP_VERSION \
- (@GhcGmpVerMj@ * 10000 + @GhcGmpVerMi@ * 100 + @GhcGmpVerPl@)
-
/* Whether GMP supports mpz_powm_sec */
#define HAVE_SECURE_POWM @HaveSecurePowm@
=====================================
rts/.ubsan-suppressions
=====================================
@@ -1,3 +1,6 @@
+# libraries/bytestring/cbits/is-valid-utf8.c:66:14: runtime load of misaligned address 0x7ae45206f112 for type 'const uint64_t *' (aka 'const unsigned long *'), which requires 8 byte alignment
+alignment:libraries/bytestring/cbits/is-valid-utf8.c
+
# libraries/text/cbits/measure_off.c:50:39: runtime left shift of 1 by 31 places cannot be represented in type 'int'
shift-base:libraries/text/cbits/measure_off.c
=====================================
rts/Task.c
=====================================
@@ -183,6 +183,7 @@ freeTask (Task *task)
stgFree(incall);
}
for (incall = task->spare_incalls; incall != NULL; incall = next) {
+ __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
next = incall->next;
stgFree(incall);
}
@@ -252,6 +253,7 @@ newInCall (Task *task)
if (task->spare_incalls != NULL) {
incall = task->spare_incalls;
+ __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
task->spare_incalls = incall->next;
task->n_spare_incalls--;
} else {
@@ -283,6 +285,7 @@ endInCall (Task *task)
stgFree(incall);
} else {
incall->next = task->spare_incalls;
+ __ghc_asan_poison_memory_region(incall, sizeof(InCall));
task->spare_incalls = incall;
task->n_spare_incalls++;
}
=====================================
rts/include/Stg.h
=====================================
@@ -335,6 +335,7 @@ external prototype return neither of these types to workaround #11395.
#include "stg/MachRegsForHost.h"
#include "stg/Regs.h"
#include "stg/Ticky.h"
+#include "rts/ASANUtils.h"
#include "rts/TSANUtils.h"
#if IN_STG_CODE
=====================================
rts/include/rts/ASANUtils.h
=====================================
@@ -0,0 +1,33 @@
+#pragma once
+
+#if defined(__SANITIZE_ADDRESS__)
+#define ASAN_ENABLED
+#elif defined(__has_feature)
+#if __has_feature(address_sanitizer)
+#define ASAN_ENABLED
+#endif
+#endif
+
+#if defined(ASAN_ENABLED)
+#include <sanitizer/asan_interface.h>
+#define USED_IF_ASAN
+#else
+#include <stdlib.h>
+#define USED_IF_ASAN __attribute__((unused))
+#endif
+
+static inline void
+__ghc_asan_poison_memory_region(void const volatile *addr USED_IF_ASAN,
+ size_t size USED_IF_ASAN) {
+#if defined(ASAN_ENABLED)
+ __asan_poison_memory_region(addr, size);
+#endif
+}
+
+static inline void
+__ghc_asan_unpoison_memory_region(void const volatile *addr USED_IF_ASAN,
+ size_t size USED_IF_ASAN) {
+#if defined(ASAN_ENABLED)
+ __asan_unpoison_memory_region(addr, size);
+#endif
+}
=====================================
rts/rts.cabal
=====================================
@@ -97,6 +97,12 @@ flag ubsan
UndefinedBehaviorSanitizer.
default: False
manual: True
+flag asan
+ description:
+ Link with -fsanitize=address, to be enabled when building with
+ AddressSanitizer.
+ default: False
+ manual: True
flag shared-libsan
description:
Link with -shared-libsan, to guarantee only one copy of the
@@ -216,6 +222,9 @@ library
if flag(ubsan)
ld-options: -fsanitize=undefined
+ if flag(asan)
+ ld-options: -fsanitize=address
+
if flag(shared-libsan)
ld-options: -shared-libsan
@@ -280,6 +289,7 @@ library
-- ^ generated
rts/ghc_ffi.h
rts/Adjustor.h
+ rts/ASANUtils.h
rts/ExecPage.h
rts/BlockSignals.h
rts/Bytecodes.h
=====================================
rts/sm/BlockAlloc.c
=====================================
@@ -261,6 +261,8 @@ initGroup(bdescr *head)
head[i].flags = 0;
}
#endif
+
+ __ghc_asan_unpoison_memory_region(head->start, (W_)head->blocks * BLOCK_SIZE);
}
#if SIZEOF_VOID_P == SIZEOF_LONG
@@ -474,6 +476,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
bd = alloc_mega_group_from_free_list(&deferred_free_mblock_list[node], n, &best);
if(bd)
{
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
return bd;
}
else if(!best)
@@ -490,6 +493,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
if (bd)
{
+ __ghc_asan_unpoison_memory_region(bd->start, (W_)bd->blocks * BLOCK_SIZE);
return bd;
}
else if (best)
@@ -500,6 +504,7 @@ alloc_mega_group (uint32_t node, StgWord mblocks)
(best_mblocks-mblocks)*MBLOCK_SIZE);
best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
+ __ghc_asan_unpoison_memory_region(MBLOCK_ROUND_DOWN(bd), mblocks * MBLOCK_SIZE);
initMBlock(MBLOCK_ROUND_DOWN(bd), node);
}
else
@@ -878,6 +883,8 @@ free_mega_group (bdescr *mg)
IF_DEBUG(sanity, checkFreeListSanity());
}
+
+ __ghc_asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
}
static void
@@ -925,6 +932,8 @@ free_deferred_mega_groups (uint32_t node)
// coalesce forwards
coalesce_mblocks(mg);
+ __ghc_asan_poison_memory_region(mg->start, (W_)mg->blocks * BLOCK_SIZE);
+
// initialize search for next round
prev = mg;
bd = prev->link;
@@ -1045,6 +1054,8 @@ freeGroup(bdescr *p)
setup_tail(p);
free_list_insert(node,p);
+ __ghc_asan_poison_memory_region(p->start, (W_)p->blocks * BLOCK_SIZE);
+
IF_DEBUG(sanity, checkFreeListSanity());
}
=====================================
rts/sm/MBlock.c
=====================================
@@ -579,6 +579,8 @@ getMBlocks(uint32_t n)
ret = getCommittedMBlocks(n);
+ __ghc_asan_unpoison_memory_region(ret, (W_)n * MBLOCK_SIZE);
+
debugTrace(DEBUG_gc, "allocated %d megablock(s) at %p",n,ret);
mblocks_allocated += n;
@@ -611,6 +613,8 @@ freeMBlocks(void *addr, uint32_t n)
mblocks_allocated -= n;
+ __ghc_asan_poison_memory_region(addr, (W_)n * MBLOCK_SIZE);
+
decommitMBlocks(addr, n);
}
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -189,6 +189,9 @@ class TestConfig:
# Are we running with UndefinedBehaviorSanitizer enabled?
self.have_ubsan = False
+ # Are we running with AddressSanitizer enabled?
+ self.have_asan = False
+
# Do symbols use leading underscores?
self.leading_underscore = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1093,6 +1093,9 @@ def have_thread_sanitizer( ) -> bool:
def have_ubsan( ) -> bool:
return config.have_ubsan
+def have_asan( ) -> bool:
+ return config.have_asan
+
def gcc_as_cmmp() -> bool:
return config.cmm_cpp_is_gcc
=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -192,6 +192,9 @@ test('rts_clearMemory', [
extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc', 'sanity']),
# On windows, nonmoving way fails with bad exit code (2816)
when(opsys('mingw32'), fragile(23091)),
+ # For simplicity, ASAN poisoning/unpoisoning logic is omitted
+ # from rts_clearMemory implementation
+ when(have_asan(), skip),
req_c,
pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ],
# Same hack as ffi023
=====================================
testsuite/tests/rts/T18623/all.T
=====================================
@@ -8,6 +8,8 @@ test('T18623',
# Recent versions of osx report an error when running `ulimit -v`
when(opsys('darwin'), skip),
when(arch('powerpc64le'), skip),
+ # ASan can't allocate shadow memory
+ when(have_asan(), skip),
cmd_prefix('ulimit -v ' + str(8 * 1024 ** 2) + ' && '),
ignore_stdout],
run_command,
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -105,6 +105,8 @@ def remove_parenthesis(s):
return re.sub(r'\s+\([^)]*\)', '', s)
test('outofmem', [ when(opsys('darwin'), skip),
+ # ASan shadow memory allocation blows up
+ when(have_asan(), skip),
# this is believed to cause other processes to die
# that happen concurrently while the outofmem test
# runs in CI. As such we'll need to disable it on
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b6529c809eb24851224e06c535e653…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b6529c809eb24851224e06c535e653…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
31 Dec '25
Cheng Shao pushed new branch wip/fix-i386-llvm at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-i386-llvm
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T26709 at Glasgow Haskell Compiler / GHC
Commits:
4b2f2236 by Simon Peyton Jones at 2025-12-30T19:16:12+00:00
Wibble
- - - - -
1 changed file:
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -567,4 +567,4 @@ test('T26349', normal, compile, ['-O -ddump-rules'])
# T26709: we expect three `case` expressions not four
test('T26709', [grep_errmsg(r'case')],
multimod_compile,
- ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
+ ['T26709', '-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b2f2236af8214ccdefdd643d1f2fae…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b2f2236af8214ccdefdd643d1f2fae…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T26709 at Glasgow Haskell Compiler / GHC
Commits:
d772880e by Simon Peyton Jones at 2025-12-30T17:43:05+00:00
Wibble
- - - - -
1 changed file:
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -565,4 +565,6 @@ test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniqu
test('T26349', normal, compile, ['-O -ddump-rules'])
# T26709: we expect three `case` expressions not four
-test('T26709', [grep_errmsg(r'case', ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
+test('T26709', [grep_errmsg(r'case')],
+ multimod_compile,
+ ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d772880e62b5cd6619623f899ffe281…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d772880e62b5cd6619623f899ffe281…
You're receiving this email because of your account on gitlab.haskell.org.
1
0