d5d4980387366085b2ef3b4c58299582b2fc4125
[ghc.git] / compiler / ghci / ObjLink.hs
1 --
2 -- (c) The University of Glasgow 2002-2006
3 --
4
5 -- ---------------------------------------------------------------------------
6 -- The dynamic linker for object code (.o .so .dll files)
7 -- ---------------------------------------------------------------------------
8
9 -- | Primarily, this module consists of an interface to the C-land
10 -- dynamic linker.
11 module ObjLink (
12 initObjLinker, -- :: IO ()
13 loadDLL, -- :: String -> IO (Maybe String)
14 loadArchive, -- :: String -> IO ()
15 loadObj, -- :: String -> IO ()
16 unloadObj, -- :: String -> IO ()
17 insertSymbol, -- :: String -> String -> Ptr a -> IO ()
18 lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
19 resolveObjs, -- :: IO SuccessFlag
20 addLibrarySearchPath, -- :: CFilePath -> IO (Ptr ())
21 removeLibrarySearchPath -- :: Ptr() -> IO Bool
22 ) where
23
24 import Panic
25 import BasicTypes ( SuccessFlag, successIf )
26 import Config ( cLeadingUnderscore )
27 import Util
28
29 import Control.Monad ( when )
30 import Foreign.C
31 import Foreign ( nullPtr )
32 import GHC.Exts ( Ptr(..) )
33 import System.Posix.Internals ( CFilePath, withFilePath )
34 import System.FilePath ( dropExtension, normalise )
35
36
37 -- ---------------------------------------------------------------------------
38 -- RTS Linker Interface
39 -- ---------------------------------------------------------------------------
40
41 insertSymbol :: String -> String -> Ptr a -> IO ()
42 insertSymbol obj_name key symbol
43 = let str = prefixUnderscore key
44 in withFilePath obj_name $ \c_obj_name ->
45 withCAString str $ \c_str ->
46 c_insertSymbol c_obj_name c_str symbol
47
48 lookupSymbol :: String -> IO (Maybe (Ptr a))
49 lookupSymbol str_in = do
50 let str = prefixUnderscore str_in
51 withCAString str $ \c_str -> do
52 addr <- c_lookupSymbol c_str
53 if addr == nullPtr
54 then return Nothing
55 else return (Just addr)
56
57 prefixUnderscore :: String -> String
58 prefixUnderscore
59 | cLeadingUnderscore == "YES" = ('_':)
60 | otherwise = id
61
62 -- | loadDLL loads a dynamic library using the OS's native linker
63 -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either
64 -- an absolute pathname to the file, or a relative filename
65 -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL
66 -- searches the standard locations for the appropriate library.
67 --
68 loadDLL :: String -> IO (Maybe String)
69 -- Nothing => success
70 -- Just err_msg => failure
71 loadDLL str0 = do
72 let
73 -- On Windows, addDLL takes a filename without an extension, because
74 -- it tries adding both .dll and .drv. To keep things uniform in the
75 -- layers above, loadDLL always takes a filename with an extension, and
76 -- we drop it here on Windows only.
77 str | isWindowsHost = dropExtension str0
78 | otherwise = str0
79 --
80 maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll
81 if maybe_errmsg == nullPtr
82 then return Nothing
83 else do str <- peekCString maybe_errmsg
84 return (Just str)
85
86 loadArchive :: String -> IO ()
87 loadArchive str = do
88 withFilePath str $ \c_str -> do
89 r <- c_loadArchive c_str
90 when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))
91
92 loadObj :: String -> IO ()
93 loadObj str = do
94 withFilePath str $ \c_str -> do
95 r <- c_loadObj c_str
96 when (r == 0) (panic ("loadObj " ++ show str ++ ": failed"))
97
98 unloadObj :: String -> IO ()
99 unloadObj str =
100 withFilePath str $ \c_str -> do
101 r <- c_unloadObj c_str
102 when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed"))
103
104 addLibrarySearchPath :: String -> IO (Ptr ())
105 addLibrarySearchPath str =
106 withFilePath str c_addLibrarySearchPath
107
108 removeLibrarySearchPath :: Ptr () -> IO Bool
109 removeLibrarySearchPath = c_removeLibrarySearchPath
110
111 resolveObjs :: IO SuccessFlag
112 resolveObjs = do
113 r <- c_resolveObjs
114 return (successIf (r /= 0))
115
116 -- ---------------------------------------------------------------------------
117 -- Foreign declarations to RTS entry points which does the real work;
118 -- ---------------------------------------------------------------------------
119
120 foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString
121 foreign import ccall unsafe "initLinker" initObjLinker :: IO ()
122 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CFilePath -> CString -> Ptr a -> IO ()
123 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
124 foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int
125 foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int
126 foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int
127 foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int
128 foreign import ccall unsafe "addLibrarySearchPath" c_addLibrarySearchPath :: CFilePath -> IO (Ptr ())
129 foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr() -> IO Bool