ghc/compiler/ghci/Linker.lhs

   1 %
   2 % (c) The University of Glasgow, 2000
   3 %
   4 \section[Linker]{The In-Memory Object File Linker}
   5
   6 \begin{code}
   7 {-# OPTIONS -#include "Linker.h" #-}
   8 module Linker (
   9    loadObj,      -- :: String -> IO ()
  10    unloadObj,    -- :: String -> IO ()
  11    lookupSymbol, -- :: String -> IO (Maybe Addr)
  12    resolveObjs,  -- :: IO ()
  13    linkPrelude -- tmp
  14   )  where
  15
  16 import IO
  17 import Exception
  18 import Addr
  19 import PrelByteArr
  20 import PrelPack         (packString)
  21 import Panic            ( panic )
  22
  23 #if __GLASGOW_HASKELL__ <= 408
  24 loadObj      = bogus "loadObj"
  25 unloadObj    = bogus "unloadObj"
  26 lookupSymbol = bogus "lookupSymbol"
  27 resolveObjs  = bogus "resolveObjs"
  28 linkPrelude  = bogus "linkPrelude"
  29 bogus f = panic ("Linker." ++ f ++ ": this hsc was built without an interpreter.")
  30
  31 #else
  32
  33 linkPrelude = do
  34   hPutStr stderr "Loading HSstd_cbits.o..."
  35   loadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/cbits/HSstd_cbits.o"
  36   hPutStr stderr "done.\n"
  37   hPutStr stderr "Resolving..."
  38   resolveObjs
  39   hPutStr stderr "done.\n"
  40   hPutStr stderr "Loading HSstd.o..."
  41   loadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/HSstd.o"
  42   hPutStr stderr "done.\n"
  43   hPutStr stderr "Resolving..."
  44   resolveObjs
  45   hPutStr stderr "done.\n"
  46 {-
  47   hPutStr stderr "Unloading HSstd.o..."
  48   unloadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/HSstd.o"
  49   hPutStr stderr "done.\n"
  50   unloadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/cbits/HSstd_cbits.o"
  51   hPutStr stderr "done.\n"
  52 -}
  53
  54 -- ---------------------------------------------------------------------------
  55 -- RTS Linker Interface
  56 -- ---------------------------------------------------------------------------
  57
  58 lookupSymbol str = do
  59    addr <- c_lookupSymbol (packString str)
  60    if addr == nullAddr
  61         then return Nothing
  62         else return (Just addr)
  63
  64 loadObj str = do
  65    r <- c_loadObj (packString str)
  66    if (r == 0)
  67         then error "loadObj: failed"
  68         else return ()
  69
  70 unloadObj str = do
  71    r <- c_unloadObj (packString str)
  72    if (r == 0)
  73         then error "unloadObj: failed"
  74         else return ()
  75
  76 resolveObjs = do
  77    r <- c_resolveObjs
  78    if (r == 0)
  79         then error "resolveObjs: failed"
  80         else return ()
  81
  82
  83 type PackedString = ByteArray Int
  84
  85 foreign import "lookupSymbol" unsafe
  86    c_lookupSymbol :: PackedString -> IO Addr
  87
  88 foreign import "loadObj" unsafe
  89    c_loadObj :: PackedString -> IO Int
  90
  91 foreign import "unloadObj" unsafe
  92    c_unloadObj :: PackedString -> IO Int
  93
  94 foreign import "resolveObjs" unsafe
  95    c_resolveObjs :: IO Int
  96
  97 #endif /* __GLASGOW_HASKELL__ <= 408 */
  98 \end{code}