diff options
Diffstat (limited to 'libraries/base/GHC/Conc/Sync.hs')
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 14 |
1 files changed, 14 insertions, 0 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 5476950ec7..5986379cb3 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -59,6 +59,8 @@ module GHC.Conc.Sync , threadStatus , threadCapability + , newStablePtrPrimMVar, PrimMVar + -- * Allocation counter and quota , setAllocationCounter , getAllocationCounter @@ -117,6 +119,7 @@ import GHC.MVar import GHC.Ptr import GHC.Real ( fromIntegral ) import GHC.Show ( Show(..), showString ) +import GHC.Stable ( StablePtr(..) ) import GHC.Weak infixr 0 `par`, `pseq` @@ -615,6 +618,17 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s -> (# s1, w #) -> (# s1, Weak w #) +data PrimMVar + +-- | Make a StablePtr that can be passed to the C function +-- @hs_try_putmvar()@. The RTS wants a 'StablePtr' to the underlying +-- 'MVar#', but a 'StablePtr#' can only refer to lifted types, so we +-- have to cheat by coercing. +newStablePtrPrimMVar :: MVar () -> IO (StablePtr PrimMVar) +newStablePtrPrimMVar (MVar m) = IO $ \s0 -> + case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of + (# s1, sp #) -> (# s1, StablePtr sp #) + ----------------------------------------------------------------------------- -- Transactional heap operations ----------------------------------------------------------------------------- |