compiler/ghci/ObjLink.lhs

   1 %
   2 % (c) The University of Glasgow, 2000-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 dynamic linker.
  10
  11 \begin{code}
  12 module ObjLink (
  13    initObjLinker,        -- :: IO ()
  14    loadDLL,              -- :: String -> IO (Maybe String)
  15    loadArchive,          -- :: String -> IO ()
  16    loadObj,              -- :: String -> IO ()
  17    unloadObj,            -- :: String -> IO ()
  18    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()
  19    lookupSymbol,         -- :: String -> IO (Maybe (Ptr a))
  20    resolveObjs           -- :: IO SuccessFlag
  21   )  where
  22
  23 import Panic
  24 import BasicTypes       ( SuccessFlag, successIf )
  25 import Config           ( cLeadingUnderscore )
  26
  27 import Control.Monad    ( when )
  28 import Foreign.C
  29 import Foreign          ( nullPtr )
  30 import GHC.Exts         ( Ptr(..) )
  31 import GHC.IO.Encoding  ( fileSystemEncoding )
  32 import qualified GHC.Foreign as GHC
  33
  34
  35
  36 -- ---------------------------------------------------------------------------
  37 -- RTS Linker Interface
  38 -- ---------------------------------------------------------------------------
  39
  40 -- UNICODE FIXME: Unicode object/archive/DLL file names on Windows will only work in the right code page
  41 withFileCString :: FilePath -> (CString -> IO a) -> IO a
  42 withFileCString = GHC.withCString fileSystemEncoding
  43
  44 insertSymbol :: String -> String -> Ptr a -> IO ()
  45 insertSymbol obj_name key symbol
  46     = let str = prefixUnderscore key
  47       in withFileCString obj_name $ \c_obj_name ->
  48          withCAString str $ \c_str ->
  49           c_insertSymbol c_obj_name c_str symbol
  50
  51 lookupSymbol :: String -> IO (Maybe (Ptr a))
  52 lookupSymbol str_in = do
  53    let str = prefixUnderscore str_in
  54    withCAString str $ \c_str -> do
  55      addr <- c_lookupSymbol c_str
  56      if addr == nullPtr
  57         then return Nothing
  58         else return (Just addr)
  59
  60 prefixUnderscore :: String -> String
  61 prefixUnderscore
  62  | cLeadingUnderscore == "YES" = ('_':)
  63  | otherwise                   = id
  64
  65 loadDLL :: String -> IO (Maybe String)
  66 -- Nothing      => success
  67 -- Just err_msg => failure
  68 loadDLL str = do
  69   maybe_errmsg <- withFileCString str $ \dll -> c_addDLL dll
  70   if maybe_errmsg == nullPtr
  71         then return Nothing
  72         else do str <- peekCString maybe_errmsg
  73                 return (Just str)
  74
  75 loadArchive :: String -> IO ()
  76 loadArchive str = do
  77    withFileCString str $ \c_str -> do
  78      r <- c_loadArchive c_str
  79      when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))
  80
  81 loadObj :: String -> IO ()
  82 loadObj str = do
  83    withFileCString str $ \c_str -> do
  84      r <- c_loadObj c_str
  85      when (r == 0) (panic ("loadObj " ++ show str ++ ": failed"))
  86
  87 unloadObj :: String -> IO ()
  88 unloadObj str =
  89    withFileCString str $ \c_str -> do
  90      r <- c_unloadObj c_str
  91      when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed"))
  92
  93 resolveObjs :: IO SuccessFlag
  94 resolveObjs = do
  95    r <- c_resolveObjs
  96    return (successIf (r /= 0))
  97
  98 -- ---------------------------------------------------------------------------
  99 -- Foreign declarations to RTS entry points which does the real work;
 100 -- ---------------------------------------------------------------------------
 101
 102 foreign import ccall unsafe "addDLL"       c_addDLL :: CString -> IO CString
 103 foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
 104 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()
 105 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
 106 foreign import ccall unsafe "loadArchive"  c_loadArchive :: CString -> IO Int
 107 foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
 108 foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int
 109 foreign import ccall unsafe "resolveObjs"  c_resolveObjs :: IO Int
 110 \end{code}