blob: d3862a56676f2dad6100fe5461222d20d8e11588 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
import Foreign.C.String
import Control.Monad
import System.Environment
import System.FilePath
import Foreign.Ptr
-- Type of paths is different on Windows
#if defined(mingw32_HOST_OS)
type PathString = CWString
withPathString = withCWString
#else
type PathString = CString
withPathString = withCString
#endif
mungeDLL :: FilePath -> FilePath
#if defined(mingw32_HOST_OS)
-- Strip extension because addDLL on Windows doesn't want it
mungeDLL f =
let (base, ext) = splitExtension f
in if ext == ".dll" then base else error ("unexpected DLL file name: " ++ f)
#else
mungeDLL = id
#endif
main = do
[ty, object] <- getArgs
initLinker
if ty == "dyn"
then do
r <- withPathString (mungeDLL object) $ \s -> addDLL s
when (r /= nullPtr) $ error =<< peekCString r
else do
r <- withPathString object $ \s -> loadObj s
when (r /= 1) $ error "loadObj failed"
r <- resolveObjs
when (r /= 1) $ error "resolveObj failed"
putStrLn "success"
{-
f <- withCString (mungeSymbol "do_checks") lookupSymbol
when (f == nullFunPtr) $ error "lookupSymbol failed"
mkIO f
foreign import ccall "lookupSymbol" lookupSymbol :: CString -> IO (FunPtr (IO ()))
foreign import ccall "dynamic" mkIO :: FunPtr (IO ()) -> IO ()
mungeSymbol :: String -> String
#if LEADING_UNDERSCORE
mungeSymbol s = "_" ++ s -- Mac OS X
#else
mungeSymbol = id
#endif
-}
foreign import ccall "initLinker" initLinker :: IO ()
foreign import ccall "addDLL" addDLL :: PathString -> IO CString
foreign import ccall "loadObj" loadObj :: PathString -> IO Int
foreign import ccall "resolveObjs" resolveObjs :: IO Int
|
