\begin{code}
{-# OPTIONS -#include "Linker.h" #-}
+
+-- so that we can see defn of LEADING_UNDERSCORE
+#include "../includes/config.h"
+
module Linker (
+ initLinker, -- :: IO ()
loadObj, -- :: String -> IO ()
unloadObj, -- :: String -> IO ()
- lookupSymbol, -- :: String -> IO (Maybe Addr)
+ lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs, -- :: IO ()
- linkPrelude -- tmp
+ addDLL -- :: String -> IO (Ptr CChar)
) where
-import IO
-import Exception
-import Addr
+import CTypes ( CChar )
+import Foreign ( Ptr, nullPtr )
import PrelByteArr
import PrelPack (packString)
import Panic ( panic )
-#if __GLASGOW_HASKELL__ <= 408
-loadObj = bogus "loadObj"
-unloadObj = bogus "unloadObj"
-lookupSymbol = bogus "lookupSymbol"
-resolveObjs = bogus "resolveObjs"
-linkPrelude = bogus "linkPrelude"
-bogus f = panic ("Linker." ++ f ++ ": this hsc was built without an interpreter.")
-
-#else
-
-linkPrelude = do
- hPutStr stderr "Loading HSstd_cbits.o..."
- loadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/cbits/HSstd_cbits.o"
- hPutStr stderr "done.\n"
- hPutStr stderr "Resolving..."
- resolveObjs
- hPutStr stderr "done.\n"
- hPutStr stderr "Loading HSstd.o..."
- loadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/HSstd.o"
- hPutStr stderr "done.\n"
- hPutStr stderr "Resolving..."
- resolveObjs
- hPutStr stderr "done.\n"
-{-
- hPutStr stderr "Unloading HSstd.o..."
- unloadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/HSstd.o"
- hPutStr stderr "done.\n"
- unloadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/cbits/HSstd_cbits.o"
- hPutStr stderr "done.\n"
--}
-
-- ---------------------------------------------------------------------------
-- RTS Linker Interface
-- ---------------------------------------------------------------------------
-lookupSymbol str = do
+lookupSymbol str_in = do
+# ifdef LEADING_UNDERSCORE
+ let str = '_':str_in
+# else
+ let str = str_in
+# endif
addr <- c_lookupSymbol (packString str)
- if addr == nullAddr
+ if addr == nullPtr
then return Nothing
else return (Just addr)
loadObj str = do
r <- c_loadObj (packString str)
if (r == 0)
- then error "loadObj: failed"
+ then panic "loadObj: failed"
else return ()
unloadObj str = do
r <- c_unloadObj (packString str)
if (r == 0)
- then error "unloadObj: failed"
+ then panic "unloadObj: failed"
else return ()
resolveObjs = do
r <- c_resolveObjs
if (r == 0)
- then error "resolveObjs: failed"
+ then panic "resolveObjs: failed"
else return ()
+addDLL path lib = do
+ maybe_errmsg <- c_addDLL (packString path) (packString lib)
+ return maybe_errmsg
type PackedString = ByteArray Int
foreign import "lookupSymbol" unsafe
- c_lookupSymbol :: PackedString -> IO Addr
+ c_lookupSymbol :: PackedString -> IO (Ptr a)
foreign import "loadObj" unsafe
c_loadObj :: PackedString -> IO Int
foreign import "resolveObjs" unsafe
c_resolveObjs :: IO Int
-#endif /* __GLASGOW_HASKELL__ <= 408 */
+foreign import "initLinker" unsafe
+ initLinker :: IO ()
+
+foreign import "addDLL" unsafe
+ c_addDLL :: PackedString -> PackedString -> IO (Ptr CChar)
+
\end{code}