llvm-tf 3.0.3.1.7 → 3.0.3.1.8
raw patch · 3 files changed
+13/−67 lines, 3 files
Files
- llvm-tf.cabal +2/−2
- src/LLVM/ExecutionEngine.hs +1/−6
- src/LLVM/ExecutionEngine/Engine.hs +10/−59
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name: llvm-tf-Version: 3.0.3.1.7+Version: 3.0.3.1.8 License: BSD3 License-File: LICENSE Synopsis: Bindings to the LLVM compiler toolkit using type families.@@ -37,7 +37,7 @@ Location: http://code.haskell.org/~thielema/llvm-tf/ Source-Repository this- Tag: 3.0.3.1.7+ Tag: 3.0.3.1.8 Type: darcs Location: http://code.haskell.org/~thielema/llvm-tf/
src/LLVM/ExecutionEngine.hs view
@@ -6,10 +6,6 @@ runEngineAccess, addModuleProvider, addModule,-{-- runStaticConstructors,- runStaticDestructors,--} getPointerToFunction, addFunctionValue, addGlobalMappings,@@ -81,9 +77,8 @@ simpleFunction bld = do m <- newModule (func, mappings) <- defineModule m (liftM2 (,) bld getGlobalMappings)- prov <- createModuleProviderForExistingModule m runEngineAccess $ do- addModuleProvider prov+ addModule m addGlobalMappings mappings generateFunction func
src/LLVM/ExecutionEngine/Engine.hs view
@@ -7,11 +7,7 @@ module LLVM.ExecutionEngine.Engine( EngineAccess, runEngineAccess,-{-- ExecutionEngine,--} createExecutionEngine, addModuleProvider, addModule,- {- runStaticConstructors, runStaticDestructors, -} getExecutionEngineTargetData, getPointerToFunction, addFunctionValue, addGlobalMappings,@@ -36,7 +32,6 @@ import qualified LLVM.FFI.Core as FFI(ModuleProviderRef, ValueRef) import qualified Control.Monad.Trans.State as MS-import Control.Monad.Trans.State (StateT, runStateT, ) import Control.Monad.IO.Class (MonadIO, liftIO, ) import Control.Monad (liftM, ) import Control.Applicative (Applicative, )@@ -56,53 +51,7 @@ import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr, ) import System.IO.Unsafe (unsafePerformIO) -{---- |The type of the JITer.-newtype ExecutionEngine = ExecutionEngine {- fromExecutionEngine :: ForeignPtr FFI.ExecutionEngine- } -withExecutionEngine :: ExecutionEngine -> (FFI.ExecutionEngineRef -> IO a)- -> IO a-withExecutionEngine = withForeignPtr . fromExecutionEngine---- |Create an execution engine for a module provider.--- Warning, do not call this function more than once.-createExecutionEngine :: ModuleProvider -> IO ExecutionEngine-createExecutionEngine prov =- withModuleProvider prov $ \provPtr ->- alloca $ \eePtr ->- alloca $ \errPtr -> do- ret <- FFI.createExecutionEngine eePtr provPtr errPtr- if ret == 1- then do err <- peek errPtr- errStr <- peekCString err- free err- ioError . userError $ errStr- else do ptr <- peek eePtr- liftM ExecutionEngine $ newForeignPtr FFI.ptrDisposeExecutionEngine ptr--addModuleProvider :: ExecutionEngine -> ModuleProvider -> IO ()-addModuleProvider ee prov =- withExecutionEngine ee $ \ eePtr ->- withModuleProvider prov $ \ provPtr ->- FFI.addModuleProvider eePtr provPtr--runStaticConstructors :: ExecutionEngine -> IO ()-runStaticConstructors ee = withExecutionEngine ee FFI.runStaticConstructors--runStaticDestructors :: ExecutionEngine -> IO ()-runStaticDestructors ee = withExecutionEngine ee FFI.runStaticDestructors--getExecutionEngineTargetData :: ExecutionEngine -> IO FFI.TargetDataRef-getExecutionEngineTargetData ee = withExecutionEngine ee FFI.getExecutionEngineTargetData--getPointerToFunction :: ExecutionEngine -> Function f -> IO (FunPtr f)-getPointerToFunction ee (Value f) =- withExecutionEngine ee $ \ eePtr ->- FFI.getPointerToGlobal eePtr f--}- -- This global variable holds the one and only execution engine. -- It may be missing, but it never dies. -- XXX We could provide a destructor, what about functions obtained by runFunction?@@ -143,7 +92,7 @@ } deriving (Show, Typeable) -newtype EngineAccess a = EA (StateT EAState IO a)+newtype EngineAccess a = EA (MS.StateT EAState IO a) deriving (Functor, Applicative, Monad, MonadIO) -- |The LLVM execution engine is encapsulated so it cannot be accessed directly.@@ -152,10 +101,8 @@ runEngineAccess :: EngineAccess a -> IO a runEngineAccess (EA body) = do eePtr <- getTheEngine- let ea = EAState { ea_engine = eePtr, ea_providers = [] }- (a, _ea') <- runStateT body ea+ MS.evalStateT body $ EAState { ea_engine = eePtr, ea_providers = [] } -- XXX should remove module providers again- return a addModuleProvider :: ModuleProvider -> EngineAccess () addModuleProvider prov = do@@ -208,18 +155,22 @@ addModule :: Module -> EngineAccess () addModule m = do- mp <- liftIO $ createModuleProviderForExistingModule m- addModuleProvider mp+ eePtr <- getEngine+ liftIO $ U.withModule m $ FFI.addModule eePtr -- | Get all the information needed to free a function. -- Freeing code might have to be done from a (C) finalizer, so it has to done from C. -- The function c_freeFunctionObject take these pointers as arguments and frees the function. type FreePointers = (FFI.ExecutionEngineRef, FFI.ModuleProviderRef, FFI.ValueRef)+{-# WARNING getFreePointers "Function returns undefined ModuleProviderRef if there is no module provider" #-} getFreePointers :: Function f -> EngineAccess FreePointers getFreePointers (Value f) = do ea <- EA MS.get- liftIO $ withModuleProvider (head $ ea_providers ea) $ \ mpp ->- return (ea_engine ea, mpp, f)+ liftIO $ do+ let ret mpp = return (ea_engine ea, mpp, f)+ case ea_providers ea of+ prov : _ -> withModuleProvider prov ret+ [] -> ret $ error "getFreePointers: no module provider" --------------------------------------