diff options
author | Ben Gamari <ben@well-typed.com> | 2020-09-09 14:19:53 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-14 03:35:07 -0500 |
commit | 74fec146d2dcf05921d58dc81fd5481f9de6d6e9 (patch) | |
tree | 72237da614f773c47900fc327480da5a44e49410 | |
parent | 544329c872cbe8707ebd12def1cfb10f4692f439 (diff) | |
download | haskell-74fec146d2dcf05921d58dc81fd5481f9de6d6e9.tar.gz |
Introduce keepAlive primop
-rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 14 | ||||
-rw-r--r-- | compiler/GHC/Core/Utils.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CoreToStg/Prep.hs | 37 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 2 | ||||
-rw-r--r-- | docs/users_guide/9.0.1-notes.rst | 17 | ||||
-rw-r--r-- | libraries/base/GHC/ForeignPtr.hs | 33 | ||||
-rw-r--r-- | libraries/base/changelog.md | 15 | ||||
-rw-r--r-- | libraries/ghc-prim/changelog.md | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T16012.script | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T16012.stdout | 2 |
10 files changed, 110 insertions, 18 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 2ba94c1982..454c2e3a9e 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -3121,6 +3121,20 @@ primop NumSparks "numSparks#" GenPrimOp has_side_effects = True out_of_line = True + +------------------------------------------------------------------------ +section "Controlling object lifetime" + {Ensuring that objects don't die a premature death.} +------------------------------------------------------------------------ + +-- See Note [keepAlive# magic] in GHC.CoreToStg.Prep. +primop KeepAliveOp "keepAlive#" GenPrimOp + o -> State# RealWorld -> (State# RealWorld -> p) -> p + { TODO. } + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv } + + ------------------------------------------------------------------------ section "Tag to enum stuff" {Convert back and forth between values of enumerated types diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index a67955ad2b..1e34a5fd62 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -1642,6 +1642,8 @@ app_ok primop_ok fun args -> False -- for the special cases for SeqOp and DataToTagOp | DataToTagOp <- op -> False + | KeepAliveOp <- op + -> False | otherwise -> primop_ok op -- Check the primop itself diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index 3b3921f5e2..01934423ed 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -32,7 +32,10 @@ import GHC.Tc.Utils.Env import GHC.Unit import GHC.Builtin.Names +import GHC.Builtin.PrimOps import GHC.Builtin.Types +import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) +import GHC.Types.Id.Make ( realWorldPrimId, mkPrimOpId ) import GHC.Core.Utils import GHC.Core.Opt.Arity @@ -47,6 +50,7 @@ import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Opt.OccurAnal + import GHC.Data.Maybe import GHC.Data.OrdList import GHC.Data.FastString @@ -64,7 +68,6 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Id.Make ( realWorldPrimId ) import GHC.Types.Basic import GHC.Types.Name ( NamedThing(..), nameSrcSpan, isInternalName ) import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) @@ -790,6 +793,38 @@ cpeApp top_env expr -- rather than the far superior "f x y". Test case is par01. = let (terminal, args', depth') = collect_args arg in cpe_app env terminal (args' ++ args) (depth + depth' - 1) + + cpe_app env + (Var f) + args + n + | Just KeepAliveOp <- isPrimOpId_maybe f + , CpeApp (Type arg_rep) + : CpeApp (Type arg_ty) + : CpeApp (Type _result_rep) + : CpeApp (Type result_ty) + : CpeApp arg + : CpeApp s0 + : CpeApp k + : rest <- pprTrace "cpe_app keepAlive#" (ppr args) args + = do { pprTraceM "cpe_app(keepAlive#)" (ppr n) + ; y <- newVar result_ty + ; s2 <- newVar realWorldStatePrimTy + ; -- beta reduce if possible + ; (floats, k') <- case k of + Lam s body -> cpe_app (extendCorePrepEnvExpr env s s0) body rest (n-2) + _ -> cpe_app env k (CpeApp s0 : rest) (n-1) + ; let touchId = mkPrimOpId TouchOp + expr = Case k' y result_ty [Alt DEFAULT [] rhs] + rhs = let scrut = mkApps (Var touchId) [Type arg_rep, Type arg_ty, arg, Var realWorldPrimId] + in Case scrut s2 result_ty [Alt DEFAULT [] (Var y)] + ; pprTraceM "cpe_app(keepAlive)" (ppr expr) + ; (floats', expr') <- cpeBody env expr + ; return (floats `appendFloats` floats', expr') + } + | Just KeepAliveOp <- isPrimOpId_maybe f + = panic "invalid keepAlive# application" + cpe_app env (Var f) (CpeApp _runtimeRep@Type{} : CpeApp _type@Type{} : CpeApp arg : rest) n | f `hasKey` runRWKey -- N.B. While it may appear that n == 1 in the case of runRW# diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index b08edea624..2ea28a8eb2 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -1623,6 +1623,8 @@ emitPrimOp dflags primop = case primop of TraceMarkerOp -> alwaysExternal SetThreadAllocationCounter -> alwaysExternal + KeepAliveOp -> panic "keepAlive# should have been eliminated in CorePrep" + where profile = targetProfile dflags platform = profilePlatform profile diff --git a/docs/users_guide/9.0.1-notes.rst b/docs/users_guide/9.0.1-notes.rst index 46c847191a..95e9852e61 100644 --- a/docs/users_guide/9.0.1-notes.rst +++ b/docs/users_guide/9.0.1-notes.rst @@ -347,12 +347,29 @@ Haddock -- | This comment used to trigger a parse error main = putStrLn "Hello" +``base`` library +~~~~~~~~~~~~~~~~ + +- ``Foreign.ForeignPtr.withForeignPtr`` is now less aggressively optimised, + avoiding the unsoundness issue reported in + :ghc-ticket:`17760` in exchange for a small amount of additional allocation. + + If your application is impacted significantly by this change and the + continuation given to ``withForeignPtr`` will not *provably* diverge (via + throwing of an exception or looping) then the previous optimisation behavior + can be recovered by instead using ``GHC.ForeignPtr.unsafeWithForeignPtr``. + + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ - Add a known-key ``cstringLength#`` to ``GHC.CString`` that is eligible for constant folding by a built-in rule. +- A new primop, ``keepAlive#``, has been introduced to replace ``touch#`` in + controlling object lifetime without the soundness issues affecting the latter + (see :ghc-ticket:`17760`) + ``ghc`` library ~~~~~~~~~~~~~~~ diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 6cc55221f4..79d1614529 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -533,7 +533,13 @@ withForeignPtr = unsafeWithForeignPtr -- throw an exception). In exchange for this loss of generality, this function -- offers the ability of GHC to optimise more aggressively. -- --- See issue #17760 for the motivation for this function. +-- Specifically, applications of the form: +-- @ +-- unsafeWithForeignPtr fptr ('Control.Monad.forever' something) +-- @ +-- +-- See GHC issue #17760 for more information about the unsoundness behavior +-- that this function can result in. unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b unsafeWithForeignPtr fo f = do r <- f (unsafeForeignPtrToPtr fo) @@ -543,18 +549,19 @@ unsafeWithForeignPtr fo f = do touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO --- actions. In particular 'Foreign.ForeignPtr.withForeignPtr' --- does a 'touchForeignPtr' after it --- executes the user action. --- --- Note that this function should not be used to express dependencies --- between finalizers on 'ForeignPtr's. For example, if the finalizer --- for a 'ForeignPtr' @F1@ calls 'touchForeignPtr' on a second --- 'ForeignPtr' @F2@, then the only guarantee is that the finalizer --- for @F2@ is never started before the finalizer for @F1@. They --- might be started together if for example both @F1@ and @F2@ are --- otherwise unreachable, and in that case the scheduler might end up --- running the finalizer for @F2@ first. +-- actions. However, this comes with a significant caveat: the contract above +-- does not hold if GHC can demonstrate that the code preceeding +-- @touchForeignPtr@ diverges (e.g. by looping infinitely or throwing an +-- exception). For this reason, you are strongly advised to use instead +-- 'withForeignPtr' where possible. +-- +-- Also, note that this function should not be used to express dependencies +-- between finalizers on 'ForeignPtr's. For example, if the finalizer for a +-- 'ForeignPtr' @F1@ calls 'touchForeignPtr' on a second 'ForeignPtr' @F2@, +-- then the only guarantee is that the finalizer for @F2@ is never started +-- before the finalizer for @F1@. They might be started together if for +-- example both @F1@ and @F2@ are otherwise unreachable, and in that case the +-- scheduler might end up running the finalizer for @F2@ first. -- -- In general, it is not recommended to use finalizers on separate -- objects with ordering constraints between them. To express the diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 02202aaa60..02df43857a 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -52,17 +52,28 @@ * Add `MonadFix` and `MonadZip` instances for `Complex` * Add `Ix` instances for tuples of size 6 through 15 + + * Correct `Bounded` instance and remove `Enum` and `Integral` instances for + `Data.Ord.Down`. * `catMaybes` is now implemented using `mapMaybe`, so that it is both a "good consumer" and "good producer" for list-fusion (#18574) + * `Foreign.ForeignPtr.withForeignPtr` is now less aggressively optimised, + avoiding the soundness issue reported in + [#17760](https://gitlab.haskell.org/ghc/ghc/-/issues/17760) in exchange for + a small amount more allocation. If your application regresses significantly + *and* the continuation given to `withForeignPtr` will *not* provably + diverge then the previous optimisation behavior can be recovered by instead + using `GHC.ForeignPtr.unsafeWithForeignPtr`. + * Correct `Bounded` instance and remove `Enum` and `Integral` instances for `Data.Ord.Down`. * `Data.Foldable` methods `maximum{,By}`, `minimum{,By}`, `product` and `sum` are now stricter by default, as well as in the class implementation for List. -## 4.14.0.0 *TBA* +## 4.14.0.0 *Jan 2020* * Bundled with GHC 8.10.1 * Add a `TestEquality` instance for the `Compose` newtype. @@ -354,7 +365,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index e36ed57f4e..a4465684d6 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -33,6 +33,10 @@ infix 4 ~, ~~ +- Introduce `keepAlive#` to replace `touch#` in controlling object lifetime without + the soundness issues of the latter (see + [#17760](https://gitlab.haskell.org/ghc/ghc/-/issues/17760)). + ## 0.6.1 (edit as necessary) - Shipped with GHC 8.10.1 diff --git a/testsuite/tests/ghci/should_run/T16012.script b/testsuite/tests/ghci/should_run/T16012.script index ab8b2d0ee0..2394e9c0ec 100644 --- a/testsuite/tests/ghci/should_run/T16012.script +++ b/testsuite/tests/ghci/should_run/T16012.script @@ -3,4 +3,4 @@ -- should always return a reasonably low result. n <- System.Mem.getAllocationCounter -if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) +if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) diff --git a/testsuite/tests/ghci/should_run/T16012.stdout b/testsuite/tests/ghci/should_run/T16012.stdout index 2eb23fdb4c..0951b0f82b 100644 --- a/testsuite/tests/ghci/should_run/T16012.stdout +++ b/testsuite/tests/ghci/should_run/T16012.stdout @@ -1 +1 @@ -Alloction counter in expected range +Allocation counter in expected range |