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
115
116
117
118
|
{-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
-- |
-- Types for referring to remote objects in Remote GHCi. For more
-- details, see Note [External GHCi pointers] in compiler/GHC/Runtime/Interpreter.hs
--
-- For details on Remote GHCi, see Note [Remote GHCi] in
-- compiler/GHC/Runtime/Interpreter.hs.
--
module GHCi.RemoteTypes
( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr
, HValue(..)
, RemoteRef, mkRemoteRef, localRef, freeRemoteRef
, HValueRef, toHValueRef
, ForeignRef, mkForeignRef, withForeignRef
, ForeignHValue
, unsafeForeignRefToRemoteRef, finalizeForeignRef
) where
import Prelude -- See note [Why do we import Prelude here?]
import Control.DeepSeq
import Data.Word
import Foreign hiding (newForeignPtr)
import Foreign.Concurrent
import Data.Binary
import Unsafe.Coerce
import GHC.Exts
import GHC.ForeignPtr
-- -----------------------------------------------------------------------------
-- RemotePtr
-- Static pointers only; don't use this for heap-resident pointers.
-- Instead use HValueRef. We will fix the remote pointer to be 64 bits. This
-- should cover 64 and 32bit systems, and permits the exchange of remote ptrs
-- between machines of different word size. For example, when connecting to
-- an iserv instance on a different architecture with different word size via
-- -fexternal-interpreter.
newtype RemotePtr a = RemotePtr Word64
toRemotePtr :: Ptr a -> RemotePtr a
toRemotePtr p = RemotePtr (fromIntegral (ptrToWordPtr p))
fromRemotePtr :: RemotePtr a -> Ptr a
fromRemotePtr (RemotePtr p) = wordPtrToPtr (fromIntegral p)
castRemotePtr :: RemotePtr a -> RemotePtr b
castRemotePtr (RemotePtr a) = RemotePtr a
deriving instance Show (RemotePtr a)
deriving instance Binary (RemotePtr a)
deriving instance NFData (RemotePtr a)
-- -----------------------------------------------------------------------------
-- HValueRef
newtype HValue = HValue Any
instance Show HValue where
show _ = "<HValue>"
-- | A reference to a remote value. These are allocated and freed explicitly.
newtype RemoteRef a = RemoteRef (RemotePtr ())
deriving (Show, Binary)
-- We can discard type information if we want
toHValueRef :: RemoteRef a -> RemoteRef HValue
toHValueRef = unsafeCoerce
-- For convenience
type HValueRef = RemoteRef HValue
-- | Make a reference to a local value that we can send remotely.
-- This reference will keep the value that it refers to alive until
-- 'freeRemoteRef' is called.
mkRemoteRef :: a -> IO (RemoteRef a)
mkRemoteRef a = do
sp <- newStablePtr a
return $! RemoteRef (toRemotePtr (castStablePtrToPtr sp))
-- | Convert an HValueRef to an HValue. Should only be used if the HValue
-- originated in this process.
localRef :: RemoteRef a -> IO a
localRef (RemoteRef w) =
deRefStablePtr (castPtrToStablePtr (fromRemotePtr w))
-- | Release an HValueRef that originated in this process
freeRemoteRef :: RemoteRef a -> IO ()
freeRemoteRef (RemoteRef w) =
freeStablePtr (castPtrToStablePtr (fromRemotePtr w))
-- | An HValueRef with a finalizer
newtype ForeignRef a = ForeignRef (ForeignPtr ())
instance NFData (ForeignRef a) where
rnf x = x `seq` ()
type ForeignHValue = ForeignRef HValue
-- | Create a 'ForeignRef' from a 'RemoteRef'. The finalizer
-- should arrange to call 'freeHValueRef' on the 'HValueRef'. (since
-- this function needs to be called in the process that created the
-- 'HValueRef', it cannot be called directly from the finalizer).
mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)
mkForeignRef (RemoteRef hvref) finalizer =
ForeignRef <$> newForeignPtr (fromRemotePtr hvref) finalizer
-- | Use a 'ForeignHValue'
withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef (ForeignRef fp) f =
withForeignPtr fp (f . RemoteRef . toRemotePtr)
unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef (ForeignRef fp) =
RemoteRef (toRemotePtr (unsafeForeignPtrToPtr fp))
finalizeForeignRef :: ForeignRef a -> IO ()
finalizeForeignRef (ForeignRef fp) = finalizeForeignPtr fp
|
