On Mon, May 27, 2002 at 10:57:18AM +0100, Simon Marlow wrote:
So, is there some wizardry out there which allows using the RTS Linker to load up .o modules which are not created with the FFI? I've been experimenting with it, and I just get segfaults if I try to load the adder_closure, adder_entry, adder_fast1 or adder_info symbols.
You *should* be able to just get the address of adder_closure and coerce it to the right type. The difficulty with this is that lookupSymbol returns a Ptr, which is an unboxed type, whereas the function type is a boxed type. Coercing unboxed types to boxed types is highly unsafe, because they have different representations on the stack.
However, GHCi does exactly this, and coerces from one to the other using addrToHValue# (see ByteCodeLink.lookupCE). It's dangerous, but we'd know pretty quickly if it didn't work.
Welp, after fumbling in the dark for about 30 minutes, I think it
works:
Adder2.hs:
module Adder2 where
adder :: Int -> Int
adder n = n + 3
Main.hs:
loadFunction :: String -> IO (Int -> Int)
loadFunction sym_to_find = do
m <- lookupSymbol sym_to_find
case m of
Just (Ptr addr) -> case addrToHValue# addr of
(# hval #) -> return hval
Nothing -> error ("Couldn't find symbol name " ++ sym_to_find ++ ", please try again later")
main = do
...
adderFunction <- loadFunction (moduleName ++ "_adder_closure")
let result = adderFunction 6
putStr (show result ++ "\n")
...
22:34(0) .../project/runtime_import-2% ./a.out Adder2
Loaded Adder2
Resolved Object Symbols: True
9
Yay!
Yay indeed :). Thanks so much for your help, Simon. Hopefully
it'll work with arbitrary data types next; that'll be my next
test.
(What's with all the Simons in the Haskell world, anyway? I bet
it's some evil Haskell conspiracy I don't know about.)
--
#ozone/algorithm