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
   9 module Linker (
  10    initLinker,   -- :: IO ()
  11    loadObj,      -- :: String -> IO ()
  12    unloadObj,    -- :: String -> IO ()
  13    lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
  14    resolveObjs,  -- :: IO Bool
  15    addDLL        -- :: String -> IO (Ptr CChar)
  16   )  where
  17
  18 import PrelByteArr
  19 import PrelPack         ( packString )
  20
  21 import Monad            ( when )
  22
  23 import CTypes           ( CChar )
  24 import Foreign          ( Ptr, nullPtr )
  25 import Panic            ( panic )
  26 import DriverUtil       ( prefixUnderscore )
  27
  28 -- ---------------------------------------------------------------------------
  29 -- RTS Linker Interface
  30 -- ---------------------------------------------------------------------------
  31
  32 lookupSymbol :: String -> IO (Maybe (Ptr a))
  33 lookupSymbol str_in = do
  34    let str = prefixUnderscore str_in
  35    addr <- c_lookupSymbol (packString str)
  36    if addr == nullPtr
  37         then return Nothing
  38         else return (Just addr)
  39
  40 loadObj :: String -> IO ()
  41 loadObj str = do
  42    r <- c_loadObj (packString str)
  43    when (r == 0) (panic "loadObj: failed")
  44
  45 unloadObj :: String -> IO ()
  46 unloadObj str = do
  47    r <- c_unloadObj (packString str)
  48    when (r == 0) (panic "unloadObj: failed")
  49
  50 resolveObjs :: IO Bool
  51 resolveObjs = do
  52    r <- c_resolveObjs
  53    return (r /= 0)  -- returns True <=> success
  54
  55 addDLL :: String -> String -> IO (Ptr CChar)
  56 addDLL path lib = do
  57    maybe_errmsg <- c_addDLL (packString path) (packString lib)
  58    return maybe_errmsg
  59
  60
  61 foreign import "initLinker" unsafe
  62    initLinker :: IO ()
  63
  64 -- ---------------------------------------------------------------------------
  65 -- Foreign declaractions to RTS entry points which does the real work;
  66 -- ---------------------------------------------------------------------------
  67
  68 type PackedString = ByteArray Int
  69
  70 foreign import "lookupSymbol" unsafe
  71    c_lookupSymbol :: PackedString -> IO (Ptr a)
  72
  73 foreign import "loadObj" unsafe
  74    c_loadObj :: PackedString -> IO Int
  75
  76 foreign import "unloadObj" unsafe
  77    c_unloadObj :: PackedString -> IO Int
  78
  79 foreign import "resolveObjs" unsafe
  80    c_resolveObjs :: IO Int
  81
  82 foreign import "addDLL" unsafe
  83    c_addDLL :: PackedString -> PackedString -> IO (Ptr CChar)
  84 \end{code}