ObjLink.hs 5.69 KB
Newer Older
1 2 3
--
--  (c) The University of Glasgow 2002-2006
--
4 5

-- ---------------------------------------------------------------------------
6
--      The dynamic linker for object code (.o .so .dll files)
7 8
-- ---------------------------------------------------------------------------

9 10
-- | Primarily, this module consists of an interface to the C-land
-- dynamic linker.
11
module ObjLink (
12 13 14 15 16 17 18 19 20 21 22
   initObjLinker,           -- :: IO ()
   loadDLL,                 -- :: String   -> IO (Maybe String)
   loadArchive,             -- :: String   -> IO ()
   loadObj,                 -- :: String   -> IO ()
   unloadObj,               -- :: String   -> IO ()
   insertSymbol,            -- :: String   -> String -> Ptr a -> IO ()
   lookupSymbol,            -- :: String   -> IO (Maybe (Ptr a))
   resolveObjs,             -- :: IO SuccessFlag
   addLibrarySearchPath,    -- :: FilePath -> IO (Ptr ())
   removeLibrarySearchPath, -- :: Ptr ()   -> IO Bool
   findSystemLibrary        -- :: FilePath -> IO (Maybe FilePath)
23 24
  )  where

Ian Lynagh's avatar
Ian Lynagh committed
25
import Panic
26 27
import BasicTypes       ( SuccessFlag, successIf )
import Config           ( cLeadingUnderscore )
28
import Util
29

30 31
import Control.Monad    ( when )
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 41 42
-- ---------------------------------------------------------------------------
-- RTS Linker Interface
-- ---------------------------------------------------------------------------

43 44 45
insertSymbol :: String -> String -> Ptr a -> IO ()
insertSymbol obj_name key symbol
    = let str = prefixUnderscore key
46
      in withFilePath obj_name $ \c_obj_name ->
47
         withCAString str $ \c_str ->
48 49
          c_insertSymbol c_obj_name c_str symbol

50 51 52
lookupSymbol :: String -> IO (Maybe (Ptr a))
lookupSymbol str_in = do
   let str = prefixUnderscore str_in
53
   withCAString str $ \c_str -> do
54 55
     addr <- c_lookupSymbol c_str
     if addr == nullPtr
56 57
        then return Nothing
        else return (Just addr)
58

59 60 61 62 63
prefixUnderscore :: String -> String
prefixUnderscore
 | cLeadingUnderscore == "YES" = ('_':)
 | otherwise                   = id

64 65 66 67 68 69
-- | loadDLL loads a dynamic library using the OS's native linker
-- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either
-- an absolute pathname to the file, or a relative filename
-- (e.g. "libfoo.so" or "foo.dll").  In the latter case, loadDLL
-- searches the standard locations for the appropriate library.
--
70 71 72
loadDLL :: String -> IO (Maybe String)
-- Nothing      => success
-- Just err_msg => failure
73 74 75 76 77 78 79 80 81
loadDLL str0 = do
  let
     -- On Windows, addDLL takes a filename without an extension, because
     -- it tries adding both .dll and .drv.  To keep things uniform in the
     -- layers above, loadDLL always takes a filename with an extension, and
     -- we drop it here on Windows only.
     str | isWindowsHost = dropExtension str0
         | otherwise     = str0
  --
82
  maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll
83
  if maybe_errmsg == nullPtr
84 85
        then return Nothing
        else do str <- peekCString maybe_errmsg
86
                free maybe_errmsg
87
                return (Just str)
88

89 90
loadArchive :: String -> IO ()
loadArchive str = do
91
   withFilePath str $ \c_str -> do
92 93 94
     r <- c_loadArchive c_str
     when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))

95 96
loadObj :: String -> IO ()
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 102

unloadObj :: String -> IO ()
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 108 109 110 111 112 113
addLibrarySearchPath :: String -> IO (Ptr ())
addLibrarySearchPath str =
   withFilePath str c_addLibrarySearchPath

removeLibrarySearchPath :: Ptr () -> IO Bool
removeLibrarySearchPath = c_removeLibrarySearchPath

114 115 116 117 118 119 120 121 122
findSystemLibrary :: String -> IO (Maybe String)
findSystemLibrary str = do
    result <- withFilePath str c_findSystemLibrary
    case result == nullPtr of
        True  -> return Nothing
        False -> do path <- peekFilePath result
                    free result
                    return $ Just path

123 124 125 126 127 128
resolveObjs :: IO SuccessFlag
resolveObjs = do
   r <- c_resolveObjs
   return (successIf (r /= 0))

-- ---------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
129
-- Foreign declarations to RTS entry points which does the real work;
130 131
-- ---------------------------------------------------------------------------

132 133 134
foreign import ccall unsafe "addDLL"                  c_addDLL                  :: CFilePath -> IO CString
foreign import ccall unsafe "initLinker"              initObjLinker             :: IO ()
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 137 138 139 140
foreign import ccall unsafe "loadArchive"             c_loadArchive             :: CFilePath -> IO Int
foreign import ccall unsafe "loadObj"                 c_loadObj                 :: CFilePath -> IO Int
foreign import ccall unsafe "unloadObj"               c_unloadObj               :: CFilePath -> IO Int
foreign import ccall unsafe "resolveObjs"             c_resolveObjs             :: IO Int
foreign import ccall unsafe "addLibrarySearchPath"    c_addLibrarySearchPath    :: CFilePath -> IO (Ptr ())
141 142
foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr ()    -> IO Bool
foreign import ccall unsafe "findSystemLibrary"       c_findSystemLibrary       :: CFilePath -> IO CFilePath