diff --git a/llvm-general.cabal b/llvm-general.cabal --- a/llvm-general.cabal +++ b/llvm-general.cabal @@ -1,5 +1,5 @@ name: llvm-general -version: 3.3.0.7 +version: 3.3.1.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet @@ -34,7 +34,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.3 - tag: v3.3.0.7 + tag: v3.3.1.0 flag shared-llvm description: link against llvm shared rather than static library @@ -161,6 +161,7 @@ src/LLVM/General/Internal/FFI/BuilderC.cpp src/LLVM/General/Internal/FFI/ConstantC.cpp src/LLVM/General/Internal/FFI/CommandLineC.cpp + src/LLVM/General/Internal/FFI/ExecutionEngineC.cpp src/LLVM/General/Internal/FFI/FunctionC.cpp src/LLVM/General/Internal/FFI/GlobalAliasC.cpp src/LLVM/General/Internal/FFI/GlobalValueC.cpp diff --git a/src/LLVM/General/AST/DataLayout.hs b/src/LLVM/General/AST/DataLayout.hs --- a/src/LLVM/General/AST/DataLayout.hs +++ b/src/LLVM/General/AST/DataLayout.hs @@ -16,7 +16,7 @@ -- | An AlignmentInfo describes how a given type must and would best be aligned data AlignmentInfo = AlignmentInfo { abiAlignment :: Word32, - preferredAlignment :: Word32 + preferredAlignment :: Maybe Word32 } deriving (Eq, Ord, Read, Show) diff --git a/src/LLVM/General/ExecutionEngine.hs b/src/LLVM/General/ExecutionEngine.hs --- a/src/LLVM/General/ExecutionEngine.hs +++ b/src/LLVM/General/ExecutionEngine.hs @@ -1,9 +1,9 @@ -- | Tools for JIT execution module LLVM.General.ExecutionEngine ( - ExecutionEngine, - withExecutionEngine, - withModuleInEngine, - findFunction + ExecutionEngine(..), + ExecutableModule, + JIT, withJIT, + MCJIT, withMCJIT ) where import LLVM.General.Internal.ExecutionEngine diff --git a/src/LLVM/General/Internal/Coding.hs b/src/LLVM/General/Internal/Coding.hs --- a/src/LLVM/General/Internal/Coding.hs +++ b/src/LLVM/General/Internal/Coding.hs @@ -15,7 +15,7 @@ import Control.Monad.IO.Class import Data.Data (Data) -import Data.Word (Word32, Word64) +import Data.Word (Word, Word32, Word64) import Data.Int (Int32) import Foreign.C @@ -101,6 +101,9 @@ instance Monad m => DecodeM m Bool FFI.LLVMBool where decodeM (FFI.LLVMBool 0) = return $ False decodeM (FFI.LLVMBool 1) = return $ True + +instance Monad m => EncodeM m Word CUInt where + encodeM = return . fromIntegral instance Monad m => EncodeM m Word32 CUInt where encodeM = return . fromIntegral diff --git a/src/LLVM/General/Internal/Constant.hs b/src/LLVM/General/Internal/Constant.hs --- a/src/LLVM/General/Internal/Constant.hs +++ b/src/LLVM/General/Internal/Constant.hs @@ -114,7 +114,7 @@ ID.Binary -> return [| $(coreCall "BinaryOperator") $(opcode) |] ID.Cast -> return [| $(coreCall "Cast") $(opcode) |] _ -> return $ coreCall name - Nothing -> if (name `elem` ["Vector", "Null", "Array"]) + Nothing -> if (name `elem` ["Vector", "Null", "Array", "Undef"]) then return $ coreCall name else [] return $ TH.match diff --git a/src/LLVM/General/Internal/DataLayout.hs b/src/LLVM/General/Internal/DataLayout.hs --- a/src/LLVM/General/Internal/DataLayout.hs +++ b/src/LLVM/General/Internal/DataLayout.hs @@ -15,7 +15,7 @@ dataLayoutToString :: DataLayout -> String dataLayoutToString dl = let sTriple :: (Word32, AlignmentInfo) -> String - sTriple (s, ai) = show s ++ ":" ++ show (abiAlignment ai) ++ ":" ++ show (preferredAlignment ai) + sTriple (s, ai) = show s ++ ":" ++ show (abiAlignment ai) ++ (maybe "" (\p -> ":" ++ show p) (preferredAlignment ai)) atChar at = case at of IntegerAlign -> "i" VectorAlign -> "v" @@ -28,7 +28,7 @@ ++ (maybe [] (\s -> ["S" ++ show s]) (stackAlignment dl)) ++ - [ "p" ++ show a ++ ":" ++ sTriple t | (AddrSpace a, t) <- Map.toList . pointerLayouts $ dl] + [ "p" ++ (if a == 0 then "" else show a) ++ ":" ++ sTriple t | (AddrSpace a, t) <- Map.toList . pointerLayouts $ dl] ++ [ atChar at ++ sTriple (s, ai) | ((at, s), ai) <- Map.toList . typeLayouts $ dl ] ++ @@ -46,8 +46,9 @@ s <- num char ':' abi <- num - char ':' - pref <- num + pref <- optionMaybe $ do + char ':' + num return (s, (AlignmentInfo abi pref)) parseSpec :: Parser (DataLayout -> DataLayout) parseSpec = choice [ @@ -63,7 +64,7 @@ return $ \dl -> dl { stackAlignment = Just n }, do char 'p' - a <- AddrSpace . read <$> many digit + a <- AddrSpace <$> option 0 (read <$> many1 digit) char ':' t <- triple return $ \dl -> dl { pointerLayouts = Map.insert a t (pointerLayouts dl) }, diff --git a/src/LLVM/General/Internal/ExecutionEngine.hs b/src/LLVM/General/Internal/ExecutionEngine.hs --- a/src/LLVM/General/Internal/ExecutionEngine.hs +++ b/src/LLVM/General/Internal/ExecutionEngine.hs @@ -1,28 +1,34 @@ +{-# LANGUAGE + MultiParamTypeClasses, + FunctionalDependencies, + FlexibleInstances, + RankNTypes + #-} module LLVM.General.Internal.ExecutionEngine where import Control.Exception import Control.Monad import Control.Monad.IO.Class import Control.Monad.AnyCont -import Data.Functor +import Data.Word +import Data.IORef import Foreign.Ptr -import Foreign.Marshal.Alloc (free) +import Foreign.C.String (CString) +import Foreign.C.Types (CUInt) +import Foreign.Marshal.Alloc (free, allocaBytes) import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.ExecutionEngine as FFI -import qualified LLVM.General.Internal.FFI.Target as FFI import qualified LLVM.General.Internal.FFI.Module as FFI import LLVM.General.Internal.Module import LLVM.General.Internal.Context import LLVM.General.Internal.Coding - +import qualified LLVM.General.CodeModel as CodeModel +import LLVM.General.Internal.Target import qualified LLVM.General.AST as A --- | -newtype ExecutionEngine = ExecutionEngine (Ptr FFI.ExecutionEngine) - removeModule :: Ptr FFI.ExecutionEngine -> Ptr FFI.Module -> IO () removeModule e m = flip runAnyContT return $ do d0 <- alloca @@ -30,37 +36,114 @@ r <- liftIO $ FFI.removeModule e m d0 d1 when (r /= 0) $ fail "FFI.removeModule failure" +-- | a 'ExecutableModule' e represents a 'Module' which is currently "in" an +-- 'ExecutionEngine', and so the functions of which may be executed. +data ExecutableModule e = ExecutableModule e (Ptr FFI.Module) --- | bracket the creation and destruction of an 'ExecutionEngine' -withExecutionEngine :: Context -> (ExecutionEngine -> IO a) -> IO a -withExecutionEngine c f = flip runAnyContT return $ do - liftIO $ FFI.initializeNativeTarget +-- | +class ExecutionEngine e f | e -> f where + withModuleInEngine :: e -> Module -> (ExecutableModule e -> IO a) -> IO a + getFunction :: ExecutableModule e -> A.Name -> IO (Maybe f) + +instance ExecutionEngine (Ptr FFI.ExecutionEngine) (FunPtr ()) where + withModuleInEngine e (Module m) = bracket_ (FFI.addModule e m) (removeModule e m) . ($ (ExecutableModule e m)) + getFunction (ExecutableModule e m) (A.Name name) = flip runAnyContT return $ do + name <- encodeM name + f <- liftIO $ FFI.getNamedFunction m name + if f == nullPtr + then + return Nothing + else + do + p <- liftIO $ FFI.getPointerToGlobal e (FFI.upCast f) + return $ if p == nullPtr then Nothing else Just (castPtrToFunPtr p) + +withExecutionEngine :: + Context -> + Maybe (Ptr FFI.Module) -> + (Ptr (Ptr FFI.ExecutionEngine) -> Ptr FFI.Module -> Ptr CString -> IO CUInt) -> + (Ptr FFI.ExecutionEngine -> IO a) -> + IO a +withExecutionEngine c m createEngine f = flip runAnyContT return $ do + liftIO initializeNativeTarget outExecutionEngine <- alloca outErrorCStringPtr <- alloca - Module dummyModule <- anyContT $ liftM (either undefined id) . withModuleFromAST c (A.Module "" Nothing Nothing []) - r <- liftIO $ FFI.createExecutionEngineForModule outExecutionEngine dummyModule outErrorCStringPtr + Module dummyModule <- maybe (anyContT $ liftM (either undefined id) + . withModuleFromAST c (A.Module "" Nothing Nothing [])) + (return . Module) m + r <- liftIO $ createEngine outExecutionEngine dummyModule outErrorCStringPtr when (r /= 0) $ do s <- anyContT $ bracket (peek outErrorCStringPtr) free fail =<< decodeM s executionEngine <- anyContT $ bracket (peek outExecutionEngine) FFI.disposeExecutionEngine liftIO $ removeModule executionEngine dummyModule - liftIO $ f (ExecutionEngine executionEngine) + liftIO $ f executionEngine +-- | +newtype JIT = JIT (Ptr FFI.ExecutionEngine) + +-- | bracket the creation and destruction of a 'JIT' +withJIT :: + Context + -> Word -- ^ optimization level + -> (JIT -> IO a) + -> IO a +withJIT c opt = + withExecutionEngine c Nothing (\e m -> FFI.createJITCompilerForModule e m (fromIntegral opt)) + . (. JIT) + +instance ExecutionEngine JIT (FunPtr ()) where + withModuleInEngine (JIT e) m f = withModuleInEngine e m (\(ExecutableModule e m) -> f (ExecutableModule (JIT e) m)) + getFunction (ExecutableModule (JIT e) m) = getFunction (ExecutableModule e m) --- | bracket the availability of machine code for a given 'Module' in an 'ExecutionEngine'. --- See 'findFunction'. -withModuleInEngine :: ExecutionEngine -> Module -> IO a -> IO a -withModuleInEngine (ExecutionEngine e) (Module m) = bracket_ (FFI.addModule e m) (removeModule e m) --- | While a 'Module' is in an 'ExecutionEngine', use 'findFunction' to lookup functions in the module. --- To run them from Haskell, treat them as any other function pointer: cast them to an appropriate and --- foreign type, then wrap them with a dynamic FFI stub. -findFunction :: ExecutionEngine -> A.Name -> IO (Maybe (Ptr ())) -findFunction (ExecutionEngine e) (A.Name fName) = flip runAnyContT return $ do - out <- alloca - fName <- encodeM fName - r <- liftIO $ FFI.findFunction e fName out - if (r /= 0) then - return Nothing - else - Just <$> (liftIO $ FFI.getPointerToGlobal e . FFI.upCast =<< peek out) +data MCJITState + = Deferred (forall a . Module -> (Ptr FFI.ExecutionEngine -> IO a) -> IO a) + | Constructed (Ptr FFI.ExecutionEngine) + +-- | +-- +-- N.B. - the LLVM MCJIT does not current support adding multiple +-- modules to any one instance of the MCJIT. +newtype MCJIT = MCJIT (IORef MCJITState) + +-- | bracket the creation and destruction of an 'MCJIT' +withMCJIT :: + Context + -> Maybe Word -- ^ optimization level + -> Maybe CodeModel.Model + -> Maybe Bool -- ^ True to disable frame pointer elimination + -> Maybe Bool -- ^ True to enable fast instruction selection +-- -> Maybe MemoryManager -- llvm-general doesn't support this yet + -> (MCJIT -> IO a) + -> IO a +withMCJIT c opt cm fpe fisel f = do + let createMCJITCompilerForModule e m s = do + size <- FFI.getMCJITCompilerOptionsSize + allocaBytes (fromIntegral size) $ \p -> do + FFI.initializeMCJITCompilerOptions p size + maybe (return ()) (FFI.setMCJITCompilerOptionsOptLevel p <=< encodeM) opt + maybe (return ()) (FFI.setMCJITCompilerOptionsCodeModel p <=< encodeM) cm + maybe (return ()) (FFI.setMCJITCompilerOptionsNoFramePointerElim p <=< encodeM) fpe + maybe (return ()) (FFI.setMCJITCompilerOptionsEnableFastISel p <=< encodeM) fisel + FFI.createMCJITCompilerForModule e m p size s + t <- newIORef (Deferred $ \(Module m) -> withExecutionEngine c (Just m) createMCJITCompilerForModule) + f (MCJIT t) + +instance ExecutionEngine MCJIT (FunPtr ()) where + withModuleInEngine (MCJIT s) m f = do + jitState <- readIORef s + let f' (ExecutableModule _ m) = f (ExecutableModule (MCJIT s) m) + case jitState of + Deferred c -> c m $ \e -> + bracket_ + (writeIORef s (Constructed e)) + (writeIORef s jitState) + (withModuleInEngine e m f') + Constructed e -> withModuleInEngine e m f' + + getFunction (ExecutableModule (MCJIT r) m) n = do + s <- liftIO $ readIORef r + case s of + Deferred _ -> return Nothing + Constructed e -> getFunction (ExecutableModule e m) n diff --git a/src/LLVM/General/Internal/FFI/Constant.hs b/src/LLVM/General/Internal/FFI/Constant.hs --- a/src/LLVM/General/Internal/FFI/Constant.hs +++ b/src/LLVM/General/Internal/FFI/Constant.hs @@ -123,7 +123,7 @@ foreign import ccall unsafe "LLVM_General_GetConstIndices" getConstantIndices :: Ptr Constant -> Ptr CUInt -> IO (Ptr CUInt) -foreign import ccall unsafe "LLVMGetUndef" getUndef :: +foreign import ccall unsafe "LLVMGetUndef" constantUndef :: Ptr Type -> IO (Ptr Constant) foreign import ccall unsafe "LLVMBlockAddress" blockAddress :: diff --git a/src/LLVM/General/Internal/FFI/ExecutionEngine.hs b/src/LLVM/General/Internal/FFI/ExecutionEngine.hs --- a/src/LLVM/General/Internal/FFI/ExecutionEngine.hs +++ b/src/LLVM/General/Internal/FFI/ExecutionEngine.hs @@ -10,6 +10,7 @@ import LLVM.General.Internal.FFI.PtrHierarchy import LLVM.General.Internal.FFI.Module +import LLVM.General.Internal.FFI.LLVMCTypes data ExecutionEngine @@ -22,6 +23,9 @@ foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule :: Ptr (Ptr ExecutionEngine) -> Ptr Module -> CUInt -> Ptr CString -> IO CUInt +foreign import ccall unsafe "LLVMCreateMCJITCompilerForModule" createMCJITCompilerForModule :: + Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr MCJITCompilerOptions -> CSize -> Ptr CString -> IO CUInt + foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine :: Ptr ExecutionEngine -> IO () @@ -45,3 +49,25 @@ foreign import ccall unsafe "LLVMLinkInMCJIT" linkInMCJIT :: IO () + +data MCJITCompilerOptions + +foreign import ccall unsafe "LLVM_General_GetMCJITCompilerOptionsSize" getMCJITCompilerOptionsSize :: + IO CSize + +foreign import ccall unsafe "LLVMInitializeMCJITCompilerOptions" initializeMCJITCompilerOptions :: + Ptr MCJITCompilerOptions -> CSize -> IO () + +foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsOptLevel" setMCJITCompilerOptionsOptLevel :: + Ptr MCJITCompilerOptions -> CUInt -> IO () + +foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsCodeModel" setMCJITCompilerOptionsCodeModel :: + Ptr MCJITCompilerOptions -> CodeModel -> IO () + +foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsNoFramePointerElim" setMCJITCompilerOptionsNoFramePointerElim :: + Ptr MCJITCompilerOptions -> LLVMBool -> IO () + +foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsEnableFastISel" setMCJITCompilerOptionsEnableFastISel :: + Ptr MCJITCompilerOptions -> LLVMBool -> IO () + + diff --git a/src/LLVM/General/Internal/FFI/ExecutionEngineC.cpp b/src/LLVM/General/Internal/FFI/ExecutionEngineC.cpp new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Internal/FFI/ExecutionEngineC.cpp @@ -0,0 +1,30 @@ +#define __STDC_LIMIT_MACROS +#include "llvm/IR/LLVMContext.h" +#include "llvm-c/ExecutionEngine.h" + +using namespace llvm; + +extern "C" { + +size_t LLVM_General_GetMCJITCompilerOptionsSize() { + return sizeof(struct LLVMMCJITCompilerOptions); +} + +void LLVM_General_SetMCJITCompilerOptionsOptLevel(struct LLVMMCJITCompilerOptions *o, unsigned x) { + o->OptLevel = x; +} + +void LLVM_General_SetMCJITCompilerOptionsCodeModel(struct LLVMMCJITCompilerOptions *o, LLVMCodeModel x) { + o->CodeModel = x; +} + +void LLVM_General_SetMCJITCompilerOptionsNoFramePointerElim(struct LLVMMCJITCompilerOptions *o, LLVMBool x) { + o->NoFramePointerElim = x; +} + +void LLVM_General_SetMCJITCompilerOptionsEnableFastISel(struct LLVMMCJITCompilerOptions *o, LLVMBool x) { + o->EnableFastISel = x; +} + +} + diff --git a/src/LLVM/General/Internal/FFI/Module.hs b/src/LLVM/General/Internal/FFI/Module.hs --- a/src/LLVM/General/Internal/FFI/Module.hs +++ b/src/LLVM/General/Internal/FFI/Module.hs @@ -72,6 +72,9 @@ foreign import ccall unsafe "LLVMAddFunction" addFunction :: Ptr Module -> CString -> Ptr Type -> IO (Ptr Function) +foreign import ccall unsafe "LLVMGetNamedFunction" getNamedFunction :: + Ptr Module -> CString -> IO (Ptr Function) + foreign import ccall unsafe "LLVM_General_GetOrAddNamedMetadata" getOrAddNamedMetadata :: Ptr Module -> CString -> IO (Ptr NamedMetadata) diff --git a/src/LLVM/General/Internal/FFI/TargetC.cpp b/src/LLVM/General/Internal/FFI/TargetC.cpp --- a/src/LLVM/General/Internal/FFI/TargetC.cpp +++ b/src/LLVM/General/Internal/FFI/TargetC.cpp @@ -1,5 +1,6 @@ #define __STDC_LIMIT_MACROS #include "llvm/Support/TargetRegistry.h" +#include "llvm/Support/TargetSelect.h" #include "llvm/Target/TargetMachine.h" #include "llvm/ADT/Triple.h" #include "llvm/ExecutionEngine/Interpreter.h" @@ -87,7 +88,9 @@ extern "C" { LLVMBool LLVM_General_InitializeNativeTarget() { - return LLVMInitializeNativeTarget(); + return LLVMInitializeNativeTarget() + || InitializeNativeTargetAsmPrinter() + || InitializeNativeTargetAsmParser(); } LLVMTargetRef LLVM_General_LookupTarget( diff --git a/src/LLVM/General/Internal/Target.hs b/src/LLVM/General/Internal/Target.hs --- a/src/LLVM/General/Internal/Target.hs +++ b/src/LLVM/General/Internal/Target.hs @@ -227,3 +227,8 @@ -- | get the 'TargetLowering' of a 'TargetMachine' getTargetLowering :: TargetMachine -> IO TargetLowering getTargetLowering (TargetMachine tm) = TargetLowering <$> FFI.getTargetLowering tm + +initializeNativeTarget :: IO () +initializeNativeTarget = do + failure <- decodeM =<< liftIO FFI.initializeNativeTarget + when failure $ fail "native target initialization failed" diff --git a/test/LLVM/General/Test/Constants.hs b/test/LLVM/General/Test/Constants.hs --- a/test/LLVM/General/Test/Constants.hs +++ b/test/LLVM/General/Test/Constants.hs @@ -109,6 +109,11 @@ C.Vector [C.Int 32 i | i <- [1,2,1]], "global <3 x i32> " ), ( + "undef", + IntegerType 32, + C.Undef (IntegerType 32), + "global i32 undef" + ), ( "binop/cast", IntegerType 64, C.Add (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64)) (C.Int 64 2), diff --git a/test/LLVM/General/Test/DataLayout.hs b/test/LLVM/General/Test/DataLayout.hs --- a/test/LLVM/General/Test/DataLayout.hs +++ b/test/LLVM/General/Test/DataLayout.hs @@ -7,11 +7,13 @@ import LLVM.General.Test.Support import qualified Data.Set as Set +import qualified Data.Map as Map import LLVM.General.Context import LLVM.General.Module import LLVM.General.AST import LLVM.General.AST.DataLayout +import LLVM.General.AST.AddrSpace import qualified LLVM.General.AST.Global as G tests = testGroup "DataLayout" [ @@ -23,7 +25,38 @@ | (name, mdl, sdl) <- [ ("little-endian", defaultDataLayout { endianness = Just LittleEndian }, "e"), ("big-endian", defaultDataLayout { endianness = Just BigEndian }, "E"), - ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32") + ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32"), + ( + "no pref", + defaultDataLayout { + pointerLayouts = + Map.singleton + (AddrSpace 0) + ( + 8, + AlignmentInfo { + abiAlignment = 64, + preferredAlignment = Nothing + } + ) + }, + "p:8:64" + ), ( + "no pref", + defaultDataLayout { + pointerLayouts = + Map.singleton + (AddrSpace 1) + ( + 8, + AlignmentInfo { + abiAlignment = 32, + preferredAlignment = Just 64 + } + ) + }, + "p1:8:32:64" + ) ] ] ] diff --git a/test/LLVM/General/Test/ExecutionEngine.hs b/test/LLVM/General/Test/ExecutionEngine.hs --- a/test/LLVM/General/Test/ExecutionEngine.hs +++ b/test/LLVM/General/Test/ExecutionEngine.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE + ForeignFunctionInterface, + FlexibleContexts + #-} module LLVM.General.Test.ExecutionEngine where import Test.Framework @@ -30,24 +33,27 @@ foreign import ccall "dynamic" mkIO32Stub :: FunPtr (Word32 -> IO Word32) -> (Word32 -> IO Word32) -tests = testGroup "ExecutionEngine" [ +testJIT :: ExecutionEngine e (FunPtr ()) => (Context -> (e -> IO ()) -> IO ()) -> Assertion +testJIT withEE = withContext $ \context -> withEE context $ \executionEngine -> do + let mAST = Module "runSomethingModule" Nothing Nothing [ + GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "_foo") ([ + Parameter (IntegerType 32) (Name "bar") [] + ],False) [] + Nothing 0 + [ + BasicBlock (UnName 0) [] ( + Do $ Ret (Just (ConstantOperand (C.Int 32 42))) [] + ) + ] + ] - testCase "runSomething" $ withContext $ \context -> withExecutionEngine context $ \executionEngine -> do - let mAST = Module "runSomethingModule" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "foo") [] - ],False) [] - Nothing 0 - [ - BasicBlock (UnName 0) [] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 42))) [] - ) - ] - ] - - s <- withModuleFromAST context mAST $ \m -> do - withModuleInEngine executionEngine m $ do - Just p <- findFunction executionEngine (Name "foo") - (mkIO32Stub ((castPtrToFunPtr p) :: FunPtr (Word32 -> IO Word32))) 7 - s @?= Right 42 + s <- withModuleFromAST context mAST $ \m -> do + withModuleInEngine executionEngine m $ \em -> do + Just p <- getFunction em (Name "_foo") + (mkIO32Stub ((castFunPtr p) :: FunPtr (Word32 -> IO Word32))) 7 + s @?= Right 42 + +tests = testGroup "ExecutionEngine" [ + testCase "run something with JIT" $ testJIT (\c -> withJIT c 2), + testCase "run something with MCJIT" $ testJIT (\c -> withMCJIT c Nothing Nothing Nothing Nothing) ] diff --git a/test/LLVM/General/Test/Optimization.hs b/test/LLVM/General/Test/Optimization.hs --- a/test/LLVM/General/Test/Optimization.hs +++ b/test/LLVM/General/Test/Optimization.hs @@ -8,7 +8,6 @@ import qualified Data.Map as Map import LLVM.General.Module -import LLVM.General.CommandLine import LLVM.General.Context import LLVM.General.PassManager import LLVM.General.Transforms @@ -156,7 +155,6 @@ ], testCase "BasicBlockVectorization" $ do - parseCommandLineOptions ["test", "-bb-vectorize-ignore-target-info"] Nothing let mIn = Module "" Nothing Nothing [ GlobalDefinition $ Function L.External V.Default CC.C [] (FloatingPointType 64 IEEE) (Name "foo") ([ diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,6 +1,12 @@ import Test.Framework import qualified LLVM.General.Test.Tests as LLVM.General +import LLVM.General.CommandLine -main = defaultMain [ +main = do + parseCommandLineOptions [ + "test", + "-bb-vectorize-ignore-target-info" + ] Nothing + defaultMain [ LLVM.General.tests - ] + ]