X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FObjLink.lhs;h=1dbf0cfa731e018b8e6aa1010115b9d0530b9df7;hb=ee26207114635c480dbc7518c0510545a6f62611;hp=057938a45ef4069a1660c9fe4e6de514110012fa;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index 057938a..1dbf0cf 100644 --- a/compiler/ghci/ObjLink.lhs +++ b/compiler/ghci/ObjLink.lhs @@ -1,5 +1,5 @@ % -% (c) The University of Glasgow, 2000 +% (c) The University of Glasgow, 2000-2006 % -- --------------------------------------------------------------------------- @@ -16,23 +16,33 @@ module ObjLink ( loadDLL, -- :: String -> IO (Maybe String) loadObj, -- :: String -> IO () unloadObj, -- :: String -> IO () + insertSymbol, -- :: String -> String -> Ptr a -> IO () lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) resolveObjs -- :: IO SuccessFlag ) where -import Monad ( when ) - -import Foreign.C -import Foreign ( Ptr, nullPtr ) -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# ) + + -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- +insertSymbol :: String -> String -> Ptr a -> IO () +insertSymbol obj_name key symbol + = let str = prefixUnderscore key + in withCString obj_name $ \c_obj_name -> + withCString str $ \c_str -> + c_insertSymbol c_obj_name c_str symbol + lookupSymbol :: String -> IO (Maybe (Ptr a)) lookupSymbol str_in = do let str = prefixUnderscore str_in @@ -75,23 +85,14 @@ 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 "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) 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 "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}