[Git][ghc/ghc][wip/9.2.7-backports] 7 commits: rts: Use C11-compliant static assertion syntax
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Wed Feb 22 13:18:06 UTC 2023
Zubin pushed to branch wip/9.2.7-backports at Glasgow Haskell Compiler / GHC
Commits:
923afa2f by Ben Gamari at 2023-02-22T17:02:04+05:30
rts: Use C11-compliant static assertion syntax
Previously we used `static_assert` which is only available in C23. By
contrast, C11 only provides `_Static_assert`.
Fixes #22777
(cherry picked from commit 406d485eb5b055ec428fc189a2724c010ff90a8c)
- - - - -
0978122d by Ben Gamari at 2023-02-22T17:04:38+05:30
rts: Statically assert alignment of Capability
In #22965 we noticed that changes in the size of `Capability` can result
in unsound behavior due to the `align` pragma claiming an alignment
which we don't in practice observe. Avoid this by statically asserting
that the size is a multiple of the alignment.
(cherry picked from commit 1de404a6528b44bb50927383cb1acf237d21ee03)
- - - - -
512c37e7 by Ben Gamari at 2023-02-22T17:04:46+05:30
rts: Introduce stgMallocAlignedBytes
(cherry picked from commit 04336d2f11e49f7d00392f05d4fd48abdd231fc0)
(cherry picked from commit 48ecd4b4dca42cf482847d7629c91d2b44eae252)
- - - - -
09fd3535 by Ben Gamari at 2023-02-22T17:04:54+05:30
rts: Correctly align Capability allocations
Previously we failed to tell the C allocator that `Capability`s needed
to be aligned, resulting in #22965.
(cherry picked from commit 4af27feabf482cf6b611951443e05ee7e53acb39)
(cherry picked from commit cdb39b95fe6d562abc6c1af9a8c0b208dd81681b)
- - - - -
3a522cbf by Andreas Klebinger at 2023-02-22T17:27:17+05:30
base: Correct @since annotation for FP<->Integral bit cast operations.
Fixes #22708
(cherry picked from commit 9296660b131d42f1b1f9c421040c5746d5c56989)
- - - - -
b05c96ae by Ben Gamari at 2023-02-22T17:31:05+05:30
hadrian: Extend xattr Darwin hack to cover /lib
As noted in #21506, it is now necessary to remove extended attributes
from `/lib` as well as `/bin` to avoid SIP issues on Darwin.
Fixes #21506.
(cherry picked from commit 78d04cfadfd728bb088b08b1e88905b43cc0360c)
- - - - -
8d3c0844 by Simon Peyton Jones at 2023-02-22T18:43:38+05:30
Re-do rubbish literals
As #19882 pointed out, we were simply doing rubbish literals wrong.
(I'll refrain from explaining the wrong-ness here -- see the ticket.)
This patch fixes it by adding a Type (of kind RuntimeRep) as field of
LitRubbish, rather than [PrimRep].
The Note [Rubbish literals] in GHC.Types.Literal explains the details.
(cherry picked from commit 52a524f7c8c5701708a007a5946c27914703d045)
- - - - -
25 changed files:
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/RepType.hs
- hadrian/bindist/Makefile
- includes/Rts.h
- libraries/base/GHC/Float.hs
- rts/Capability.c
- rts/Capability.h
- rts/RtsUtils.c
- rts/RtsUtils.h
- testsuite/tests/stranal/should_compile/T18982.stderr
- + testsuite/tests/stranal/should_compile/T19882a.hs
- + testsuite/tests/stranal/should_compile/T19882b.hs
- testsuite/tests/stranal/should_compile/all.T
Changes:
=====================================
compiler/GHC/Builtin/Types/Prim.hs
=====================================
@@ -13,7 +13,8 @@ Wired-in knowledge about primitive types
module GHC.Builtin.Types.Prim(
mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only
- mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom,
+ mkTemplateKindVar, mkTemplateKindVars,
+ mkTemplateTyVars, mkTemplateTyVarsFrom,
mkTemplateKiTyVars, mkTemplateKiTyVar,
mkTemplateTyConBinders, mkTemplateKindTyConBinders,
=====================================
compiler/GHC/Core/Make.hs
=====================================
@@ -13,6 +13,7 @@ module GHC.Core.Make (
sortQuantVars, castBottomExpr,
-- * Constructing boxed literals
+ mkLitRubbish,
mkWordExpr,
mkIntExpr, mkIntExprInt, mkUncheckedIntExpr,
mkIntegerExpr, mkNaturalExpr,
@@ -247,6 +248,23 @@ castBottomExpr e res_ty
where
e_ty = exprType e
+mkLitRubbish :: Type -> Maybe CoreExpr
+-- Make a rubbish-literal CoreExpr of the given type.
+-- Fail (returning Nothing) if
+-- * the RuntimeRep of the Type is not monomorphic;
+-- * the type is (a ~# b), the type of coercion
+-- See INVARIANT 1 and 2 of item (2) in Note [Rubbish literals]
+-- in GHC.Types.Literal
+mkLitRubbish ty
+ | not (noFreeVarsOfType rep)
+ = Nothing -- Satisfy INVARIANT 1
+ | isCoVarType ty
+ = Nothing -- Satisfy INVARIANT 2
+ | otherwise
+ = Just (Lit (LitRubbish rep) `mkTyApps` [ty])
+ where
+ rep = getRuntimeRep ty
+
{-
************************************************************************
* *
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -29,6 +29,7 @@ import GHC.Core.Opt.Monad
import qualified GHC.Core.Subst as Core
import GHC.Core.Unfold.Make
import GHC.Core
+import GHC.Core.Make ( mkLitRubbish )
import GHC.Core.Rules
import GHC.Core.Utils ( exprIsTrivial, getIdFromTrivialExpr_maybe
, mkCast, exprType )
@@ -2295,16 +2296,28 @@ specHeader env (bndr : bndrs) (UnspecArg : args)
let (env', bndr') = substBndr env (zapIdOccInfo bndr)
; (useful, env'', leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args)
<- specHeader env' bndrs args
+
+ ; let bndr_ty = idType bndr'
+
+ -- See Note [Drop dead args from specialisations]
+ -- C.f. GHC.Core.Opt.WorkWrap.Utils.mk_absent_let
+ (mb_spec_bndr, spec_arg)
+ | isDeadBinder bndr
+ , Just lit_expr <- mkLitRubbish bndr_ty
+ = (Nothing, lit_expr)
+ | otherwise
+ = (Just bndr', varToCoreExpr bndr')
+
; pure ( useful
, env''
, leftover_bndrs
, bndr' : rule_bs
, varToCoreExpr bndr' : rule_es
- , if isDeadBinder bndr
- then bs' -- see Note [Drop dead args from specialisations]
- else bndr' : bs'
+ , case mb_spec_bndr of
+ Nothing -> bs' -- see Note [Drop dead args from specialisations]
+ Just b' -> b' : bs'
, dx
- , varToCoreExpr bndr' : spec_args
+ , spec_arg : spec_args
)
}
=====================================
compiler/GHC/Core/Opt/WorkWrap/Utils.hs
=====================================
@@ -30,13 +30,12 @@ import GHC.Core.Make ( mkAbsentErrorApp, mkCoreUbxTup
, mkCoreApp, mkCoreLet )
import GHC.Types.Id.Make ( voidArgId, voidPrimId )
import GHC.Builtin.Types ( tupleDataCon )
-import GHC.Types.Literal ( mkLitRubbish )
+import GHC.Core.Make ( mkLitRubbish )
import GHC.Types.Var.Env ( mkInScopeSet )
import GHC.Types.Var.Set ( VarSet )
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.Predicate ( isClassPred )
-import GHC.Types.RepType ( isVoidTy, typeMonoPrimRep_maybe )
import GHC.Core.Coercion
import GHC.Core.FamInstEnv
import GHC.Types.Basic ( Boxity(..) )
@@ -54,6 +53,8 @@ import GHC.Driver.Ppr
import GHC.Data.FastString
import GHC.Data.List.SetOps
+import GHC.Types.RepType
+
{-
************************************************************************
* *
@@ -423,7 +424,10 @@ mkWWargs :: TCvSubst -- Freshening substitution to apply to the type
mkWWargs subst fun_ty demands
| null demands
- = return ([], id, id, substTy subst fun_ty)
+ = return ([], id, id, substTyUnchecked subst fun_ty)
+ -- I got an ASSERT failure here with `substTy`, and I was
+ -- disinclined to pursue it since this code is about to be
+ -- deleted by Sebastian
| (dmd:demands') <- demands
, Just (mult, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty
@@ -934,7 +938,6 @@ unbox_one dflags fam_envs arg cs
; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) }
-- Don't pass the arg, rebox instead
-----------------------
nop_fn :: CoreExpr -> CoreExpr
nop_fn body = body
@@ -1305,7 +1308,7 @@ they are *dead code*) and they are probably discarded after the next run of the
Simplifier (when they are in fact *unreachable code*). Yet, we have to come up
with "filler" values that we bind the absent arg Ids to.
-That is exactly what Note [Rubbish values] are for: A convenient way to
+That is exactly what Note [Rubbish literals] are for: A convenient way to
conjure filler values at any type (and any representation or levity!).
Needless to say, there are some wrinkles:
@@ -1313,7 +1316,7 @@ Needless to say, there are some wrinkles:
1. In case we have a absent, /lazy/, and /lifted/ arg, we use an error-thunk
instead. If absence analysis was wrong (e.g., #11126) and the binding
in fact is used, then we get a nice panic message instead of undefined
- runtime behavior (See Modes of failure from Note [Rubbish values]).
+ runtime behavior (See Modes of failure from Note [Rubbish literals]).
Obviously, we can't use an error-thunk if the value is of unlifted rep
(like 'Int#' or 'MutVar#'), because we'd immediately evaluate the panic.
@@ -1377,23 +1380,22 @@ mk_absent_let :: DynFlags -> Id -> Demand -> Maybe (CoreExpr -> CoreExpr)
mk_absent_let dflags arg dmd
-- The lifted case: Bind 'absentError' for a nice panic message if we are
-- wrong (like we were in #11126). See (1) in Note [Absent fillers]
- | Just [LiftedRep] <- mb_mono_prim_reps
+ | not (isUnliftedType arg_ty)
, not (isStrictDmd dmd) -- See (2) in Note [Absent fillers]
= Just (Let (NonRec arg panic_rhs))
- -- The default case for mono rep: Bind @RUBBISH[prim_reps] \@arg_ty@
+ -- The default case for mono rep: Bind `RUBBISH[rr] \@arg_ty`
-- See Note [Absent fillers], the main part
- | Just prim_reps <- mb_mono_prim_reps
- = Just (bindNonRec arg (mkTyApps (Lit (mkLitRubbish prim_reps)) [arg_ty]))
+ | Just lit_expr <- mkLitRubbish arg_ty
+ = Just (bindNonRec arg lit_expr)
-- Catch all: Either @arg_ty@ wasn't of form @TYPE rep@ or @rep@ wasn't mono rep.
-- See (3) in Note [Absent fillers]
- | Nothing <- mb_mono_prim_reps
+ | otherwise
= WARN( True, text "No absent value for" <+> ppr arg_ty )
Nothing
where
arg_ty = idType arg
- mb_mono_prim_reps = typeMonoPrimRep_maybe arg_ty
panic_rhs = mkAbsentErrorApp arg_ty msg
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -1403,7 +1403,7 @@ tyConRepModOcc tc_module tc_occ = (rep_module, mkTyConRepOcc tc_occ)
************************************************************************
Note [rep swamp]
-
+~~~~~~~~~~~~~~~~
GHC has a rich selection of types that represent "primitive types" of
one kind or another. Each of them makes a different set of
distinctions, and mostly the differences are for good reasons,
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -52,6 +52,7 @@ import GHC.Driver.Ppr
import GHC.Iface.Syntax
import GHC.Core.DataCon
import GHC.Types.Id
+import GHC.Types.Literal
import GHC.Types.Id.Info
import GHC.StgToCmm.Types
import GHC.Core
@@ -541,6 +542,7 @@ toIfUnfolding _ NoUnfolding = Nothing
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var v) = toIfaceVar v
+toIfaceExpr (Lit (LitRubbish r)) = IfaceLitRubbish (toIfaceType r)
toIfaceExpr (Lit l) = IfaceLit l
toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
toIfaceExpr (Coercion co) = IfaceCo (toIfaceCoercion co)
@@ -583,7 +585,9 @@ toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map getOccFS bs) (toIfaceExpr
---------------------
toIfaceCon :: AltCon -> IfaceConAlt
toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)
-toIfaceCon (LitAlt l) = IfaceLitAlt l
+toIfaceCon (LitAlt l) = ASSERT2( (not (isLitRubbish l)) , ppr l )
+ -- assert: see Note [Rubbish literals] wrinkle (b)
+ (IfaceLitAlt l)
toIfaceCon DEFAULT = IfaceDefault
---------------------
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -396,9 +396,11 @@ coreToStgExpr (Coercion _)
coreToStgExpr expr@(App _ _)
= case app_head of
- Var f -> coreToStgApp f args ticks -- Regular application
- Lit l at LitRubbish{} -> return (StgLit l) -- LitRubbish
- _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr)
+ Var f -> coreToStgApp f args ticks -- Regular application
+ Lit l | isLitRubbish l -- If there is LitRubbish at the head,
+ -> return (StgLit l) -- discard the arguments
+
+ _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr)
where
(app_head, args, ticks) = myCollectArgs expr
coreToStgExpr expr@(Lam _ _)
=====================================
compiler/GHC/Iface/Rename.hs
=====================================
@@ -644,8 +644,9 @@ rnIfaceExpr (IfaceLet (IfaceRec pairs) body)
<*> rnIfaceExpr body
rnIfaceExpr (IfaceCast expr co)
= IfaceCast <$> rnIfaceExpr expr <*> rnIfaceCo co
-rnIfaceExpr (IfaceLit lit) = pure (IfaceLit lit)
-rnIfaceExpr (IfaceFCall cc ty) = IfaceFCall cc <$> rnIfaceType ty
+rnIfaceExpr (IfaceLit lit) = pure (IfaceLit lit)
+rnIfaceExpr (IfaceLitRubbish rep) = IfaceLitRubbish <$> rnIfaceType rep
+rnIfaceExpr (IfaceFCall cc ty) = IfaceFCall cc <$> rnIfaceType ty
rnIfaceExpr (IfaceTick tickish expr) = IfaceTick tickish <$> rnIfaceExpr expr
rnIfaceBndrs :: Rename [IfaceBndr]
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -558,6 +558,8 @@ data IfaceExpr
| IfaceLet IfaceBinding IfaceExpr
| IfaceCast IfaceExpr IfaceCoercion
| IfaceLit Literal
+ | IfaceLitRubbish IfaceType -- See GHC.Types.Literal
+ -- Note [Rubbish literals] item (6)
| IfaceFCall ForeignCall IfaceType
| IfaceTick IfaceTickish IfaceExpr -- from Tick tickish E
@@ -1363,6 +1365,7 @@ pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr _ (IfaceLcl v) = ppr v
pprIfaceExpr _ (IfaceExt v) = ppr v
pprIfaceExpr _ (IfaceLit l) = ppr l
+pprIfaceExpr _ (IfaceLitRubbish r) = text "RUBBISH" <> parens (ppr r)
pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
pprIfaceExpr _ (IfaceType ty) = char '@' <> pprParendIfaceType ty
pprIfaceExpr _ (IfaceCo co) = text "@~" <> pprParendIfaceCoercion co
@@ -2347,6 +2350,9 @@ instance Binary IfaceExpr where
putByte bh 13
put_ bh a
put_ bh b
+ put_ bh (IfaceLitRubbish r) = do
+ putByte bh 14
+ put_ bh r
get bh = do
h <- getByte bh
case h of
@@ -2389,6 +2395,8 @@ instance Binary IfaceExpr where
13 -> do a <- get bh
b <- get bh
return (IfaceECase a b)
+ 14 -> do r <- get bh
+ return (IfaceLitRubbish r)
_ -> panic ("get IfaceExpr " ++ show h)
instance Binary IfaceTickish where
@@ -2613,6 +2621,7 @@ instance NFData IfaceExpr where
IfaceLet bind e -> rnf bind `seq` rnf e
IfaceCast e co -> rnf e `seq` rnf co
IfaceLit l -> l `seq` () -- FIXME
+ IfaceLitRubbish r -> rnf r `seq` ()
IfaceFCall fc ty -> fc `seq` rnf ty
IfaceTick tick e -> rnf tick `seq` rnf e
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1447,6 +1447,10 @@ tcIfaceExpr (IfaceLcl name)
tcIfaceExpr (IfaceExt gbl)
= Var <$> tcIfaceExtId gbl
+tcIfaceExpr (IfaceLitRubbish rep)
+ = do rep' <- tcIfaceType rep
+ return (Lit (LitRubbish rep'))
+
tcIfaceExpr (IfaceLit lit)
= do lit' <- tcIfaceLit lit
return (Lit lit')
=====================================
compiler/GHC/Stg/Unarise.hs
=====================================
@@ -219,7 +219,7 @@ STG programs after unarisation have these invariants:
This means that it's safe to wrap `StgArg`s of DataCon applications with
`GHC.StgToCmm.Env.NonVoid`, for example.
- * Similar to unboxed tuples, Note [Rubbish values] of TupleRep may only
+ * Similar to unboxed tuples, Note [Rubbish literals] of TupleRep may only
appear in return position.
* Alt binders (binders in patterns) are always non-void.
@@ -248,7 +248,7 @@ import GHC.Utils.Panic
import GHC.Types.RepType
import GHC.Stg.Syntax
import GHC.Core.Type
-import GHC.Builtin.Types.Prim (intPrimTy)
+import GHC.Builtin.Types.Prim (intPrimTy, primRepToRuntimeRep)
import GHC.Builtin.Types
import GHC.Types.Unique.Supply
import GHC.Utils.Misc
@@ -389,7 +389,7 @@ unariseExpr rho (StgCase scrut bndr alt_ty alts)
, Just args' <- unariseMulti_maybe rho dc args ty_args
= elimCase rho args' bndr alt_ty alts
- -- See (3) of Note [Rubbish values] in GHC.Types.Literal
+ -- See (3) of Note [Rubbish literals] in GHC.Types.Literal
| StgLit lit <- scrut
, Just args' <- unariseRubbish_maybe lit
= elimCase rho args' bndr alt_ty alts
@@ -426,19 +426,18 @@ unariseMulti_maybe rho dc args ty_args
-- Doesn't return void args.
unariseRubbish_maybe :: Literal -> Maybe [OutStgArg]
-unariseRubbish_maybe lit
- | LitRubbish preps <- lit
- , [prep] <- preps
+unariseRubbish_maybe (LitRubbish rep)
+ | [prep] <- preps
, not (isVoidRep prep)
- -- Single, non-void PrimRep. Nothing to do!
- = Nothing
+ = Nothing -- Single, non-void PrimRep. Nothing to do!
- | LitRubbish preps <- lit
- -- Multiple reps, possibly with VoidRep. Eliminate!
- = Just [ StgLitArg (LitRubbish [prep]) | prep <- preps, not (isVoidRep prep) ]
+ | otherwise -- Multiple reps, possibly with VoidRep. Eliminate via elimCase
+ = Just [ StgLitArg (LitRubbish (primRepToType prep))
+ | prep <- preps, not (isVoidRep prep) ]
+ where
+ preps = runtimeRepPrimRep (text "unariseRubbish_maybe") rep
- | otherwise
- = Nothing
+unariseRubbish_maybe _ = Nothing
--------------------------------------------------------------------------------
@@ -658,7 +657,8 @@ ubxSumRubbishArg WordSlot = StgLitArg (LitNumber LitNumWord 0)
ubxSumRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0)
ubxSumRubbishArg FloatSlot = StgLitArg (LitFloat 0)
ubxSumRubbishArg DoubleSlot = StgLitArg (LitDouble 0)
-ubxSumRubbishArg (VecSlot n e) = StgLitArg (LitRubbish [VecRep n e])
+ubxSumRubbishArg (VecSlot n e) = StgLitArg (LitRubbish vec_rep)
+ where vec_rep = primRepToRuntimeRep (VecRep n e)
--------------------------------------------------------------------------------
=====================================
compiler/GHC/StgToCmm/Lit.hs
=====================================
@@ -25,6 +25,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm.Utils
import GHC.Types.Literal
+import GHC.Types.RepType( runtimeRepPrimRep )
import GHC.Builtin.Types ( unitDataConId )
import GHC.Core.TyCon
import GHC.Utils.Misc
@@ -51,8 +52,8 @@ cgLit :: Literal -> FCode CmmExpr
cgLit (LitString s) =
CmmLit <$> newByteStringCLit s
-- not unpackFS; we want the UTF-8 byte stream.
-cgLit (LitRubbish preps) =
- case expectOnly "cgLit:Rubbish" preps of -- Note [Post-unarisation invariants]
+cgLit (LitRubbish rep) =
+ case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants]
VoidRep -> panic "cgLit:VoidRep" -- dito
LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId
UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId
@@ -62,7 +63,9 @@ cgLit (LitRubbish preps) =
let elem_lit = mkSimpleLit platform (num_rep_lit (primElemRepToPrimRep elem))
pure (CmmLit (CmmVec (replicate n elem_lit)))
prep -> cgLit (num_rep_lit prep)
- where
+ where
+ prim_reps = runtimeRepPrimRep (text "cgLit") rep
+
num_rep_lit IntRep = mkLitIntUnchecked 0
num_rep_lit Int8Rep = mkLitInt8Unchecked 0
num_rep_lit Int16Rep = mkLitInt16Unchecked 0
@@ -76,6 +79,7 @@ cgLit (LitRubbish preps) =
num_rep_lit FloatRep = LitFloat 0
num_rep_lit DoubleRep = LitDouble 0
num_rep_lit other = pprPanic "num_rep_lit: Not a num lit" (ppr other)
+
cgLit other_lit = do
platform <- getPlatform
pure (CmmLit (mkSimpleLit platform other_lit))
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -33,7 +33,6 @@ module GHC.Types.Literal
, mkLitChar, mkLitString
, mkLitInteger, mkLitNatural
, mkLitNumber, mkLitNumberWrap
- , mkLitRubbish
-- ** Operations on Literals
, literalType
@@ -53,7 +52,7 @@ module GHC.Types.Literal
, isZeroLit, isOneLit
, litFitsInChar
, litValue, mapLitValue
- , isLitValue_maybe
+ , isLitValue_maybe, isLitRubbish
-- ** Coercions
, narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit
@@ -71,7 +70,6 @@ import GHC.Prelude
import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Types
import GHC.Core.Type
-import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Types.Basic
@@ -135,13 +133,15 @@ data Literal
-- that can be represented as a Literal. Create
-- with 'nullAddrLit'
- | LitRubbish [PrimRep] -- ^ A nonsense value of the given
- -- representation. See Note [Rubbish values].
+ | LitRubbish Type -- ^ A nonsense value of the given
+ -- representation. See Note [Rubbish literals].
+ --
+ -- The Type argument, rr, is of kind RuntimeRep.
+ -- The type of the literal is forall (a:TYPE rr). a
+ --
+ -- INVARIANT: the Type has no free variables
+ -- and so substitution etc can ignore it
--
- -- The @[PrimRep]@ of a 'Type' can be obtained
- -- from 'typeMonoPrimRep_maybe'. The field
- -- becomes empty or singleton post-unarisation,
- -- see Note [Post-unarisation invariants].
| LitFloat Rational -- ^ @Float#@. Create with 'mkLitFloat'
| LitDouble Rational -- ^ @Double#@. Create with 'mkLitDouble'
@@ -219,7 +219,6 @@ instance Binary LitNumType where
{-
Note [BigNum literals]
~~~~~~~~~~~~~~~~~~~~~~
-
GHC supports 2 kinds of arbitrary precision integers (a.k.a BigNum):
* Natural: natural represented as a Word# or as a BigNat
@@ -233,7 +232,6 @@ are replaced with expression to build them at runtime from machine literals
Note [String literals]
~~~~~~~~~~~~~~~~~~~~~~
-
String literals are UTF-8 encoded and stored into ByteStrings in the following
ASTs: Haskell, Core, Stg, Cmm. TH can also emit ByteString based string literals
with the BytesPrimL constructor (see #14741).
@@ -262,7 +260,9 @@ instance Binary Literal where
= do putByte bh 6
put_ bh nt
put_ bh i
- put_ bh (LitRubbish b) = do putByte bh 7; put_ bh b
+ put_ _ (LitRubbish b) = pprPanic "Binary LitRubbish" (ppr b)
+ -- We use IfaceLitRubbish; see Note [Rubbish literals], item (6)
+
get bh = do
h <- getByte bh
case h of
@@ -288,9 +288,6 @@ instance Binary Literal where
nt <- get bh
i <- get bh
return (LitNumber nt i)
- 7 -> do
- b <- get bh
- return (LitRubbish b)
_ -> pprPanic "Binary:Literal" (int (fromIntegral h))
instance Outputable Literal where
@@ -572,11 +569,9 @@ mkLitNatural :: Integer -> Literal
mkLitNatural x = ASSERT2( inNaturalRange x, integer x )
(LitNumber LitNumNatural x)
--- | Create a rubbish literal of the given representation.
--- The representation of a 'Type' can be obtained via 'typeMonoPrimRep_maybe'.
--- See Note [Rubbish values].
-mkLitRubbish :: [PrimRep] -> Literal
-mkLitRubbish = LitRubbish
+isLitRubbish :: Literal -> Bool
+isLitRubbish (LitRubbish {}) = True
+isLitRubbish _ = False
inNaturalRange :: Integer -> Bool
inNaturalRange x = x >= 0
@@ -844,10 +839,12 @@ literalType (LitNumber lt _) = case lt of
LitNumWord16 -> word16PrimTy
LitNumWord32 -> word32PrimTy
LitNumWord64 -> word64PrimTy
-literalType (LitRubbish preps) = mkForAllTy a Inferred (mkTyVarTy a)
+
+-- LitRubbish: see Note [Rubbish literals]
+literalType (LitRubbish rep)
+ = mkForAllTy a Inferred (mkTyVarTy a)
where
- -- See Note [Rubbish values]
- a = head $ mkTemplateTyVars [tYPE (primRepsToRuntimeRep preps)]
+ a = mkTemplateKindVar (tYPE rep)
{-
Comparison
@@ -863,7 +860,7 @@ cmpLit (LitDouble a) (LitDouble b) = a `compare` b
cmpLit (LitLabel a _ _) (LitLabel b _ _) = a `lexicalCompareFS` b
cmpLit (LitNumber nt1 a) (LitNumber nt2 b)
= (nt1 `compare` nt2) `mappend` (a `compare` b)
-cmpLit (LitRubbish b1) (LitRubbish b2) = b1 `compare` b2
+cmpLit (LitRubbish b1) (LitRubbish b2) = b1 `nonDetCmpType` b2
cmpLit lit1 lit2
| isTrue# (dataToTag# lit1 <# dataToTag# lit2) = LT
| otherwise = GT
@@ -899,8 +896,8 @@ pprLiteral add_par (LitLabel l mb fod) =
where b = case mb of
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
-pprLiteral _ (LitRubbish reps)
- = text "RUBBISH" <> ppr reps
+pprLiteral _ (LitRubbish rep)
+ = text "RUBBISH" <> parens (ppr rep)
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
-- See Note [Printing of literals in Core].
@@ -944,75 +941,159 @@ LitInteger -1 (-1)
LitLabel "__label" ... ("__label" ...)
LitRubbish "RUBBISH[...]"
-Note [Rubbish values]
-~~~~~~~~~~~~~~~~~~~~~
+Note [Rubbish literals]
+~~~~~~~~~~~~~~~~~~~~~~~
Sometimes, we need to cough up a rubbish value of a certain type that is used
in place of dead code we thus aim to eliminate. The value of a dead occurrence
has no effect on the dynamic semantics of the program, so we can pick any value
of the same representation.
+
Exploiting the results of absence analysis in worker/wrapper is a scenario where
-we need such a rubbish value, see Note [Absent fillers] for examples.
+we need such a rubbish value, see examples in Note [Absent fillers] in
+GHC.Core.Opt.WorkWrap.Utils.
It's completely undefined what the *value* of a rubbish value is, e.g., we could
pick @0#@ for @Int#@ or @42#@; it mustn't matter where it's inserted into a Core
program. We embed these rubbish values in the 'LitRubbish' case of the 'Literal'
data type. Here are the moving parts:
- 1. Source Haskell: No way to produce rubbish lits in source syntax. Purely
- an IR feature.
-
- 2. Core: 'LitRubbish' carries a @[PrimRep]@ which represents the monomorphic
- 'RuntimeRep' of the type it is substituting for.
- We have it that @RUBBISH[IntRep]@ has type @forall (a :: TYPE IntRep). a@,
- and the type application @RUBBISH[IntRep] \@Int# :: Int#@ represents
- a rubbish value of type @Int#@. Rubbish lits are completely opaque in Core.
- In general, @RUBBISH[preps] :: forall (a :: TYPE rep). a@, where @rep@
- is the 'RuntimeRep' corresponding to @preps :: [PrimRep]@
- (via 'primRepsToRuntimeRep'). See 'literalType'.
- Why not encode a 'RuntimeRep' via a @Type@? Thus
- > data Literal = ... | LitRubbish Type | ...
- Because
- * We have to provide an Eq and Ord instance and @Type@ has none
- * The encoded @Type@ might be polymorphic and we can only emit code for
- monomorphic 'RuntimeRep's anyway.
-
- 3. STG: The type app in @RUBBISH[IntRep] \@Int# :: Int#@ is erased and we get
- the (untyped) 'StgLit' @RUBBISH[IntRep] :: Int#@ in STG.
- It's treated mostly opaque, with the exception of the Unariser, where we
- take apart a case scrutinisation on, or arg occurrence of, e.g.,
- @RUBBISH[IntRep,DoubleRep]@ (which may stand in for @(# Int#, Double# #)@)
- into its sub-parts @RUBBISH[IntRep]@ and @RUBBISH[DoubleRep]@, similar to
- unboxed tuples. @RUBBISH[VoidRep]@ is erased.
- See 'unariseRubbish_maybe' and also Note [Post-unarisation invariants].
-
- 4. Cmm: We translate 'LitRubbish' to their actual rubbish value in 'cgLit'.
- The particulars are boring, and only matter when debugging illicit use of
- a rubbish value; see Modes of failure below.
-
- 5. Bytecode: In GHC.ByteCode.Asm we just lower it as a 0 literal, because it's
- all boxed to the host GC anyway.
-
-Why not lower LitRubbish in CoreToStg? Because it enables us to use RubbishLit
-when unarising unboxed sums in the future, and it allows rubbish values of e.g.
-VecRep, for which we can't cough up dummy values in STG.
+1. Source Haskell: No way to produce rubbish lits in source syntax. Purely
+ an IR feature.
+
+2. Core: 'LitRubbish' carries a `Type` of kind RuntimeRep,
+ describing the runtime representaion of the literal (is it a
+ pointer, an unboxed Double#, or whatever).
+
+ We have it that `RUBBISH[rr]` has type `forall (a :: TYPE rr). a`.
+ See the `LitRubbish` case of `literalType`.
+
+ The function GHC.Core.Make.mkLitRubbish makes a Core rubbish literal of
+ a given type. It obeys the following invariants:
+
+ INVARIANT 1: 'rr' has no free variables. Main reason: we don't need to run
+ substitutions and free variable finders over Literal. The rules around
+ levity/runtime-rep polymorphism naturally uphold this invariant.
+
+ INVARIANT 2: we never make a rubbish literal of type (a ~# b). Reason:
+ see Note [Core type and coercion invariant] in GHC.Core. We can't substitute
+ a LitRubbish inside a coercion, so it's best not to make one. They are zero
+ width anyway, so passing absent ones around costs nothing. If we wanted
+ an absent filler of type (a ~# b) we should use (Coercion (UnivCo ...)),
+ but it doesn't seem worth making a new UnivCoProvenance for this purpose.
+
+ This is sad, though: see #18983.
+
+3. STG: The type app in `RUBBISH[IntRep] @Int# :: Int#` is erased and we get
+ the (untyped) 'StgLit' `RUBBISH[IntRep] :: Int#` in STG.
+
+ It's treated mostly opaque, with the exception of the Unariser, where we
+ take apart a case scrutinisation on, or arg occurrence of, e.g.,
+ `RUBBISH[TupleRep[IntRep,DoubleRep]]` (which may stand in for `(# Int#, Double# #)`)
+ into its sub-parts `RUBBISH[IntRep]` and `RUBBISH[DoubleRep]`, similar to
+ unboxed tuples. `RUBBISH[VoidRep]` is erased.
+ See 'unariseRubbish_maybe' and also Note [Post-unarisation invariants].
+
+4. Cmm: We translate 'LitRubbish' to their actual rubbish value in 'cgLit'.
+ The particulars are boring, and only matter when debugging illicit use of
+ a rubbish value; see Modes of failure below.
+
+5. Bytecode: In GHC.ByteCode.Asm we just lower it as a 0 literal, because it's
+ all boxed to the host GC anyway.
+
+6. IfaceSyn: `Literal` is part of `IfaceSyn`, but `Type` really isn't. So in
+ the passage from Core to Iface I put LitRubbish into its owns IfaceExpr data
+ constructor, IfaceLitRubbish. The remaining constructors of Literal are
+ fine as IfaceSyn.
+
+Wrinkles
+
+a) Why do we put the `Type` (of kind RuntimeRep) inside the literal? Could
+ we not instead /apply/ the literal to that RuntimeRep? Alas no, becuase
+ then LitRubbish :: forall (rr::RuntimeRep) (a::TYPE rr). a
+ and that's am ill-formed type because its kind is `TYPE rr`, which escapes
+ the binding site of `rr`. Annoying.
+
+b) A rubbish literal is not bottom, and replies True to exprOkForSpeculation.
+ For unboxed types there is no bottom anyway. If we have
+ let (x::Int#) = RUBBISH[IntRep] @Int#
+ we want to convert that to a case! We want to leave it as a let, and
+ probably discard it as dead code soon after because x is unused.
+
+c) We can see a rubbish literal at the head of an application chain.
+ Most obviously, pretty much every rubbish literal is the head of a
+ type application e.g. `RUBBISH[IntRep] @Int#`. But see also
+ Note [How a rubbish literal can be the head of an application]
+
+c) Literal is in Ord, because (and only because) we use Ord on AltCon when
+ building a TypeMap. Annoying. We use `nonDetCmpType` here; the
+ non-determinism won't matter because it's only used in TrieMap.
+ Moreover, rubbish literals should not appear in patterns anyway.
+
+d) Why not lower LitRubbish in CoreToStg? Because it enables us to use
+ RubbishLit when unarising unboxed sums in the future, and it allows
+ rubbish values of e.g. VecRep, for which we can't cough up dummy
+ values in STG.
Modes of failure
----------------
Suppose there is a bug in GHC, and a rubbish value is used after all. That is
undefined behavior, of course, but let us list a few examples for failure modes:
- a) For an value of unboxed numeric type like @Int#@, we just use a silly
+ a) For an value of unboxed numeric type like `Int#`, we just use a silly
value like 42#. The error might propoagate indefinitely, hence we better
pick a rather unique literal. Same for Word, Floats, Char and VecRep.
b) For AddrRep (like String lits), we mit a null pointer, resulting in a
definitive segfault when accessed.
c) For boxed values, unlifted or not, we use a pointer to a fixed closure,
- like @()@, so that the GC has a pointer to follow.
+ like `()`, so that the GC has a pointer to follow.
If we use that pointer as an 'Array#', we will likely access fields of the
array that don't exist, and a seg-fault is likely, but not guaranteed.
- If we use that pointer as @Either Int Bool@, we might try to access the
+ If we use that pointer as `Either Int Bool`, we might try to access the
'Int' field of the 'Left' constructor (which has the same ConTag as '()'),
which doesn't exists. In the best case, we'll find an invalid pointer in its
position and get a seg-fault, in the worst case the error manifests only one
or two indirections later.
- -}
+
+Note [How a rubbish literal can be the head of an application]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this (#19824):
+
+ h :: T3 -> Int -> blah
+ h _ (I# n) = ...
+
+ f :: (T1 -> T2 -> T3) -> T4 -> blah
+ f g x = ....(h (g n s) x)...
+
+Demand analysis finds that h does not use its first argument, and w/w's h to
+
+ {-# INLINE h #-}
+ h a b = case b of I# n -> $wh n
+
+Demand analysis also finds that f does not use its first arg,
+so the worker for f look like
+
+ $wf x = let g = RUBBISH in
+ ....(h (g n s) x)...
+
+Now we inline g to get:
+
+ $wf x = ....(h (RUBBISH n s) x)...
+
+And lo, until we inline `h`, we have that application of
+RUBBISH in $wf's RHS. But surely `h` will inline? Not if the
+arguments look boring. Well, RUBBISH doesn't look boring. But it
+could be a bit more complicated like
+ f g x = let t = ...(g n s)...
+ in ...(h t x)...
+
+and now the call looks more boring. Anyway, the point is that we
+might reasonably see RUBBISH at the head of an application chain.
+
+It would be fine to rewrite
+ RUBBISH @(ta->tb->tr) a b ---> RUBBISH @tr
+but we don't currently do so.
+
+It is NOT ok to discard the entire continuation:
+ case RUBBISH @ty of DEFAULT -> blah
+does not return RUBBISH!
+-}
=====================================
compiler/GHC/Types/RepType.hs
=====================================
@@ -338,7 +338,7 @@ needed and how many bits are required. The data type GHC.Core.TyCon.PrimRep
enumerates all the possibilities.
data PrimRep
- = VoidRep
+ = VoidRep -- See Note [VoidRep]
| LiftedRep -- ^ Lifted pointer
| UnliftedRep -- ^ Unlifted pointer
| Int8Rep -- ^ Signed, 8-bit value
@@ -549,6 +549,7 @@ runtimeRepMonoPrimRep_maybe rr_ty
-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that
-- it encodes. See also Note [Getting from RuntimeRep to PrimRep]
+-- The [PrimRep] is the final runtime representation /after/ unarisation
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]
runtimeRepPrimRep doc rr_ty
| Just rr_ty' <- coreView rr_ty
=====================================
hadrian/bindist/Makefile
=====================================
@@ -166,7 +166,9 @@ install_bin_libdir:
cp -R $$i "$(DESTDIR)$(ActualBinsDir)"; \
done
# Work around #17418 on Darwin
- if [ -e "${XATTR}" ]; then "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; fi
+ if [ -e "${XATTR}" ]; then \
+ "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; \
+ fi
install_bin_direct:
@echo "Copying binaries to $(DESTDIR)$(WrapperBinsDir)"
@@ -179,7 +181,11 @@ install_lib: lib/settings
$(INSTALL_DIR) "$(DESTDIR)$(ActualLibsDir)"
for i in $(LIBRARIES); do \
cp -R $$i "$(DESTDIR)$(ActualLibsDir)/"; \
- done
+ done; \
+ # Work around #17418 on Darwin
+ if [ -e "${XATTR}" ]; then \
+ "${XATTR}" -c -r "$(DESTDIR)$(ActualLibsDir)"; \
+ fi
INCLUDES = $(wildcard ./include/*)
install_includes:
=====================================
includes/Rts.h
=====================================
@@ -29,6 +29,9 @@ extern "C" {
#include <windows.h>
#endif
+/* For _Static_assert */
+#include <assert.h>
+
#if !defined(IN_STG_CODE)
#define IN_STG_CODE 0
#endif
@@ -147,9 +150,17 @@ void _warnFail(const char *filename, unsigned int linenum);
#define ASSERTM(predicate,msg,...) CHECKM(predicate,msg,##__VA_ARGS__)
#define WARN(predicate) CHECKWARN(predicate)
#undef ASSERTS_ENABLED
-
#endif /* DEBUG */
+#if __STDC_VERSION__ >= 201112L
+// `_Static_assert` is provided by C11 but is deprecated and replaced by
+// `static_assert` in C23. Perhaps some day we should instead use the latter.
+// See #22777.
+#define GHC_STATIC_ASSERT(x, msg) _Static_assert((x), msg)
+#else
+#define GHC_STATIC_ASSERT(x, msg)
+#endif
+
/*
* Use this on the RHS of macros which expand to nothing
* to make sure that the macro can be used in a context which
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -1451,7 +1451,7 @@ is using CMM.
-- | @'castWord32ToFloat' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
--- @since 4.10.0.0
+-- @since 4.11.0.0
{-# INLINE castWord32ToFloat #-}
castWord32ToFloat :: Word32 -> Float
@@ -1464,7 +1464,7 @@ foreign import prim "stg_word32ToFloatzh"
-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
--- @since 4.10.0.0
+-- @since 4.11.0.0
{-# INLINE castFloatToWord32 #-}
castFloatToWord32 :: Float -> Word32
@@ -1478,7 +1478,7 @@ foreign import prim "stg_floatToWord32zh"
-- | @'castWord64ToDouble' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
--- @since 4.10.0.0
+-- @since 4.11.0.0
{-# INLINE castWord64ToDouble #-}
castWord64ToDouble :: Word64 -> Double
@@ -1495,7 +1495,7 @@ foreign import prim "stg_word64ToDoublezh"
-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
--- @since 4.10.0.0
+-- @since 4.11.0.0
{-# INLINE castDoubleToWord64 #-}
castDoubleToWord64 :: Double -> Word64
=====================================
rts/Capability.c
=====================================
@@ -439,8 +439,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS)
if (i < from) {
new_capabilities[i] = capabilities[i];
} else {
- new_capabilities[i] = stgMallocBytes(sizeof(Capability),
- "moreCapabilities");
+ new_capabilities[i] = stgMallocAlignedBytes(sizeof(Capability),
+ CAPABILITY_ALIGNMENT,
+ "moreCapabilities");
initCapability(new_capabilities[i], i);
}
}
@@ -1287,7 +1288,7 @@ freeCapabilities (void)
for (i=0; i < getNumCapabilities(); i++) {
freeCapability(capabilities[i]);
if (capabilities[i] != &MainCapability)
- stgFree(capabilities[i]);
+ stgFreeAligned(capabilities[i]);
}
#else
freeCapability(&MainCapability);
=====================================
rts/Capability.h
=====================================
@@ -27,6 +27,17 @@
#include "BeginPrivate.h"
+// We never want a Capability to overlap a cache line with
+// anything else, so round it up to a cache line size:
+#if defined(s390x_HOST_ARCH)
+#define CAPABILITY_ALIGNMENT 256
+#elif defined(mingw32_HOST_OS)
+// N.B. it's quite unclear why this special case exists
+#define CAPABILITY_ALIGNMENT 1
+#else
+#define CAPABILITY_ALIGNMENT 64
+#endif
+
/* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */
struct Capability_ {
// State required by the STG virtual machine when running Haskell
@@ -172,14 +183,12 @@ struct Capability_ {
StgTRecHeader *free_trec_headers;
uint32_t transaction_tokens;
} // typedef Capability is defined in RtsAPI.h
- // We never want a Capability to overlap a cache line with anything
- // else, so round it up to a cache line size:
-#if defined(s390x_HOST_ARCH)
- ATTRIBUTE_ALIGNED(256)
-#elif !defined(mingw32_HOST_OS)
- ATTRIBUTE_ALIGNED(64)
-#endif
- ;
+ ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT)
+;
+
+// We allocate arrays of Capabilities therefore we must ensure that the size is
+// a multiple of the claimed alignment
+GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size");
#if defined(THREADED_RTS)
#define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId())
=====================================
rts/RtsUtils.c
=====================================
@@ -59,9 +59,9 @@ extern char *ctime_r(const time_t *, char *);
void *
stgMallocBytes (size_t n, char *msg)
{
- void *space;
+ void *space = malloc(n);
- if ((space = malloc(n)) == NULL) {
+ if (space == NULL) {
/* Quoting POSIX.1-2008 (which says more or less the same as ISO C99):
*
* "Upon successful completion with size not equal to 0, malloc() shall
@@ -130,6 +130,53 @@ stgFree(void* p)
free(p);
}
+// N.B. Allocations resulting from this function must be freed by
+// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc`
+void *
+stgMallocAlignedBytes (size_t n, size_t align, char *msg)
+{
+ void *space;
+
+#if defined(mingw32_HOST_OS)
+ space = _aligned_malloc(n, align);
+#else
+ if (posix_memalign(&space, align, n)) {
+ space = NULL; // Allocation failed
+ }
+#endif
+
+ if (space == NULL) {
+ /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99):
+ *
+ * "Upon successful completion with size not equal to 0, malloc() shall
+ * return a pointer to the allocated space. If size is 0, either a null
+ * pointer or a unique pointer that can be successfully passed to free()
+ * shall be returned. Otherwise, it shall return a null pointer and set
+ * errno to indicate the error."
+ *
+ * Consequently, a NULL pointer being returned by `malloc()` for a 0-size
+ * allocation is *not* to be considered an error.
+ */
+ if (n == 0) return NULL;
+
+ /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+ rtsConfig.mallocFailHook((W_) n, msg);
+ stg_exit(EXIT_INTERNAL_ERROR);
+ }
+ IF_DEBUG(zero_on_gc, memset(space, 0xbb, n));
+ return space;
+}
+
+void
+stgFreeAligned (void *p)
+{
+#if defined(mingw32_HOST_OS)
+ _aligned_free(p);
+#else
+ free(p);
+#endif
+}
+
/* -----------------------------------------------------------------------------
Stack/heap overflow
-------------------------------------------------------------------------- */
=====================================
rts/RtsUtils.h
=====================================
@@ -29,6 +29,10 @@ char *stgStrndup(const char *s, size_t n);
void stgFree(void* p);
+void *stgMallocAlignedBytes(size_t n, size_t align, char *msg);
+
+void stgFreeAligned(void *p);
+
/* -----------------------------------------------------------------------------
* Misc other utilities
* -------------------------------------------------------------------------- */
=====================================
testsuite/tests/stranal/should_compile/T18982.stderr
=====================================
@@ -1,6 +1,6 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 315, types: 214, coercions: 2, joins: 0/0}
+Result size of Tidy Core = {terms: 311, types: 214, coercions: 4, joins: 0/0}
-- RHS size: {terms: 8, types: 9, coercions: 1, joins: 0/0}
T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int
@@ -210,21 +210,21 @@ T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3
T18982.$tc'ExGADT :: GHC.Types.TyCon
T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1
--- RHS size: {terms: 13, types: 15, coercions: 0, joins: 0/0}
-T18982.$wi :: forall {a} {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int#
-T18982.$wi = \ (@a) (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case RUBBISH[] @(a GHC.Prim.~# Int) of ww2 { __DEFAULT -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } }
+-- RHS size: {terms: 11, types: 10, coercions: 0, joins: 0/0}
+T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int#
+T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# }
--- RHS size: {terms: 15, types: 22, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 15, types: 22, coercions: 1, joins: 0/0}
i :: forall a. ExGADT a -> Int
-i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } }
+i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Prim.~# Int) ww2 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } }
--- RHS size: {terms: 8, types: 12, coercions: 0, joins: 0/0}
-T18982.$wh :: forall {a}. GHC.Prim.Int# -> GHC.Prim.Int#
-T18982.$wh = \ (@a) (ww :: GHC.Prim.Int#) -> case RUBBISH[] @(a GHC.Prim.~# Int) of ww1 { __DEFAULT -> GHC.Prim.+# ww 1# }
+-- RHS size: {terms: 6, types: 7, coercions: 0, joins: 0/0}
+T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int#
+T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1#
--- RHS size: {terms: 14, types: 15, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 14, types: 15, coercions: 1, joins: 0/0}
h :: forall a. GADT a -> Int
-h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } }
+h = \ (@a) (w :: GADT a) -> case w of { GADT ww ww1 -> case ww1 of { GHC.Types.I# ww2 -> case T18982.$wh @a @~(ww :: a GHC.Prim.~# Int) ww2 of ww3 { __DEFAULT -> GHC.Types.I# ww3 } } }
-- RHS size: {terms: 9, types: 4, coercions: 0, joins: 0/0}
T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int#
@@ -232,7 +232,7 @@ T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -
-- RHS size: {terms: 14, types: 11, coercions: 0, joins: 0/0}
g :: Ex Int -> Int
-g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } }
+g = \ (w :: Ex Int) -> case w of { Ex @e ww ww1 -> case ww1 of { GHC.Types.I# ww2 -> case T18982.$wg @e ww ww2 of ww3 { __DEFAULT -> GHC.Types.I# ww3 } } }
-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int#
@@ -240,7 +240,7 @@ T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1#
-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0}
f :: Box Int -> Int
-f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } }
+f = \ (w :: Box Int) -> case w of { Box ww -> case ww of { GHC.Types.I# ww1 -> case T18982.$wf ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } } }
=====================================
testsuite/tests/stranal/should_compile/T19882a.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+
+module T19882a where
+
+import GHC.Exts
+
+f1 :: (# State# RealWorld, Int, Int #) -> Bool -> Int
+f1 x True = 1
+f1 x False = f1 x True
+
=====================================
testsuite/tests/stranal/should_compile/T19882b.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+
+module T19882b where
+
+import GHC.Exts
+
+f2 :: (# State# RealWorld, Int #) -> Bool -> Int
+f2 x True = 1
+f2 x False = f2 x True
=====================================
testsuite/tests/stranal/should_compile/all.T
=====================================
@@ -70,3 +70,5 @@ test('T20663', [ grep_errmsg(r'\$wyeah ::') ], compile, ['-dppr-cols=1000 -ddump
test('T19180', normal, compile, [''])
test('T19849', normal, compile, [''])
test('T22039', normal, compile, [''])
+test('T19882a', normal, compile, [''])
+test('T19882b', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aec09b1a6ffab6c7ddd9e0a6893cee673ffb57d3...8d3c08442b2edd613bbd2484f6e254895c020f61
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aec09b1a6ffab6c7ddd9e0a6893cee673ffb57d3...8d3c08442b2edd613bbd2484f6e254895c020f61
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230222/f0aab115/attachment-0001.html>
More information about the ghc-commits
mailing list