Reorganisation of the source tree
[ghc-hetmet.git] / ghc / compiler / ghci / ObjLink.lhs
diff --git a/ghc/compiler/ghci/ObjLink.lhs b/ghc/compiler/ghci/ObjLink.lhs
deleted file mode 100644 (file)
index 057938a..0000000
+++ /dev/null
@@ -1,97 +0,0 @@
-%
-% (c) The University of Glasgow, 2000
-%
-
--- ---------------------------------------------------------------------------
---     The dynamic linker for object code (.o .so .dll files)
--- ---------------------------------------------------------------------------
-
-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)
-   loadObj,             -- :: String -> IO ()
-   unloadObj,           -- :: String -> 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 BasicTypes      ( SuccessFlag, successIf )
-import Config          ( cLeadingUnderscore )
-import Outputable
-
--- ---------------------------------------------------------------------------
--- RTS Linker Interface
--- ---------------------------------------------------------------------------
-
-lookupSymbol :: String -> IO (Maybe (Ptr a))
-lookupSymbol str_in = do
-   let str = prefixUnderscore str_in
-   withCString str $ \c_str -> do
-     addr <- c_lookupSymbol c_str
-     if addr == nullPtr
-       then return Nothing
-       else return (Just addr)
-
-prefixUnderscore :: String -> String
-prefixUnderscore
- | cLeadingUnderscore == "YES" = ('_':)
- | otherwise                   = id
-
-loadDLL :: String -> IO (Maybe String)
--- Nothing      => success
--- Just err_msg => failure
-loadDLL str = do
-  maybe_errmsg <- withCString str $ \dll -> c_addDLL dll
-  if maybe_errmsg == nullPtr
-       then return Nothing
-       else do str <- peekCString maybe_errmsg
-               return (Just str)
-
-loadObj :: String -> IO ()
-loadObj str = do
-   withCString str $ \c_str -> do
-     r <- c_loadObj c_str
-     when (r == 0) (panic "loadObj: failed")
-
-unloadObj :: String -> IO ()
-unloadObj str =
-   withCString str $ \c_str -> do
-     r <- c_unloadObj c_str
-     when (r == 0) (panic "unloadObj: failed")
-
-resolveObjs :: IO SuccessFlag
-resolveObjs = do
-   r <- c_resolveObjs
-   return (successIf (r /= 0))
-
--- ---------------------------------------------------------------------------
--- 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 "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}