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 {-# OPTIONS -#include "Linker.h" #-}
  13
  14 module ObjLink (
  15    initObjLinker,        -- :: IO ()
  16    loadDLL,              -- :: String -> IO (Maybe String)
  17    loadObj,              -- :: String -> IO ()
  18    unloadObj,            -- :: String -> IO ()
  19    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()
  20    lookupSymbol,         -- :: String -> IO (Maybe (Ptr a))
  21    resolveObjs,          -- :: IO SuccessFlag
  22    lookupDataCon         -- :: Ptr a  -> IO (Maybe String)
  23   )  where
  24
  25 import ByteCodeItbls    ( StgInfoTable )
  26 import Panic            ( panic )
  27 import BasicTypes       ( SuccessFlag, successIf )
  28 import Config           ( cLeadingUnderscore )
  29 import Outputable
  30
  31 import Control.Monad    ( when )
  32 import Foreign.C
  33 import Foreign          ( nullPtr )
  34 import GHC.Exts         ( Ptr(..), unsafeCoerce# )
  35
  36 import Constants        ( wORD_SIZE )
  37 import Foreign          ( plusPtr )
  38
  39
  40 -- ---------------------------------------------------------------------------
  41 -- RTS Linker Interface
  42 -- ---------------------------------------------------------------------------
  43
  44 insertSymbol :: String -> String -> Ptr a -> IO ()
  45 insertSymbol obj_name key symbol
  46     = let str = prefixUnderscore key
  47       in withCString obj_name $ \c_obj_name ->
  48          withCString 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    withCString 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 -- | Expects a Ptr to an info table, not to a closure
  61 lookupDataCon :: Ptr StgInfoTable -> IO (Maybe String)
  62 lookupDataCon ptr = do
  63     name <- c_lookupDataCon  (ptr `plusPtr` (wORD_SIZE*2))
  64     if name == nullPtr
  65        then return Nothing
  66        else peekCString name >>= return . Just
  67
  68 prefixUnderscore :: String -> String
  69 prefixUnderscore
  70  | cLeadingUnderscore == "YES" = ('_':)
  71  | otherwise                   = id
  72
  73 loadDLL :: String -> IO (Maybe String)
  74 -- Nothing      => success
  75 -- Just err_msg => failure
  76 loadDLL str = do
  77   maybe_errmsg <- withCString str $ \dll -> c_addDLL dll
  78   if maybe_errmsg == nullPtr
  79         then return Nothing
  80         else do str <- peekCString maybe_errmsg
  81                 return (Just str)
  82
  83 loadObj :: String -> IO ()
  84 loadObj str = do
  85    withCString str $ \c_str -> do
  86      r <- c_loadObj c_str
  87      when (r == 0) (panic "loadObj: failed")
  88
  89 unloadObj :: String -> IO ()
  90 unloadObj str =
  91    withCString str $ \c_str -> do
  92      r <- c_unloadObj c_str
  93      when (r == 0) (panic "unloadObj: failed")
  94
  95 resolveObjs :: IO SuccessFlag
  96 resolveObjs = do
  97    r <- c_resolveObjs
  98    return (successIf (r /= 0))
  99
 100 -- ---------------------------------------------------------------------------
 101 -- Foreign declaractions to RTS entry points which does the real work;
 102 -- ---------------------------------------------------------------------------
 103
 104 foreign import ccall unsafe "addDLL"       c_addDLL :: CString -> IO CString
 105 foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
 106 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()
 107 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
 108 foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
 109 foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int
 110 foreign import ccall unsafe "resolveObjs"  c_resolveObjs :: IO Int
 111 foreign import ccall unsafe "lookupDataCon"  c_lookupDataCon :: Ptr a -> IO CString
 112
 113 \end{code}