X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FObjLink.lhs;h=ec916164ce590f6dee07d8a228d7f803c931d077;hp=135afbb07dcadce0cc39d6fe3d2df47775a6a726;hb=295e7569c4793d210afbd05b42c81571b170baa9;hpb=ab5b8aa357c685a7c702262903bce04c66f79156 diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index 135afbb..ec91616 100644 --- a/compiler/ghci/ObjLink.lhs +++ b/compiler/ghci/ObjLink.lhs @@ -9,8 +9,6 @@ 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) @@ -18,23 +16,18 @@ module ObjLink ( unloadObj, -- :: String -> IO () insertSymbol, -- :: String -> String -> Ptr a -> IO () lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) - resolveObjs, -- :: IO SuccessFlag - lookupDataCon -- :: Ptr a -> IO (Maybe String) + resolveObjs -- :: IO SuccessFlag ) where -import ByteCodeItbls ( StgInfoTable ) -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(..) ) -import Constants ( wORD_SIZE ) -import Foreign ( plusPtr ) -- --------------------------------------------------------------------------- @@ -57,14 +50,6 @@ lookupSymbol str_in = do then return Nothing else return (Just addr) --- | Expects a Ptr to an info table, not to a closure -lookupDataCon :: Ptr StgInfoTable -> IO (Maybe String) -lookupDataCon ptr = do - name <- c_lookupDataCon (ptr `plusPtr` (wORD_SIZE*2)) - if name == nullPtr - then return Nothing - else peekCString name >>= return . Just - prefixUnderscore :: String -> String prefixUnderscore | cLeadingUnderscore == "YES" = ('_':) @@ -84,13 +69,13 @@ 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 @@ -98,7 +83,7 @@ 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 @@ -108,6 +93,4 @@ foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr 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 -foreign import ccall unsafe "lookupDataCon" c_lookupDataCon :: Ptr a -> IO CString - \end{code}