X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FObjLink.lhs;h=310ddb5e9b70ad33978c8f0776f27919137a5825;hb=4f7d5513b25571f0eb091b8af04e2225f2802fed;hp=f46532fbad029a956f48e09ce322d010f09348d1;hpb=ab22f4e6456820c1b5169d75f5975a94e61f54ce;p=ghc-hetmet.git diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index f46532f..310ddb5 100644 --- a/compiler/ghci/ObjLink.lhs +++ b/compiler/ghci/ObjLink.lhs @@ -9,28 +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 () - 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 @@ -43,13 +42,6 @@ insertSymbol obj_name key symbol withCString str $ \c_str -> c_insertSymbol c_obj_name c_str symbol -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 @@ -74,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 @@ -92,29 +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; -- --------------------------------------------------------------------------- -#if __GLASGOW_HASKELL__ >= 504 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 () -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 -#else -foreign import "addDLL" unsafe c_addDLL :: CString -> IO CString -foreign import "initLinker" unsafe initLinker :: IO () -foreign import "insertSymbol" unsafe c_insertSymbol :: CString -> CString -> Ptr a -> IO () -foreign import "insertStableSymbol" unsafe c_insertStableSymbol - :: CString -> CString -> Ptr a -> IO () -foreign import "lookupSymbol" unsafe c_lookupSymbol :: CString -> IO (Ptr a) -foreign import "loadObj" unsafe c_loadObj :: CString -> IO Int -foreign import "unloadObj" unsafe c_unloadObj :: CString -> IO Int -foreign import "resolveObjs" unsafe c_resolveObjs :: IO Int -#endif - \end{code}