{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.StaticPtr -- Copyright : (C) 2014 I/O Tweag -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- Symbolic references to values. -- -- References to values are usually implemented with memory addresses, and this -- is practical when communicating values between the different pieces of a -- single process. -- -- When values are communicated across different processes running in possibly -- different machines, though, addresses are no longer useful since each -- process may use different addresses to store a given value. -- -- To solve such concern, the references provided by this module offer a key -- that can be used to locate the values on each process. Each process maintains -- a global table of references which can be looked up with a given key. This -- table is known as the Static Pointer Table. The reference can then be -- dereferenced to obtain the value. -- ----------------------------------------------------------------------------- module GHC.StaticPtr ( StaticPtr , deRefStaticPtr , StaticKey , staticKey , unsafeLookupStaticPtr , StaticPtrInfo(..) , staticPtrInfo , staticPtrKeys , IsStatic(..) ) where import Foreign.C.Types (CInt(..)) import Foreign.Marshal (allocaArray, peekArray, withArray) import Foreign.Ptr (castPtr) import GHC.Exts (addrToAny#) import GHC.Ptr (Ptr(..), nullPtr) import GHC.Fingerprint (Fingerprint(..)) import GHC.Prim import GHC.Word (Word64(..)) #include "MachDeps.h" -- | A reference to a value of type 'a'. #if WORD_SIZE_IN_BITS < 64 data StaticPtr a = StaticPtr Word64# Word64# -- The flattened Fingerprint is -- convenient in the compiler. StaticPtrInfo a #else data StaticPtr a = StaticPtr Word# Word# StaticPtrInfo a #endif -- | Dereferences a static pointer. deRefStaticPtr :: StaticPtr a -> a deRefStaticPtr (StaticPtr _ _ _ v) = v -- | A key for `StaticPtrs` that can be serialized and used with -- 'unsafeLookupStaticPtr'. type StaticKey = Fingerprint -- | The 'StaticKey' that can be used to look up the given 'StaticPtr'. staticKey :: StaticPtr a -> StaticKey staticKey (StaticPtr w0 w1 _ _) = Fingerprint (W64# w0) (W64# w1) -- | Looks up a 'StaticPtr' by its 'StaticKey'. -- -- If the 'StaticPtr' is not found returns @Nothing@. -- -- This function is unsafe because the program behavior is undefined if the type -- of the returned 'StaticPtr' does not match the expected one. -- unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a)) unsafeLookupStaticPtr (Fingerprint w1 w2) = do ptr@(Ptr addr) <- withArray [w1,w2] (hs_spt_lookup . castPtr) if (ptr == nullPtr) then return Nothing else case addrToAny# addr of (# spe #) -> return (Just spe) foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) -- | A class for things buildable from static pointers. class IsStatic p where fromStaticPtr :: StaticPtr a -> p a -- | @since 4.9.0.0 instance IsStatic StaticPtr where fromStaticPtr = id -- | Miscelaneous information available for debugging purposes. data StaticPtrInfo = StaticPtrInfo { -- | Package key of the package where the static pointer is defined spInfoUnitId :: String -- | Name of the module where the static pointer is defined , spInfoModuleName :: String -- | Source location of the definition of the static pointer as a -- @(Line, Column)@ pair. , spInfoSrcLoc :: (Int, Int) } deriving (Show) -- | 'StaticPtrInfo' of the given 'StaticPtr'. staticPtrInfo :: StaticPtr a -> StaticPtrInfo staticPtrInfo (StaticPtr _ _ n _) = n -- | A list of all known keys. staticPtrKeys :: IO [StaticKey] staticPtrKeys = do keyCount <- hs_spt_key_count allocaArray (fromIntegral keyCount) $ \p -> do count <- hs_spt_keys p keyCount peekArray (fromIntegral count) p >>= mapM (\pa -> peekArray 2 pa >>= \[w1, w2] -> return $ Fingerprint w1 w2) {-# NOINLINE staticPtrKeys #-} foreign import ccall unsafe hs_spt_key_count :: IO CInt foreign import ccall unsafe hs_spt_keys :: Ptr a -> CInt -> IO CInt