X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FLinker.lhs;h=5d1663327ac28c12c296158437bf7e0a28732b81;hb=916214e4f401d70462654013e83c4b8b08e85a18;hp=440ff11506d3ec69b8d1a8e98542e736dde2aba7;hpb=6ef5df4a1bc630798e0de5e676afe11086b68606;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs
index 440ff11..5d16633 100644
--- a/ghc/compiler/ghci/Linker.lhs
+++ b/ghc/compiler/ghci/Linker.lhs
@@ -5,85 +5,66 @@
 
 \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
@@ -94,5 +75,10 @@ foreign import "unloadObj" unsafe
 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}