1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ExistentialQuantification #-}
-----------------------------------------------------------------------------
-- |
-- 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
) 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(..))
-- | A reference to a value of type 'a'.
data StaticPtr a = StaticPtr StaticKey StaticPtrInfo a
-- | 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 k _ _) = k
-- | 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)
-- | Miscelaneous information available for debugging purposes.
data StaticPtrInfo = StaticPtrInfo
{ -- | Package key of the package where the static pointer is defined
spInfoPackageKey :: String
-- | Name of the module where the static pointer is defined
, spInfoModuleName :: String
-- | An internal name that is distinct for every static pointer defined in
-- a given module.
, spInfoName :: 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
|
