X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FObjLink.lhs;h=4047301e02328de2ad4be7b8130cbabc12960ac3;hb=6aaa17c7d5417bbe20aa56c1f7160930223d4ed8;hp=d5e0f7bd926bbe97722cfc62e90531e2b9ed2ac1;hpb=2011e9b1cbe775094dc2fd7968a8175068dc0ee8;p=ghc-hetmet.git diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index d5e0f7b..4047301 100644 --- a/compiler/ghci/ObjLink.lhs +++ b/compiler/ghci/ObjLink.lhs @@ -11,13 +11,19 @@ Primarily, this module consists of an interface to the C-land dynamic linker. \begin{code} {-# OPTIONS -#include "Linker.h" #-} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module ObjLink ( initObjLinker, -- :: IO () loadDLL, -- :: String -> IO (Maybe String) 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 @@ -32,6 +38,8 @@ import Foreign.C import Foreign ( nullPtr ) import GHC.Exts ( Ptr(..), unsafeCoerce# ) + + -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- @@ -43,13 +51,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 @@ -92,17 +93,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; -- --------------------------------------------------------------------------- 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 "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}