.. and now, my real reason for posting the previous message 8)
Unfortunately, the big limitation of this is that we're going through the FFI to get things to work.
This kinda sucks because that means that the exported functions have to stick to exporting one of the prim_types (Int, Char, Float, Double, Ptr, StablePtr, and a few others).
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. The Right Thing To Do would be to do the communication with the RTS linker in terms of StablePtrs, but there's a performance overhead for doing that (perhaps not too bad, I haven't measured it). Cheers, Simon
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
It strikes me that you might want to play with or steal code from the Dynamic library if you're disabling/avoiding normal type-checking in this way. The Dynamic library is a bit limited in what types it can handle, is fairly high overhead if you are coercing a lot and won't catch problems where the typename stays the same but the type itself changes, but it'll also catch a lot of errors in a lot of code. -- Alastair Reid reid@cs.utah.edu http://www.cs.utah.edu/~reid/
participants (3)
-
Alastair Reid -
Andre Pang -
Simon Marlow