[Git][ghc/ghc][wip/spj-try-opt-coercion] More refactoring
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/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC
Commits:
86d4cd86 by Simon Peyton Jones at 2025-12-31T10:22:11+00:00
More refactoring
- - - - -
8 changed files:
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Driver/DynFlags.hs
Changes:
=====================================
compiler/GHC/Core/Coercion/Opt.hs
=====================================
@@ -42,13 +42,32 @@ import Control.Monad ( zipWithM )
%* *
%************************************************************************
+Note [Coercion optimisation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This module does coercion optimisation. See the paper
-
Evidence normalization in Systtem FV (RTA'13)
https://simon.peytonjones.org/evidence-normalization/
-
The paper is also in the GHC repo, in docs/opt-coercion.
+However, although powerful and occasionally very effective, coercion optimisation
+can be very expensive (#26679). So we apply it sparingly:
+
+* In the Simplifier, function `rebuild_go`, we use `isReflexiveCo` (which
+ computes the type of the coercion) to eliminate reflexive coercion, just
+ before we build a cast (e |> co).
+
+ (More precisely, we use `isReflexiveCoIgnoringMultiplicity.)
+
+* We have a whole pass, `optCoProgram` that runs the coercion optimiser on all
+ the coercions in the program.
+
+ - We run it once in all optimisation levels
+ (see GHC.Driver.DynFlags.optLevelFlags)
+
+ - We run it early in the optimisation pipeline
+ (see GHC.Core.Opt.Pipeline.getCoreToDo).
+
+
Note [Optimising coercion optimisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Looking up a coercion's role or kind is linear in the size of the
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -227,6 +227,7 @@ getCoreToDo dflags hpt_rule_base extra_vars
-- Optimise coercions
-- With -O do this after one run of the Simplifier.
-- Without -O, just take what the desugarer produced
+ -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt
runWhen do_co_opt CoreOptCoercion,
if full_laziness then
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -161,15 +161,16 @@ following table:
Note [Inline depth]
~~~~~~~~~~~~~~~~~~~
+The seInlineDepth tells us how deep in inlining we are.
+
When we inline an /already-simplified/ unfolding, we
* Zap the substitution environment; the inlined thing is an OutExpr
* Bump the seInlineDepth in the SimplEnv
Both these tasks are done in zapSubstEnv.
-The seInlineDepth tells us how deep in inlining we are. Currently,
-seInlineDepth is used for just one purpose: when we encounter a
-coercion we don't apply optCoercion to it if seInlineDepth>0.
-Reason: it has already been optimised once, no point in doing so again.
+Currently, `seInlineDepth` is entirely unused! (It was previously used to avoid
+repeatedly optimising coercions.) But it's cheap to maintain and might prove
+useful, so I have no removed it.
-}
data SimplEnv
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -27,7 +27,6 @@ import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr )
import qualified GHC.Core.Make
import GHC.Core.Coercion hiding ( substCo, substCoVar )
import GHC.Core.Reduction
-import GHC.Core.Coercion.Opt ( optCoercion )
import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe )
import GHC.Core.DataCon
import GHC.Core.Opt.Stats ( Tick(..) )
@@ -1358,16 +1357,8 @@ simplCoercionF env co cont
simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion
simplCoercion env co
- = do { let opt_co | reSimplifying env = substCo env co
- | otherwise = optCoercion opts subst co
- -- If (reSimplifying env) is True we have already simplified
- -- this coercion once, and we don't want do so again; doing
- -- so repeatedly risks non-linear behaviour
- -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env
- ; seqCo opt_co `seq` return opt_co }
- where
- subst = getTCvSubst env
- opts = seOptCoercionOpts env
+ = do { let out_co = substCo env co
+ ; seqCo out_co `seq` return out_co }
-----------------------------------
-- | Push a TickIt context outwards past applications and cases, as
@@ -1538,15 +1529,13 @@ rebuild_go env expr cont
case cont of
Stop {} -> return (emptyFloats env, expr)
TickIt t cont -> rebuild_go env (mkTick t expr) cont
- CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }
+ CastIt { sc_co = co, sc_cont = cont }
| isReflexiveCoIgnoringMultiplicity co
-- ignoring multiplicity: c.f. GHC.Core.Coercion.Opt.opt_univ
-> rebuild_go env expr cont
| otherwise
- -> rebuild_go env (mkCast expr co') cont
+ -> rebuild_go env (mkCast expr co) cont
-- NB: mkCast implements the (Coercion co |> g) optimisation
- where
- co' = optOutCoercion env co opt
Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }
-> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont
@@ -1645,45 +1634,9 @@ isReflexiveCo
In investigating this I saw missed opportunities for on-the-fly
coercion shrinkage. See #15090.
-
-Note [Avoid re-simplifying coercions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In some benchmarks (with deeply nested cases) we successively push
-casts onto the SimplCont. We don't want to call the coercion optimiser
-on each successive composition -- that's at least quadratic. So:
-
-* The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to
- record whether the coercion optimiser has been applied to the coercion.
-
-* In `simplCast`, when we see (Cast e co), we simplify `co` to get
- an OutCoercion, and built a CastIt with sc_opt=True.
-
- Actually not quite: if we are simplifying the result of inlining an
- unfolding (seInlineDepth > 0), then instead of /optimising/ it again,
- just /substitute/ which is cheaper. See `simplCoercion`.
-
-* In `addCoerce` (in `simplCast`) if we combine this new coercion with
- an existing once, we build a CastIt for (co1 ; co2) with sc_opt=False.
-
-* When unpacking a CastIt, in `rebuildCall` and `rebuild`, we optimise
- the (presumably composed) coercion if sc_opt=False; this is done
- by `optOutCoercion`.
-
-* When duplicating a continuation in `mkDupableContWithDmds`, before
- duplicating a CastIt, optimise the coercion. Otherwise we'll end up
- optimising it separately in the duplicate copies.
-}
-optOutCoercion :: SimplEnvIS -> OutCoercion -> Bool -> OutCoercion
--- See Note [Avoid re-simplifying coercions]
-optOutCoercion env co already_optimised
- | already_optimised = co -- See Note [Avoid re-simplifying coercions]
- | otherwise = optCoercion opts empty_subst co
- where
- empty_subst = mkEmptySubst (seInScope env)
- opts = seOptCoercionOpts env
-
simplCast :: SimplEnv -> InExpr -> InCoercion -> SimplCont
-> SimplM (SimplFloats, OutExpr)
simplCast env body co0 cont0
@@ -1691,27 +1644,25 @@ simplCast env body co0 cont0
; cont1 <- {-#SCC "simplCast-addCoerce" #-}
if isReflCo co1
then return cont0 -- See Note [Optimising reflexivity]
- else addCoerce co1 True cont0
- -- True <=> co1 is optimised
+ else addCoerce co1 cont0
; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 }
where
-
-- If the first parameter is MRefl, then simplifying revealed a
-- reflexive coercion. Omit.
- addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont
- addCoerceM MRefl _ cont = return cont
- addCoerceM (MCo co) opt cont = addCoerce co opt cont
+ addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont
+ addCoerceM MRefl cont = return cont
+ addCoerceM (MCo co) cont = addCoerce co cont
- addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont
- addCoerce co1 _ (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity]
- = addCoerce (mkTransCo co1 co2) False cont
+ addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont
+ addCoerce co1 (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity]
+ = addCoerce (mkTransCo co1 co2) cont
-- False: (mkTransCo co1 co2) is not fully optimised
-- See Note [Avoid re-simplifying coercions]
- addCoerce co co_is_opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })
+ addCoerce co (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })
| Just (arg_ty', m_co') <- pushCoTyArg co arg_ty
= {-#SCC "addCoerce-pushCoTyArg" #-}
- do { tail' <- addCoerceM m_co' co_is_opt tail
+ do { tail' <- addCoerceM m_co' tail
; return (ApplyToTy { sc_arg_ty = arg_ty'
, sc_cont = tail'
, sc_hole_ty = coercionLKind co }) }
@@ -1721,15 +1672,12 @@ simplCast env body co0 cont0
-- where co :: (s1->s2) ~ (t1->t2)
-- co1 :: t1 ~ s1
-- co2 :: s2 ~ t2
- addCoerce co co_is_opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se
- , sc_dup = dup, sc_cont = tail
- , sc_hole_ty = fun_ty })
- | not co_is_opt -- pushCoValArg duplicates the coercion, so optimise first
- = addCoerce (optOutCoercion (zapSubstEnv env) co co_is_opt) True cont
-
+ addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se
+ , sc_dup = dup, sc_cont = tail
+ , sc_hole_ty = fun_ty })
| Just (m_co1, m_co2) <- pushCoValArg co
= {-#SCC "addCoerce-pushCoValArg" #-}
- do { tail' <- addCoerceM m_co2 co_is_opt tail
+ do { tail' <- addCoerceM m_co2 tail
; case m_co1 of {
MRefl -> return (cont { sc_cont = tail'
, sc_hole_ty = coercionLKind co }) ;
@@ -1748,11 +1696,11 @@ simplCast env body co0 cont0
, sc_cont = tail'
, sc_hole_ty = coercionLKind co }) } } }
- addCoerce co co_is_opt cont
+ addCoerce co cont
| isReflCo co = return cont -- Having this at the end makes a huge
-- difference in T12227, for some reason
-- See Note [Optimising reflexivity]
- | otherwise = return (CastIt { sc_co = co, sc_opt = co_is_opt, sc_cont = cont })
+ | otherwise = return (CastIt { sc_co = co, sc_cont = cont })
simplLazyArg :: SimplEnvIS -- ^ Used only for its InScopeSet
-> DupFlag
@@ -3877,11 +3825,9 @@ mkDupableContWithDmds env _ cont
mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont" -- Handled by previous eqn
-mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont })
+mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_cont = cont })
= do { (floats, cont') <- mkDupableContWithDmds env dmds cont
- ; return (floats, CastIt { sc_co = optOutCoercion env co opt
- , sc_opt = True, sc_cont = cont' }) }
- -- optOutCoercion: see Note [Avoid re-simplifying coercions]
+ ; return (floats, CastIt { sc_co = co, sc_cont = cont' }) }
-- Duplicating ticks for now, not sure if this is good or not
mkDupableContWithDmds env dmds (TickIt t cont)
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -164,9 +164,6 @@ data SimplCont
| CastIt -- (CastIt co K)[e] = K[ e `cast` co ]
{ sc_co :: OutCoercion -- The coercion simplified
-- Invariant: never an identity coercion
- , sc_opt :: Bool -- True <=> sc_co has had optCoercion applied to it
- -- See Note [Avoid re-simplifying coercions]
- -- in GHC.Core.Opt.Simplify.Iteration
, sc_cont :: SimplCont }
| ApplyToVal -- (ApplyToVal arg K)[e] = K[ e arg ]
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -30,7 +30,6 @@ import GHC.Core.Unfold.Make
import GHC.Core.Make ( FloatBind(..), mkWildValBinder )
import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs )
import GHC.Core.DataCon
-import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
, isInScope, substTyVarBndr, cloneTyVarBndr )
import GHC.Core.Predicate( isCoVarType )
@@ -113,7 +112,6 @@ See ticket #25790
-- | Simple optimiser options
data SimpleOpts = SimpleOpts
{ so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options
- , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
, so_eta_red :: !Bool -- ^ Eta reduction on?
, so_inline :: !Bool -- ^ False <=> do no inlining whatsoever,
-- even for trivial or used-once things
@@ -123,7 +121,6 @@ data SimpleOpts = SimpleOpts
defaultSimpleOpts :: SimpleOpts
defaultSimpleOpts = SimpleOpts
{ so_uf_opts = defaultUnfoldingOpts
- , so_co_opts = OptCoercionOpts { optCoercionEnabled = False }
, so_eta_red = False
, so_inline = True
}
@@ -288,7 +285,7 @@ simple_opt_expr env expr = go expr
go e@(Lam {}) = simple_app env e []
go (Type ty) = Type (substTyUnchecked subst ty)
- go (Coercion co) = Coercion (go_co co)
+ go (Coercion co) = Coercion (simple_opt_co env co)
go (Lit lit) = Lit lit
go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)
go (Let bind body) = case simple_opt_bind env bind NotTopLevel of
@@ -323,15 +320,15 @@ simple_opt_expr env expr = go expr
e' = go e
(env', b') = subst_opt_bndr env b
- ----------------------
- go_co co = optCoercion (so_co_opts (soe_opts env)) subst co
-
----------------------
go_alt env (Alt con bndrs rhs)
= Alt con bndrs' (simple_opt_expr env' rhs)
where
(env', bndrs') = subst_opt_bndrs env bndrs
+simple_opt_co :: SimpleOptEnv -> InCoercion -> OutCoercion
+simple_opt_co env co = substCo (soe_subst env) co
+
mk_cast :: CoreExpr -> CoercionR -> CoreExpr
-- Like GHC.Core.Utils.mkCast, but does a full reflexivity check.
-- mkCast doesn't do that because the Simplifier does (in simplCast)
@@ -471,7 +468,7 @@ add_cast env co1 as
CastIt co2:rest -> CastIt (co1' `mkTransCo` co2):rest
_ -> CastIt co1':as
where
- co1' = optCoercion (so_co_opts (soe_opts env)) (soe_subst env) co1
+ co1' = simple_opt_co env co1
rebuild_app :: HasDebugCallStack
=> SimpleOptEnv -> OutExpr -> [SimpleContItem] -> OutExpr
@@ -606,7 +603,7 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opt
(env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)
| Coercion co <- in_rhs
- , let out_co = optCoercion (so_co_opts (soe_opts env)) (soe_subst rhs_env) co
+ , let out_co = simple_opt_co rhs_env co
= assert (isCoVar in_bndr)
(env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)
=====================================
compiler/GHC/Driver/Config.hs
=====================================
@@ -24,7 +24,6 @@ initOptCoercionOpts dflags = OptCoercionOpts
initSimpleOpts :: DynFlags -> SimpleOpts
initSimpleOpts dflags = SimpleOpts
{ so_uf_opts = unfoldingOpts dflags
- , so_co_opts = initOptCoercionOpts dflags
, so_eta_red = gopt Opt_DoEtaReduction dflags
, so_inline = True
}
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1236,7 +1236,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
, ([1,2], Opt_DoCleverArgEtaExpansion) -- See Note [Eta expansion of arguments in CorePrep]
, ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0]
, ([0,1,2], Opt_ProfManualCcs )
- , ([0,1,2], Opt_OptCoercion )
+ , ([0,1,2], Opt_OptCoercion ) -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt
, ([2], Opt_DictsStrict)
, ([0], Opt_IgnoreInterfacePragmas)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86d4cd861572e6a901098a7fc6ea77d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86d4cd861572e6a901098a7fc6ea77d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-try-opt-coercion] 63 commits: compiler: remove unused CPP code in foreign stub
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/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC
Commits:
d99f8326 by Cheng Shao at 2025-12-11T19:14:18-05:00
compiler: remove unused CPP code in foreign stub
This patch removes unused CPP code in the generated foreign stub:
- `#define IN_STG_CODE 0` is not needed, since `Rts.h` already
includes this definition
- The `if defined(__cplusplus)` code paths are not needed in the `.c`
file, since we don't generate C++ stubs and don't include C++
headers in our stubs. But it still needs to be present in the `.h`
header since it might be later included into C++ source files.
- - - - -
46c9746f by Cheng Shao at 2025-12-11T19:14:57-05:00
configure: bump LlvmMaxVersion to 22
This commit bumps LlvmMaxVersion to 22; 21.x releases have been
available since Aug 26th, 2025 and there's no regressions with 21.x so
far. This bump is also required for updating fedora image to 43.
- - - - -
96fce8d0 by Cheng Shao at 2025-12-12T01:17:51+01:00
hadrian: add support for building with UndefinedBehaviorSanitizer
This patch adds a +ubsan flavour transformer to hadrian to build all
stage1+ C/C++ code with UndefinedBehaviorSanitizer. This is
particularly useful to catch potential undefined behavior in the RTS
codebase.
- - - - -
f7a06d8c by Cheng Shao at 2025-12-12T01:17:51+01:00
ci: update alpine/fedora & add ubsan job
This patch updates alpine image to 3.23, fedora image to 43, and adds
a `x86_64-linux-fedora43-validate+debug_info+ubsan` job that's run in
validate/nightly pipelines to catch undefined behavior in the RTS
codebase.
- - - - -
2ccd11ca by Cheng Shao at 2025-12-12T01:17:51+01:00
rts: fix zero-length VLA undefined behavior in interpretBCO
This commit fixes a zero-length VLA undefined behavior in interpretBCO, caught by UBSan:
```
+rts/Interpreter.c:3133:19: runtime variable length array bound evaluates to non-positive value 0
```
- - - - -
4156ed19 by Cheng Shao at 2025-12-12T01:17:51+01:00
rts: fix unaligned ReadSpB in interpretBCO
This commit fixes unaligned ReadSpB in interpretBCO, caught by UBSan:
```
+rts/Interpreter.c:2174:64: runtime load of misaligned address 0x004202059dd1 for type 'StgWord', which requires 8 byte alignment
```
To perform proper unaligned read, we define StgUnalignedWord as a type
alias of StgWord with aligned(1) attribute, and load StgUnalignedWord
instead of StgWord in ReadSpB, so the C compiler is aware that we're
not loading with natural alignment.
- - - - -
fef89fb9 by Cheng Shao at 2025-12-12T01:17:51+01:00
rts: fix signed integer overflow in subword arithmetic in interpretBCO
This commit fixes signed integer overflow in subword arithmetic in
interpretBCO, see added note for detailed explanation.
- - - - -
3c001377 by Cheng Shao at 2025-12-13T05:03:15-05:00
ci: use treeless fetch for perf notes
This patch improves the ci logic for fetching perf notes by using
treeless fetch
(https://github.blog/open-source/git/get-up-to-speed-with-partial-clone-and-…)
to avoid downloading all blobs of the perf notes repo at once, and
only fetch the actually required blobs on-demand when needed. This
makes the initial `test-metrics.sh pull` operation much faster, and
also more robust, since we are seeing an increasing rate of 504 errors
in CI when fetching all perf notes at once, which is a major source of
CI flakiness at this point.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
123a8d77 by Peter Trommler at 2025-12-13T05:03:57-05:00
Cmm: remove restriction in MachOp folding
- - - - -
0b54b5fd by Andreas Klebinger at 2025-12-13T05:04:38-05:00
Remove explicit Typeable deriviations.
- - - - -
08b13f7b by Cheng Shao at 2025-12-13T05:05:18-05:00
ci: set gc.auto=0 during setup stage
This patch sets `gc.auto=0` during `setup` stage of CI, see added
comment for detailed explanation.
- - - - -
3b5aecb5 by Ben Gamari at 2025-12-13T23:43:10+01:00
Bump exceptions submodule to 0.10.11
- - - - -
c32de3b0 by Johan Förberg at 2025-12-15T02:36:03-05:00
base: Define Semigroup and Monoid instances for lazy ST
CLC proposal:
https://github.com/haskell/core-libraries-committee/issues/374
Fixes #26581
- - - - -
4f8b660c by mangoiv at 2025-12-15T02:37:05-05:00
ci: do not require nightly cabal-reinstall job to succeed
- - - - -
2c2a3ef3 by Cheng Shao at 2025-12-15T11:51:53-05:00
docs: drop obsolete warning about -fexternal-interpreter on windows
This patch drops an obsolete warning about -fexternal-interpreter not
supported on windows; it is supported since a long time ago, including
the profiled way.
- - - - -
68573aa5 by Marc Scholten at 2025-12-15T11:53:00-05:00
haddock: Drop Haddock.Backends.HaddockDB as it's unused
- - - - -
b230d549 by mangoiv at 2025-12-16T15:17:45-05:00
base: generalize delete{Firsts,}By
When we delete{Firsts,}By we should not require the
lists to be the same type. This is an especially useful
generalisation in the case of deleteFirstsBy because we
can skip an invocation of the map function.
This change was discussed on the core-libraries-committee's bug
tracker at https://github.com/haskell/core-libraries-committee/issues/372.
- - - - -
6a2b43e3 by Cheng Shao at 2025-12-16T15:18:30-05:00
compiler: clean up redundant LANGUAGE pragmas
This patch bumps `default-language` of `ghc`/`ghc-bin` from `GHC2021`
to `GHC2024` (which is supported in ghc 9.10, current boot ghc lower
version bound), and also cleans up redundant `LANGUAGE` pragmas (as
well as `default-extensions`/`other-extensions`) that are already
implied by `GHC2024`.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
fca9cd7c by sheaf at 2025-12-18T13:18:18-05:00
X86 CodeGen: fix assign_eax_sse_regs
We must set %al to the number of SSE2 registers that contain arguments
(in case we are dealing with a varargs function). The logic for counting
how many arguments reside in SSE2 registers was incorrect, as it used
'isFloatFormat', which incorrectly ignores vector registers.
We now instead do case analysis on the register class:
is_sse_reg r =
case targetClassOfReg platform r of
RcFloatOrVector -> True
RcInteger -> False
This change is necessary to prevent segfaults in T20030_test1j, because
subsequent commits change the format calculations, resulting in vector
formats more often.
- - - - -
53150617 by sheaf at 2025-12-18T13:18:19-05:00
X86 regUsageOfInstr: fix format for IMUL
When used with 8-bit operands, the IMUL instruction returns the result
in the lower 16 bits of %rax (also known as %ax). This is different
than for the other sizes, where an input at 16, 32 or 64 bits will
result in 16, 32 or 64 bits of output in both %rax and %rdx.
This doesn't affect the behaviour of the compiler, because we don't
allow partial writes at sub-word sizes. The rationale is explained
in Wrinkle [Don't allow scalar partial writes] in Note [Register formats in liveness analysis],
in GHC.CmmToAsm.Reg.Liveness.
- - - - -
c7a56dd1 by sheaf at 2025-12-18T13:18:19-05:00
Liveness analysis: consider register formats
This commit updates the register allocator to be a bit more careful in
situations in which a single register is used at multiple different
formats, e.g. when xmm1 is used both to store a Double# and a DoubleX2#.
This is done by introducing the 'Regs' newtype around 'UniqSet RegWithFormat',
for which the combining operations take the larger of the two formats
instead of overriding the format.
Operations on 'Regs' are defined in 'GHC.CmmToAsm.Reg.Regs'. There is
a modest compile-time cost for the additional overhead for tracking
register formats, which causes the metric increases of this commit.
The subtle aspects of the implementation are outlined in
Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness.
Fixes #26411 #26611
-------------------------
Metric Increase:
T12707
T26425
T3294
-------------------------
- - - - -
c2e83339 by sheaf at 2025-12-18T13:18:19-05:00
Register allocator: reload at same format as spill
This commit ensures that if we spill a register onto the stack at a
given format, we then always reload the register at this same format.
This ensures we don't end up in a situation where we spill F64x2 but end
up only reloading the lower F64. This first reload would make us believe
the whole data is in a register, thus silently losing the upper 64 bits
of the spilled register's contents.
Fixes #26526
- - - - -
55ab583b by sheaf at 2025-12-18T13:18:19-05:00
Register allocation: writes redefine format
As explained in Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear,
we consider all writes to redefine the format of the register.
This ensures that in a situation such as
movsd .Ln6m(%rip),%v1
shufpd $0,%v1,%v1
we properly consider the broadcast operation to change the format of %v1
from F64 to F64x2.
This completes the fix to #26411 (test in T26411b).
- - - - -
951402ed by Vladislav Zavialov at 2025-12-18T13:19:05-05:00
Parser: improve mkModuleImpExp, remove checkImportSpec
1. The `mkModuleImpExp` helper now knows whether it is processing an import or
export list item, and uses this information to produce a more accurate error
message for `import M (T(..,x))` with PatternSynonyms disabled.
The old message incorrectly referred to this case as an export form.
2. The `checkImportSpec` helper is removed in favor of more comprehensive error
checking in `mkModuleImpExp`.
3. Additionaly, the invariants of `ImpExpList` and `ImpExpAllWith` have been
made more explicit in the comments and assertions (calls to 'panic').
Test case: import-syntax-no-ext
- - - - -
47d83d96 by Vladislav Zavialov at 2025-12-18T13:19:06-05:00
Subordinate namespace-specified wildcards (#25901)
Add support for subordinate namespace-specified wildcards
`X(type ..)` and `X(data ..)` to import and export lists.
Examples:
import M (Cls(type ..)) -- imports Cls and all its associated types
import M (Cls(data ..)) -- imports Cls and all its methods
module M (R(data ..), C(type ..)) where
-- exports R and all its data constructors and record fields;
-- exports C and all its associated types, but not its methods
The scope of this change is limited to the case where the wildcard is the only
subordinate import/export item, whereas the more complex forms `X(type .., f)`
or `X(type .., data ..)` are unsupported and raise the newly introduced
PsErrUnsupportedExplicitNamespace error. This restriction may be lifted later.
Summary of the changes:
1. Refactor IEThingAll to store its extension field XIEThingAll as a record
IEThingAllExt instead of a tuple.
2. Extend the AST by adding a NamespaceSpecifier field to IEThingAllExt,
representing an optional namespace specifier `type` or `data` in front
of a subordinate wildcard `X(..)`.
3. Extend the grammar in Parser.y with productions for `type ..` and `data ..`
in subordinate import/export items.
4. Introduce `filterByNamespaceGREs` to filter [GlobalRdrElt] by a
NamespaceSpecifier; use it in `filterImports` and `exports_from_avail`
to account for the namespace specifier in IEThingAll.
5. Improve diagnostics by storing more information in DodgyImportsEmptyParent
and DodgyExportsEmptyParent.
Test cases:
T25901_sub_e T25901_sub_f T25901_sub_g T25901_sub_a
T25901_sub_b T25901_sub_c T25901_sub_d T25901_sub_w
DodgyImports02 DodgyImports03 DodgyImports04
- - - - -
eac418bb by Recursion Ninja at 2025-12-18T13:19:48-05:00
Removing the 'Data' instance for 'InstEnv'.
The 'Data' instance is blocking work on Trees that Grow, and the
'Data' instance seem to have been added without a clear purpose.
- - - - -
e920e038 by Recursion Ninja at 2025-12-18T13:19:48-05:00
'Decouple Language.Haskell.Syntax.Decls' from 'GHC.Unit.Module.Warnings'
- - - - -
bd38b76c by Cheng Shao at 2025-12-18T13:20:31-05:00
testsuite: improve coverage of foundation test
This patch refactors the `foundation` test a bit to improve coverage:
- Instead of using a hard-coded seed, a random seed is now taken from
the command line, and printed upon test failure. This improves test
coverage over many future CI runs, and shall a failure occur, the
seed is available in the CI log for local reproduction.
- The iterations count is bumped to 1000 instead of 100, similar to
the bump in `test-primops`. Runtime timeout is bumped 2x just to be
safe.
- Improve `newLCGGen` by using non-atomic loads/stores on a
`MutableByteArray#` for storing mutable `Word64`, this test doesn't
use parallelism in the first place
- Fixed a few compiler warnings and removed redundant pragmas and
imports
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
3995187c by Sylvain Henry at 2025-12-18T13:21:45-05:00
Doc: document -pgmi "" (#26634)
- - - - -
5729418c by Cheng Shao at 2025-12-18T13:22:29-05:00
rts: use __builtin_mul_overflow for hs_mulIntMayOflo
This patch uses `__builtin_mul_overflow` to implement
`hs_mulIntMayOflo`. This is a GNU C checked arithmetic builtin
function supported by gcc/clang, is type-generic so works for both
32-bit/64-bit, and makes the code both more efficient and easier to
read/maintain than the previous hand rolled logic.
- - - - -
1ca4b49a by Cheng Shao at 2025-12-18T13:23:11-05:00
compiler/rts: fix ABI mismatch in barf() invocations
This patch fixes a long-standing issue of ABI mismatch in `barf()`
invocations, both in compiler-emitted code and in hand written Cmm
code:
- In RTS, we have `barf()` which reports a fatal internal error
message and exits the program.
- `barf()` is a variadic C function! When used as a callee of a
foreign call with `ccall` calling convention instead of `capi`,
there is an ABI mismatch between the caller and the callee!
- Unfortunately, both the compiler and the Cmm sources contain many
places where we call `barf()` via `ccall` convention!! Like, when
you write `foreign "C" barf("foo object (%p) entered!", R1)`, it
totally doesn't do what you think it'll do at all!! The second
argument `R1` is not properly passed in `va_list`, and the behavior
is completely undefined!!
- Even more unfortunately, this issue has been sitting around long
enough because the ABI mismatch is subtle enough on normie platforms
like x64 and arm64.
- But there are platforms like wasm32 that are stricter about ABI, and
the broken `barf()` invocations already causes trouble for wasm
backend: we had to use ugly hacks like `barf(errmsg, NULL)` to make
`wasm-ld` happy, and even with this band-aid, compiler-generated
`barf()` invocations are still broken, resulting in regressions in
certain debug-related functionality, e.g. `-dtag-inference-checks`
is broken on wasm32 (#22882).
This patch properly fixes the issue:
- We add non-variadic `barf` wrappers in the RTS that can be used as
`ccall` callees
- Both the compiler `emitBarf` logic and the hand-written Cmm are
changed to call these wrappers
- `emitBarf` now also properly annotates the foreign call as
`CmmNeverReturns` to indicate it's a noreturn call to enable more
efficient code generation
`-dtag-inference-checks` now works on wasm. Closes #22882.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
b3dd23b9 by Vilim Lendvaj at 2025-12-18T13:23:57-05:00
Remove outdated comment
The Traversable instance for ZipList is no longer in
GHC.Internal.Data.Traversable. In fact, it is right below this very comment.
- - - - -
9a9c2f03 by Cheng Shao at 2025-12-18T13:24:39-05:00
compiler: remove unused OtherSection logic
This patch removes the OtherSection logic in Cmm, given it's never
actually used by any of our backends.
- - - - -
91edd292 by Wolfgang Jeltsch at 2025-12-19T03:18:19-05:00
Remove unused known-key and name variables for generics
This removes the known-key and corresponding name variables for `K1`,
`M1`, `R`, `D`, `C`, `S`, and `URec` from `GHC.Generics`, as they are
apparently nowhere used in GHC’s source code.
- - - - -
73ee7e38 by Wolfgang Jeltsch at 2025-12-19T03:19:02-05:00
Remove unused known keys and names for generics classes
This removes the known-key and corresponding name variables for
`Datatype`, `Constructor`, and `Selector` from `GHC.Generics`, as they
are apparently nowhere used in GHC’s source code.
- - - - -
f69c5f14 by Cheng Shao at 2025-12-19T03:19:45-05:00
wasm: fix handling of ByteArray#/MutableByteArray# arguments in JSFFI imports
This patch fixes the handling of ByteArray#/MutableByteArray#
arguments in JSFFI imports, see the amended note and manual for
explanation. Also adds a test to witness the fix.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
224446a2 by Cheng Shao at 2025-12-20T07:49:54-05:00
rts: workaround -Werror=maybe-uninitialized false positives
In some cases gcc might report -Werror=maybe-uninitialized that we
know are false positives, but need to workaround it to make validate
builds with -Werror pass.
- - - - -
251ec087 by Cheng Shao at 2025-12-20T07:49:54-05:00
hadrian: use -Og as C/C++ optimization level when debugging
This commit enables -Og as optimization level when compiling the debug
ways of rts. According to gcc documentation
(https://gcc.gnu.org/onlinedocs/gcc/Optimize-Options.html#index-Og)
-Og is a better choice than -O0 for producing debuggable code. It's
also supported by clang as well, so it makes sense to use it as a
default for debugging. Also add missing -g3 flag to C++ compilation
flags in +debug_info flavour transformer.
- - - - -
fb586c67 by Cheng Shao at 2025-12-20T07:50:36-05:00
compiler: replace DList with OrdList
This patch removes `DList` logic from the compiler and replaces it
with `OrdList` which also supports O(1) concatenation and should be
more memory efficient than the church-encoded `DList`.
- - - - -
8149c987 by Cheng Shao at 2025-12-20T17:06:51-05:00
hadrian: add with_profiled_libs flavour transformer
This patch adds a `with_profiled_libs` flavour transformer to hadrian
which is the exact opposite of `no_profiled_libs`. It adds profiling
ways to stage1+ rts/library ways, and doesn't alter other flavour
settings. It is useful when needing to test profiling logic locally
with a quick flavour.
- - - - -
746b18cd by Cheng Shao at 2025-12-20T17:06:51-05:00
hadrian: fix missing profiled dynamic libraries in profiled_ghc
This commit fixes the profiled_ghc flavour transformer to include
profiled dynamic libraries as well, since they're supported by GHC
since !12595.
- - - - -
4dd7e3b9 by Cheng Shao at 2025-12-20T17:07:33-05:00
ci: set http.postBuffer to mitigate perf notes timeout on some runners
This patch sets http.postBuffer to mitigate the timeout when fetching
perf notes on some runners with slow internet connection. Fixes #26684.
- - - - -
bc36268a by Wolfgang Jeltsch at 2025-12-21T16:23:24-05:00
Remove unused known keys and names for type representations
This removes the known-key and corresponding name variables for
`TrName`, `TrNameD`, `TypeRep`, `KindRepTypeLitD`, `TypeLitSort`, and
`mkTrType`, as they are apparently nowhere used in GHC’s source code.
- - - - -
ff5050e9 by Wolfgang Jeltsch at 2025-12-21T16:24:04-05:00
Remove unused known keys and names for natural operations
This removes the known-key and corresponding name variables for
`naturalAndNot`, `naturalLog2`, `naturalLogBaseWord`, `naturalLogBase`,
`naturalPowMod`, `naturalSizeInBase`, `naturalToFloat`, and
`naturalToDouble`, as they are apparently nowhere used in GHC’s source
code.
- - - - -
424388c2 by Wolfgang Jeltsch at 2025-12-21T16:24:45-05:00
Remove the unused known key and name for `Fingerprint`
This removes the variables for the known key and the name of the
`Fingerprint` data constructor, as they are apparently nowhere used in
GHC’s source code.
- - - - -
a1ed86fe by Wolfgang Jeltsch at 2025-12-21T16:25:26-05:00
Remove the unused known key and name for `failIO`
This removes the variables for the known key and the name of the
`failIO` operation, as they are apparently nowhere used in GHC’s source
code.
- - - - -
b8220daf by Wolfgang Jeltsch at 2025-12-21T16:26:07-05:00
Remove the unused known key and name for `liftM`
This removes the variables for the known key and the name of the `liftM`
operation, as they are apparently nowhere used in GHC’s source code.
- - - - -
eb0628b1 by Wolfgang Jeltsch at 2025-12-21T16:26:47-05:00
Fix the documentation of `hIsClosed`
- - - - -
db1ce858 by sheaf at 2025-12-22T17:11:17-05:00
Do deep subsumption when computing valid hole fits
This commit makes a couple of improvements to the code that
computes "valid hole fits":
1. It uses deep subsumption for data constructors.
This matches up the multiplicities, as per
Note [Typechecking data constructors].
This fixes #26338 (test: LinearHoleFits).
2. It now suggests (non-unidirectional) pattern synonyms as valid
hole fits. This fixes #26339 (test: PatSynHoleFit).
3. It uses 'stableNameCmp', to make the hole fit output deterministic.
-------------------------
Metric Increase:
hard_hole_fits
-------------------------
- - - - -
72ee9100 by sheaf at 2025-12-22T17:11:17-05:00
Speed up hole fits with a quick pre-test
This speeds up the machinery for valid hole fits by doing a small
check to rule out obviously wrong hole fits, such as:
1. A hole fit identifier whose type has a different TyCon at the head,
after looking through foralls and (=>) arrows, e.g.:
hole_ty = Int
cand_ty = Maybe a
or
hole_ty = forall a b. a -> b
cand_ty = forall x y. Either x y
2. A hole fit identifier that is not polymorphic when the hole type
is polymorphic, e.g.
hole_ty = forall a. a -> a
cand_ty = Int -> Int
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
- - - - -
30e513ba by Cheng Shao at 2025-12-22T17:12:00-05:00
configure: remove unused win32-tarballs.md5sum
This patch removes the unused `win32-tarballs.md5sum` file from the
tree. The current mingw tarball download logic in
`mk/get-win32-tarballs.py` fetches and checks against `SHA256SUM` from
the same location where the tarballs are fetched, and this file has
been unused for a few years.
- - - - -
a2d52b3b by Wolfgang Jeltsch at 2025-12-23T04:47:33-05:00
Add an operation `System.IO.hGetNewlineMode`
This commit also contains some small code and documentation changes for
related operations, for the sake of consistency.
- - - - -
b26d134a by Cheng Shao at 2025-12-23T04:48:15-05:00
rts: opportunistically reclaim slop space in shrinkMutableByteArray#
Previously, `shrinkMutableByteArray#` shrinks a `MutableByteArray#`
in-place by assigning the new size to it, and zeroing the extra slop
space. That slop space is not reclaimed and wasted. But it's often the
case that we allocate a `MutableByteArray#` upfront, then shrink it
shortly after, so the `MutableByteArray#` closure sits right at the
end of a nursery block; this patch identifies such chances, and also
shrink `bd->free` if possible, reducing heap space fragmentation.
Co-authored-by: Codex <codex(a)openai.com>
-------------------------
Metric Decrease:
T10678
-------------------------
- - - - -
c72ddabf by Cheng Shao at 2025-12-23T16:13:23-05:00
hadrian: fix bootstrapping with ghc-9.14
This patch fixes bootstrapping GHC with ghc-9.14, tested locally with
ghc-9.14.1 release as bootstrapping GHC.
- - - - -
0fd6d8e4 by Cheng Shao at 2025-12-23T16:14:05-05:00
hadrian: pass -keep-tmp-files to test ghc when --keep-test-files is enabled
This patch makes hadrian pass `-keep-tmp-files` to test ghc when
`--keep-test-files` is enabled, so you can check the ghc intermediate
files when debugging certain test failures. Closes #26688.
- - - - -
81d10134 by Cheng Shao at 2025-12-24T06:11:52-05:00
configure: remove dead code in configure scripts
This patch removes dead code in our configure scripts, including:
- Variables and auto-detected programs that are not used
- autoconf functions that are not used, or export a variable that's
not used
- `AC_CHECK_HEADERS` invocations that don't have actual corresponding
`HAVE_XXX_H` usage
- Other dead code (e.g. stray `AC_DEFUN()`)
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
fb1381c3 by Wolfgang Jeltsch at 2025-12-24T06:12:34-05:00
Remove unused known keys and names for list operations
This removes the known-key and corresponding name variables for
`concat`, `filter`, `zip`, and `(++)`, as they are apparently nowhere
used in GHC’s source code.
- - - - -
7b9c20f4 by Recursion Ninja at 2025-12-24T10:35:36-05:00
Decoupling Language.Haskell.Syntax.Binds from GHC.Types.Basic
by transferring InlinePragma types between the modules.
* Moved InlinePragma data-types to Language.Haskell.Syntax.Binds.InlinePragma
* Partitioned of Arity type synonyms to GHC.Types.Arity
* InlinePragma is now extensible via Trees That Grow
* Activation is now extensible via Trees That Grow
* Maybe Arity change to more descriptive InlineSaturation data-type
* InlineSaturation information removed from InlinePragma during GHS parsing pass
* Cleaned up the exposed module interfaces of the new modules
- - - - -
a3afae0c by Simon Peyton Jones at 2025-12-25T15:26:36-05:00
Check for rubbish literals in Lint
Addresses #26607.
See new Note [Checking for rubbish literals] in GHC.Core.Lint
- - - - -
d4f9bca2 by Simon Peyton Jones at 2025-12-31T09:42:07+00:00
Experiment with switching off optCoercion entirely
- - - - -
90438e6f by Simon Peyton Jones at 2025-12-31T09:42:07+00:00
Do isReflexiveCo in the Simplifier
- - - - -
05873d95 by Simon Peyton Jones at 2025-12-31T09:42:07+00:00
Make coercion optimisation into its own pass
In this MR:
* -fopt-coercion / -fno-opt-coercion switches the pass on and off
* -fopt-coercion is on by default
* The pass runs just once, right at the start of the pipeline
- - - - -
34995b98 by Simon Peyton Jones at 2025-12-31T09:42:07+00:00
Update user manual
- - - - -
638 changed files:
- .gitattributes
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- .gitlab/test-metrics.sh
- compiler/GHC.hs
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/PrimOps/Ids.hs
- compiler/GHC/Builtin/Types/Literals.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/BlockId.hs
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Config.hs
- compiler/GHC/Cmm/ContFlowOpt.hs
- compiler/GHC/Cmm/Dataflow.hs
- compiler/GHC/Cmm/Dataflow/Block.hs
- compiler/GHC/Cmm/Dataflow/Graph.hs
- compiler/GHC/Cmm/Dataflow/Label.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/Cmm/Dominators.hs
- compiler/GHC/Cmm/Expr.hs
- compiler/GHC/Cmm/Graph.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/LRegSet.hs
- compiler/GHC/Cmm/LayoutStack.hs
- compiler/GHC/Cmm/Lint.hs
- compiler/GHC/Cmm/Liveness.hs
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/ProcPoint.hs
- compiler/GHC/Cmm/Reducibility.hs
- compiler/GHC/Cmm/Reg.hs
- compiler/GHC/Cmm/Sink.hs
- compiler/GHC/Cmm/Switch.hs
- compiler/GHC/Cmm/Switch/Implement.hs
- compiler/GHC/Cmm/ThreadSanitizer.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/BlockLayout.hs
- compiler/GHC/CmmToAsm/CFG.hs
- compiler/GHC/CmmToAsm/CPrim.hs
- compiler/GHC/CmmToAsm/Dwarf/Types.hs
- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/CmmToAsm/Monad.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/CmmToAsm/Reg/Graph.hs
- compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
- compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Linear/State.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- + compiler/GHC/CmmToAsm/Reg/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Target.hs
- compiler/GHC/CmmToAsm/Wasm.hs
- compiler/GHC/CmmToAsm/Wasm/Asm.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/Wasm/Types.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion.hs-boot
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Core/LateCC/OverloadedCalls.hs
- compiler/GHC/Core/LateCC/TopLevelBinds.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Lint/Interactive.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Map/Type.hs
- compiler/GHC/Core/Opt/CSE.hs
- compiler/GHC/Core/Opt/CallerCC.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Pipeline/Types.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/TyCon/Env.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Type.hs-boot
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/Data/Bag.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/Graph/Collapse.hs
- compiler/GHC/Data/Graph/Color.hs
- compiler/GHC/Data/Graph/Directed.hs
- compiler/GHC/Data/List/Infinite.hs
- compiler/GHC/Data/List/NonEmpty.hs
- compiler/GHC/Data/Maybe.hs
- compiler/GHC/Data/Pair.hs
- compiler/GHC/Data/Stream.hs
- compiler/GHC/Data/Strict.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Data/Word64Map.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/CmdLine.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Core/Lint/Interactive.hs
- compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Config/Tidy.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/KnotVars.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeSem.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Pipeline/LogQueue.hs
- compiler/GHC/Driver/Pipeline/Monad.hs
- compiler/GHC/Driver/Pipeline/Phases.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Basic.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Doc.hs-boot
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Pat.hs-boot
- compiler/GHC/Hs/Stats.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/Decl.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Check.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Pmc/Types.hs
- compiler/GHC/HsToCore/Pmc/Utils.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Env.hs
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Debug.hs
- compiler/GHC/Iface/Ext/Types.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Iface/Warnings.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/JS/Ident.hs
- compiler/GHC/JS/JStg/Monad.hs
- compiler/GHC/JS/JStg/Syntax.hs
- compiler/GHC/JS/Make.hs
- compiler/GHC/JS/Optimizer.hs
- compiler/GHC/JS/Ppr.hs
- compiler/GHC/JS/Syntax.hs
- compiler/GHC/JS/Transform.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Llvm/MetaData.hs
- compiler/GHC/Llvm/Ppr.hs
- compiler/GHC/Llvm/Types.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Basic.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/Parser/Types.hs
- compiler/GHC/Platform.hs
- compiler/GHC/Platform/Reg/Class.hs
- compiler/GHC/Platform/Reg/Class/NoVectors.hs
- compiler/GHC/Platform/Reg/Class/Separate.hs
- compiler/GHC/Platform/Reg/Class/Unified.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Expr.hs-boot
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Heap/Layout.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/JS.hs
- compiler/GHC/Runtime/Interpreter/Process.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Runtime/Interpreter/Types/SymbolCache.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Stg/EnforceEpt.hs
- compiler/GHC/Stg/EnforceEpt/Rewrite.hs
- compiler/GHC/Stg/EnforceEpt/TagSig.hs
- compiler/GHC/Stg/EnforceEpt/Types.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/Stg/Lift/Analysis.hs
- compiler/GHC/Stg/Lift/Monad.hs
- compiler/GHC/Stg/Lift/Types.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/Stg/Pipeline.hs
- compiler/GHC/Stg/Syntax.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/Stg/Utils.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/ArgRep.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/CgUtils.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/ExtCode.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/StgToCmm/Monad.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Arg.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/DataCon.hs
- compiler/GHC/StgToJS/Deps.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/ExprCtx.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/StgToJS/Heap.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Linker/Opt.hs
- compiler/GHC/StgToJS/Linker/Types.hs
- compiler/GHC/StgToJS/Literal.hs
- compiler/GHC/StgToJS/Monad.hs
- compiler/GHC/StgToJS/Object.hs
- compiler/GHC/StgToJS/Rts/Rts.hs
- compiler/GHC/StgToJS/Rts/Types.hs
- compiler/GHC/StgToJS/Sinker/Collect.hs
- compiler/GHC/StgToJS/Sinker/Sinker.hs
- compiler/GHC/StgToJS/Sinker/StringsUnfloat.hs
- compiler/GHC/StgToJS/Types.hs
- compiler/GHC/StgToJS/Utils.hs
- compiler/GHC/SysTools.hs
- compiler/GHC/SysTools/Ar.hs
- compiler/GHC/SysTools/BaseDir.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/SysTools/Terminal.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Functor.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Hole/FitTypes.hs
- compiler/GHC/Tc/Errors/Hole/Plugin.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Errors/Types/PromotionErr.hs
- compiler/GHC/Tc/Gen/Annotation.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Irred.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/Monad.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Annotations.hs
- + compiler/GHC/Types/Arity.hs
- compiler/GHC/Types/Avail.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/CompleteMatch.hs
- compiler/GHC/Types/CostCentre.hs
- compiler/GHC/Types/CostCentre/State.hs
- compiler/GHC/Types/DefaultEnv.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/FieldLabel.hs
- compiler/GHC/Types/Fixity.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/ForeignStubs.hs
- compiler/GHC/Types/GREInfo.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- + compiler/GHC/Types/InlinePragma.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Name.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/Name/Set.hs
- compiler/GHC/Types/PkgQual.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/SaneDouble.hs
- compiler/GHC/Types/SourceText.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Unique/Map.hs
- compiler/GHC/Types/Unique/SDFM.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit.hs
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/Module.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/GHC/Unit/Module/Warnings.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
- compiler/GHC/Unit/Types.hs-boot
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Binary/Typeable.hs
- compiler/GHC/Utils/Exception.hs
- compiler/GHC/Utils/Json.hs
- compiler/GHC/Utils/Logger.hs
- compiler/GHC/Utils/Misc.hs
- compiler/GHC/Utils/Monad/Codensity.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/GHC/Utils/Panic.hs
- compiler/GHC/Utils/Panic/Plain.hs
- compiler/GHC/Wasm/ControlFlow.hs
- compiler/GHC/Wasm/ControlFlow/FromCmm.hs
- compiler/Language/Haskell/Syntax.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- + compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Expr.hs-boot
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/Language/Haskell/Syntax/Pat.hs-boot
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- configure.ac
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/ghci.rst
- docs/users_guide/phases.rst
- docs/users_guide/using-optimisation.rst
- docs/users_guide/wasm.rst
- ghc/GHC/Driver/Session/Lint.hs
- ghc/GHC/Driver/Session/Mode.hs
- ghc/GHCi/Leak.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Info.hs
- ghc/GHCi/UI/Monad.hs
- ghc/Main.hs
- ghc/ghc-bin.cabal.in
- hadrian/cabal.project
- hadrian/doc/flavours.md
- hadrian/src/Flavour.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Oracles/ArgsHash.hs
- hadrian/src/Hadrian/Oracles/Cabal/Type.hs
- hadrian/src/Hadrian/Oracles/DirectoryContents.hs
- hadrian/src/Hadrian/Oracles/Path.hs
- hadrian/src/Hadrian/Oracles/TextFile.hs
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Oracles/Flavour.hs
- hadrian/src/Oracles/ModuleFiles.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/changelog.md
- libraries/base/src/System/IO.hs
- libraries/exceptions
- libraries/ghc-internal/configure.ac
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- − m4/find_ghc_bootstrap_prog.m4
- − m4/fp_copy_shellvar.m4
- − m4/fp_prog_ld_flag.m4
- − m4/fp_prog_sort.m4
- m4/prep_target_file.m4
- − mk/win32-tarballs.md5sum
- + rts/.ubsan-suppressions
- rts/Apply.cmm
- rts/Compact.cmm
- rts/ContinuationOps.cmm
- rts/Exception.cmm
- rts/Interpreter.c
- rts/Jumps.h
- rts/PrimOps.cmm
- rts/RtsMessages.c
- rts/StgMiscClosures.cmm
- rts/StgStartup.cmm
- rts/configure.ac
- rts/include/Stg.h
- rts/include/rts/Messages.h
- rts/include/stg/Types.h
- rts/linker/InitFini.c
- rts/prim/mulIntMayOflo.c
- rts/rts.cabal
- rts/sm/Sanity.c
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/ghci/scripts/T8353.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/jsffi/all.T
- + testsuite/tests/jsffi/bytearrayarg.hs
- + testsuite/tests/jsffi/bytearrayarg.mjs
- + testsuite/tests/jsffi/bytearrayarg.stdout
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/numeric/should_run/foundation.hs
- testsuite/tests/numeric/should_run/foundation.stdout
- testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/patsyn/should_fail/all.T
- + testsuite/tests/patsyn/should_fail/import-syntax-no-ext.hs
- + testsuite/tests/patsyn/should_fail/import-syntax-no-ext.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/perf/should_run/all.T
- testsuite/tests/plugins/test-hole-plugin.stderr
- + testsuite/tests/rename/should_compile/T25901_sub_e.hs
- + testsuite/tests/rename/should_compile/T25901_sub_f.hs
- + testsuite/tests/rename/should_compile/T25901_sub_f.stderr
- + testsuite/tests/rename/should_compile/T25901_sub_g.hs
- + testsuite/tests/rename/should_compile/T25901_sub_g.stderr
- + testsuite/tests/rename/should_compile/T25901_sub_g_helper.hs
- testsuite/tests/rename/should_compile/all.T
- testsuite/tests/rename/should_fail/T23570b.stderr
- + testsuite/tests/rename/should_fail/T25901_sub_a.hs
- + testsuite/tests/rename/should_fail/T25901_sub_a.stderr
- + testsuite/tests/rename/should_fail/T25901_sub_b.hs
- + testsuite/tests/rename/should_fail/T25901_sub_b.stderr
- + testsuite/tests/rename/should_fail/T25901_sub_c.hs
- + testsuite/tests/rename/should_fail/T25901_sub_c.stderr
- + testsuite/tests/rename/should_fail/T25901_sub_c_helper.hs
- + testsuite/tests/rename/should_fail/T25901_sub_d.hs
- + testsuite/tests/rename/should_fail/T25901_sub_d.stderr
- + testsuite/tests/rename/should_fail/T25901_sub_d_helper.hs
- + testsuite/tests/rename/should_fail/T25901_sub_w.hs
- + testsuite/tests/rename/should_fail/T25901_sub_w.stderr
- testsuite/tests/rename/should_fail/all.T
- + testsuite/tests/simd/should_run/T26411.hs
- + testsuite/tests/simd/should_run/T26411.stdout
- + testsuite/tests/simd/should_run/T26411b.hs
- + testsuite/tests/simd/should_run/T26411b.stdout
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simplStg/should_compile/all.T
- testsuite/tests/th/T15321.stderr
- testsuite/tests/typecheck/should_compile/T13050.stderr
- testsuite/tests/typecheck/should_compile/T14273.stderr
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/hole_constraints.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes2.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
- testsuite/tests/warnings/should_compile/DodgyExports03.stderr
- testsuite/tests/warnings/should_compile/DodgyImports.stderr
- + testsuite/tests/warnings/should_compile/DodgyImports02.hs
- + testsuite/tests/warnings/should_compile/DodgyImports02.stderr
- + testsuite/tests/warnings/should_compile/DodgyImports03.hs
- + testsuite/tests/warnings/should_compile/DodgyImports03.stderr
- + testsuite/tests/warnings/should_compile/DodgyImports03_helper.hs
- + testsuite/tests/warnings/should_compile/DodgyImports04.hs
- + testsuite/tests/warnings/should_compile/DodgyImports04.stderr
- testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr
- testsuite/tests/warnings/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/deriveConstants/Main.hs
- utils/genapply/Main.hs
- utils/haddock/haddock-api/haddock-api.cabal
- − utils/haddock/haddock-api/src/Haddock/Backends/HaddockDB.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f94fb33cdcc192e81b01424017008f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f94fb33cdcc192e81b01424017008f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
31 Dec '25
Simon Peyton Jones pushed to branch wip/T26709 at Glasgow Haskell Compiler / GHC
Commits:
1cb9b4d9 by Simon Peyton Jones at 2025-12-31T09:41:09+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]
- - - - -
5 changed files:
- 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/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
=====================================
@@ -73,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 )
@@ -113,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
{-
@@ -674,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
@@ -688,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!
@@ -725,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
@@ -741,7 +755,18 @@ 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`.
+-- 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]
@@ -950,10 +975,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/-/commit/1cb9b4d9713a833a4477649dfbd7469…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cb9b4d9713a833a4477649dfbd7469…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[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