never executed always true always false
1 {-# LANGUAGE CPP, UnboxedTuples, MagicHash #-}
2 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
3 --
4 -- (c) The University of Glasgow 2002-2006
5 --
6
7 -- ---------------------------------------------------------------------------
8 -- The dynamic linker for object code (.o .so .dll files)
9 -- ---------------------------------------------------------------------------
10
11 -- | Primarily, this module consists of an interface to the C-land
12 -- dynamic linker.
13 module GHCi.ObjLink
14 ( initObjLinker, ShouldRetainCAFs(..)
15 , loadDLL
16 , loadArchive
17 , loadObj
18 , unloadObj
19 , purgeObj
20 , lookupSymbol
21 , lookupClosure
22 , resolveObjs
23 , addLibrarySearchPath
24 , removeLibrarySearchPath
25 , findSystemLibrary
26 ) where
27
28 import Prelude -- See note [Why do we import Prelude here?]
29 import GHCi.RemoteTypes
30 import Control.Exception (throwIO, ErrorCall(..))
31 import Control.Monad ( when )
32 import Foreign.C
33 import Foreign.Marshal.Alloc ( free )
34 import Foreign ( nullPtr )
35 import GHC.Exts
36 import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath )
37 import System.FilePath ( dropExtension, normalise )
38
39
40
41
42 -- ---------------------------------------------------------------------------
43 -- RTS Linker Interface
44 -- ---------------------------------------------------------------------------
45
46 data ShouldRetainCAFs
47 = RetainCAFs
48 -- ^ Retain CAFs unconditionally in linked Haskell code.
49 -- Note that this prevents any code from being unloaded.
50 -- It should not be necessary unless you are GHCi or
51 -- hs-plugins, which needs to be able call any function
52 -- in the compiled code.
53 | DontRetainCAFs
54 -- ^ Do not retain CAFs. Everything reachable from foreign
55 -- exports will be retained, due to the StablePtrs
56 -- created by the module initialisation code. unloadObj
57 -- frees these StablePtrs, which will allow the CAFs to
58 -- be GC'd and the code to be removed.
59
60 initObjLinker :: ShouldRetainCAFs -> IO ()
61 initObjLinker RetainCAFs = c_initLinker_ 1
62 initObjLinker _ = c_initLinker_ 0
63
64 lookupSymbol :: String -> IO (Maybe (Ptr a))
65 lookupSymbol str_in = do
66 let str = prefixUnderscore str_in
67 withCAString str $ \c_str -> do
68 addr <- c_lookupSymbol c_str
69 if addr == nullPtr
70 then return Nothing
71 else return (Just addr)
72
73 lookupClosure :: String -> IO (Maybe HValueRef)
74 lookupClosure str = do
75 m <- lookupSymbol str
76 case m of
77 Nothing -> return Nothing
78 Just (Ptr addr) -> case addrToAny# addr of
79 (# a #) -> Just <$> mkRemoteRef (HValue a)
80
81 prefixUnderscore :: String -> String
82 prefixUnderscore
83 | cLeadingUnderscore = ('_':)
84 | otherwise = id
85
86 -- | loadDLL loads a dynamic library using the OS's native linker
87 -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either
88 -- an absolute pathname to the file, or a relative filename
89 -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL
90 -- searches the standard locations for the appropriate library.
91 --
92 loadDLL :: String -> IO (Maybe String)
93 -- Nothing => success
94 -- Just err_msg => failure
95 loadDLL str0 = do
96 let
97 -- On Windows, addDLL takes a filename without an extension, because
98 -- it tries adding both .dll and .drv. To keep things uniform in the
99 -- layers above, loadDLL always takes a filename with an extension, and
100 -- we drop it here on Windows only.
101 str | isWindowsHost = dropExtension str0
102 | otherwise = str0
103 --
104 maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll
105 if maybe_errmsg == nullPtr
106 then return Nothing
107 else do str <- peekCString maybe_errmsg
108 free maybe_errmsg
109 return (Just str)
110
111 loadArchive :: String -> IO ()
112 loadArchive str = do
113 withFilePath str $ \c_str -> do
114 r <- c_loadArchive c_str
115 when (r == 0) (throwIO (ErrorCall ("loadArchive " ++ show str ++ ": failed")))
116
117 loadObj :: String -> IO ()
118 loadObj str = do
119 withFilePath str $ \c_str -> do
120 r <- c_loadObj c_str
121 when (r == 0) (throwIO (ErrorCall ("loadObj " ++ show str ++ ": failed")))
122
123 -- | @unloadObj@ drops the given dynamic library from the symbol table
124 -- as well as enables the library to be removed from memory during
125 -- a future major GC.
126 unloadObj :: String -> IO ()
127 unloadObj str =
128 withFilePath str $ \c_str -> do
129 r <- c_unloadObj c_str
130 when (r == 0) (throwIO (ErrorCall ("unloadObj " ++ show str ++ ": failed")))
131
132 -- | @purgeObj@ drops the symbols for the dynamic library from the symbol
133 -- table. Unlike 'unloadObj', the library will not be dropped memory during
134 -- a future major GC.
135 purgeObj :: String -> IO ()
136 purgeObj str =
137 withFilePath str $ \c_str -> do
138 r <- c_purgeObj c_str
139 when (r == 0) (throwIO (ErrorCall ("purgeObj " ++ show str ++ ": failed")))
140
141 addLibrarySearchPath :: String -> IO (Ptr ())
142 addLibrarySearchPath str =
143 withFilePath str c_addLibrarySearchPath
144
145 removeLibrarySearchPath :: Ptr () -> IO Bool
146 removeLibrarySearchPath = c_removeLibrarySearchPath
147
148 findSystemLibrary :: String -> IO (Maybe String)
149 findSystemLibrary str = do
150 result <- withFilePath str c_findSystemLibrary
151 case result == nullPtr of
152 True -> return Nothing
153 False -> do path <- peekFilePath result
154 free result
155 return $ Just path
156
157 resolveObjs :: IO Bool
158 resolveObjs = do
159 r <- c_resolveObjs
160 return (r /= 0)
161
162 -- ---------------------------------------------------------------------------
163 -- Foreign declarations to RTS entry points which does the real work;
164 -- ---------------------------------------------------------------------------
165
166 foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString
167 foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO ()
168 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
169 foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int
170 foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int
171 foreign import ccall unsafe "purgeObj" c_purgeObj :: CFilePath -> IO Int
172 foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int
173 foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int
174 foreign import ccall unsafe "addLibrarySearchPath" c_addLibrarySearchPath :: CFilePath -> IO (Ptr ())
175 foreign import ccall unsafe "findSystemLibrary" c_findSystemLibrary :: CFilePath -> IO CFilePath
176 foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr() -> IO Bool
177
178 -- -----------------------------------------------------------------------------
179 -- Configuration
180
181 #include "ghcautoconf.h"
182
183 cLeadingUnderscore :: Bool
184 #if defined(LEADING_UNDERSCORE)
185 cLeadingUnderscore = True
186 #else
187 cLeadingUnderscore = False
188 #endif
189
190 isWindowsHost :: Bool
191 #if defined(mingw32_HOST_OS)
192 isWindowsHost = True
193 #else
194 isWindowsHost = False
195 #endif