Fix archive loading on Windows by the runtime loader
[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, -- :: FilePath -> IO (Ptr ())
21 removeLibrarySearchPath, -- :: Ptr () -> IO Bool
22 findSystemLibrary -- :: FilePath -> IO (Maybe FilePath)
23 ) where
24
25 import Panic
26 import BasicTypes ( SuccessFlag, successIf )
27 import Config ( cLeadingUnderscore )
28 import Util
29
30 import Control.Monad ( when )
31 import Foreign.C
32 import Foreign.Marshal.Alloc ( free )
33 import Foreign ( nullPtr )
34 import GHC.Exts ( Ptr(..) )
35 import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath )
36 import System.FilePath ( dropExtension, normalise )
37
38
39 -- ---------------------------------------------------------------------------
40 -- RTS Linker Interface
41 -- ---------------------------------------------------------------------------
42
43 insertSymbol :: String -> String -> Ptr a -> IO ()
44 insertSymbol obj_name key symbol
45 = let str = prefixUnderscore key
46 in withFilePath obj_name $ \c_obj_name ->
47 withCAString str $ \c_str ->
48 c_insertSymbol c_obj_name c_str symbol
49
50 lookupSymbol :: String -> IO (Maybe (Ptr a))
51 lookupSymbol str_in = do
52 let str = prefixUnderscore str_in
53 withCAString str $ \c_str -> do
54 addr <- c_lookupSymbol c_str
55 if addr == nullPtr
56 then return Nothing
57 else return (Just addr)
58
59 prefixUnderscore :: String -> String
60 prefixUnderscore
61 | cLeadingUnderscore == "YES" = ('_':)
62 | otherwise = id
63
64 -- | loadDLL loads a dynamic library using the OS's native linker
65 -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either
66 -- an absolute pathname to the file, or a relative filename
67 -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL
68 -- searches the standard locations for the appropriate library.
69 --
70 loadDLL :: String -> IO (Maybe String)
71 -- Nothing => success
72 -- Just err_msg => failure
73 loadDLL str0 = do
74 let
75 -- On Windows, addDLL takes a filename without an extension, because
76 -- it tries adding both .dll and .drv. To keep things uniform in the
77 -- layers above, loadDLL always takes a filename with an extension, and
78 -- we drop it here on Windows only.
79 str | isWindowsHost = dropExtension str0
80 | otherwise = str0
81 --
82 maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll
83 if maybe_errmsg == nullPtr
84 then return Nothing
85 else do str <- peekCString maybe_errmsg
86 free maybe_errmsg
87 return (Just str)
88
89 loadArchive :: String -> IO ()
90 loadArchive str = do
91 withFilePath str $ \c_str -> do
92 r <- c_loadArchive c_str
93 when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))
94
95 loadObj :: String -> IO ()
96 loadObj str = do
97 withFilePath str $ \c_str -> do
98 r <- c_loadObj c_str
99 when (r == 0) (panic ("loadObj " ++ show str ++ ": failed"))
100
101 unloadObj :: String -> IO ()
102 unloadObj str =
103 withFilePath str $ \c_str -> do
104 r <- c_unloadObj c_str
105 when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed"))
106
107 addLibrarySearchPath :: String -> IO (Ptr ())
108 addLibrarySearchPath str =
109 withFilePath str c_addLibrarySearchPath
110
111 removeLibrarySearchPath :: Ptr () -> IO Bool
112 removeLibrarySearchPath = c_removeLibrarySearchPath
113
114 findSystemLibrary :: String -> IO (Maybe String)
115 findSystemLibrary str = do
116 result <- withFilePath str c_findSystemLibrary
117 case result == nullPtr of
118 True -> return Nothing
119 False -> do path <- peekFilePath result
120 free result
121 return $ Just path
122
123 resolveObjs :: IO SuccessFlag
124 resolveObjs = do
125 r <- c_resolveObjs
126 return (successIf (r /= 0))
127
128 -- ---------------------------------------------------------------------------
129 -- Foreign declarations to RTS entry points which does the real work;
130 -- ---------------------------------------------------------------------------
131
132 foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString
133 foreign import ccall unsafe "initLinker" initObjLinker :: IO ()
134 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CFilePath -> CString -> Ptr a -> IO ()
135 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
136 foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int
137 foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int
138 foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int
139 foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int
140 foreign import ccall unsafe "addLibrarySearchPath" c_addLibrarySearchPath :: CFilePath -> IO (Ptr ())
141 foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr () -> IO Bool
142 foreign import ccall unsafe "findSystemLibrary" c_findSystemLibrary :: CFilePath -> IO CFilePath