X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FObjLink.lhs;h=310ddb5e9b70ad33978c8f0776f27919137a5825;hb=4f7d5513b25571f0eb091b8af04e2225f2802fed;hp=48deb46783a9c9d210455b83c0ac12e76ac0510b;hpb=6ef2fc2ebf11755a54386f8e317d83cb19913be1;p=ghc-hetmet.git diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index 48deb46..310ddb5 100644 --- a/compiler/ghci/ObjLink.lhs +++ b/compiler/ghci/ObjLink.lhs @@ -9,29 +9,27 @@ Primarily, this module consists of an interface to the C-land dynamic linker. \begin{code} -{-# OPTIONS -#include "Linker.h" #-} - module ObjLink ( initObjLinker, -- :: IO () loadDLL, -- :: String -> IO (Maybe String) + loadArchive, -- :: String -> IO () loadObj, -- :: String -> IO () unloadObj, -- :: String -> IO () insertSymbol, -- :: String -> String -> Ptr a -> IO () --- Suspicious; see defn --- insertStableSymbol, -- :: String -> String -> a -> IO () lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) resolveObjs -- :: IO SuccessFlag ) where -import Panic ( panic ) +import Panic import BasicTypes ( SuccessFlag, successIf ) import Config ( cLeadingUnderscore ) -import Outputable import Control.Monad ( when ) import Foreign.C import Foreign ( nullPtr ) -import GHC.Exts ( Ptr(..), unsafeCoerce# ) +import GHC.Exts ( Ptr(..) ) + + -- --------------------------------------------------------------------------- -- RTS Linker Interface @@ -44,15 +42,6 @@ insertSymbol obj_name key symbol withCString str $ \c_str -> c_insertSymbol c_obj_name c_str symbol -{- Deeply suspicious use of unsafeCoerce#; should use makeStablePtr# -insertStableSymbol :: String -> String -> a -> IO () -insertStableSymbol obj_name key symbol - = let str = prefixUnderscore key - in withCString obj_name $ \c_obj_name -> - withCString str $ \c_str -> - c_insertStableSymbol c_obj_name c_str (Ptr (unsafeCoerce# symbol)) --} - lookupSymbol :: String -> IO (Maybe (Ptr a)) lookupSymbol str_in = do let str = prefixUnderscore str_in @@ -77,17 +66,23 @@ loadDLL str = do else do str <- peekCString maybe_errmsg return (Just str) +loadArchive :: String -> IO () +loadArchive str = do + withCString str $ \c_str -> do + r <- c_loadArchive c_str + when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed")) + loadObj :: String -> IO () loadObj str = do withCString str $ \c_str -> do r <- c_loadObj c_str - when (r == 0) (panic "loadObj: failed") + when (r == 0) (panic ("loadObj " ++ show str ++ ": failed")) unloadObj :: String -> IO () unloadObj str = withCString str $ \c_str -> do r <- c_unloadObj c_str - when (r == 0) (panic "unloadObj: failed") + when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed")) resolveObjs :: IO SuccessFlag resolveObjs = do @@ -95,18 +90,15 @@ resolveObjs = do return (successIf (r /= 0)) -- --------------------------------------------------------------------------- --- Foreign declaractions to RTS entry points which does the real work; +-- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- foreign import ccall unsafe "addDLL" c_addDLL :: CString -> IO CString foreign import ccall unsafe "initLinker" initObjLinker :: IO () foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO () --- Suspicious: should take a stable pointer --- foreign import ccall unsafe "insertStableSymbol" c_insertStableSymbol --- :: CString -> CString -> Ptr a -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) +foreign import ccall unsafe "loadArchive" c_loadArchive :: CString -> IO Int foreign import ccall unsafe "loadObj" c_loadObj :: CString -> IO Int foreign import ccall unsafe "unloadObj" c_unloadObj :: CString -> IO Int foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int - \end{code}