X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FObjLink.lhs;h=48deb46783a9c9d210455b83c0ac12e76ac0510b;hp=5988165886e3767690265feda9efab291c11fe8e;hb=6ef2fc2ebf11755a54386f8e317d83cb19913be1;hpb=53e5ed273237468ed64ee30caf7a82e2678c4669 diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index 5988165..48deb46 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 % -- --------------------------------------------------------------------------- @@ -17,20 +17,20 @@ module ObjLink ( loadObj, -- :: String -> IO () unloadObj, -- :: String -> IO () insertSymbol, -- :: String -> String -> Ptr a -> IO () - insertStableSymbol, -- :: String -> String -> a -> IO () +-- Suspicious; see defn +-- insertStableSymbol, -- :: String -> String -> a -> IO () lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) resolveObjs -- :: IO SuccessFlag ) where -import Monad ( when ) - -import Foreign.C -import Foreign ( nullPtr ) import Panic ( 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# ) -- --------------------------------------------------------------------------- @@ -44,12 +44,14 @@ 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 @@ -96,26 +98,15 @@ resolveObjs = do -- Foreign declaractions 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 () +-- 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 "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}