diff --git a/example/Common.hs b/example/Common.hs new file mode 100644 --- /dev/null +++ b/example/Common.hs @@ -0,0 +1,44 @@ +module Common where + +import qualified LLVM.FFI.ExecutionEngine as EE +import qualified LLVM.FFI.Core as LLVM + +import qualified Foreign.C.String as CStr +import qualified Foreign.Marshal.Array as Array +import qualified Foreign.Marshal.Alloc as Alloc +import Foreign.C.Types (CUInt) +import Foreign.Storable (Storable, peek) +import Foreign.Ptr (Ptr) + +import Control.Exception (bracket) +import Control.Monad (when) + +import qualified System.Exit as Exit +import Text.Printf (printf) + + +withArrayLen :: (Storable a) => [a] -> (CUInt -> Ptr a -> IO b) -> IO b +withArrayLen xs act = + Array.withArrayLen xs $ \len ptr -> act (fromIntegral len) ptr + +noResult :: IO () -> IO () +noResult = id + + +getString :: IO CStr.CString -> IO String +getString get = bracket get LLVM.disposeMessage CStr.peekCString + +createExecutionEngine :: LLVM.ModuleRef -> IO EE.ExecutionEngineRef +createExecutionEngine modul = + Alloc.alloca $ \execEngineRef -> + Alloc.alloca $ \errorMsgRef -> do + err <- + EE.createExecutionEngineForModuleCPU + execEngineRef modul errorMsgRef + when (err/=LLVM.false) $ do + bracket (peek errorMsgRef) Alloc.free $ \errorMsg -> do + noResult $ + printf "createExecutionEngine: %s\n" + =<< CStr.peekCString errorMsg + Exit.exitFailure + peek execEngineRef diff --git a/example/Host.hs b/example/Host.hs new file mode 100644 --- /dev/null +++ b/example/Host.hs @@ -0,0 +1,31 @@ +{- | +This program shows some interesting facts about the host machine. +-} +module Main where + +import Common (getString, createExecutionEngine) + +import qualified LLVM.FFI.ExecutionEngine as EE +import qualified LLVM.FFI.Target as Target +import qualified LLVM.FFI.Support.Host as Host +import qualified LLVM.FFI.Core as LLVM +import qualified LLVM.Target.Native as Native + +import Foreign.C.String (withCString) + +import Control.Exception (bracket) + + +main :: IO () +main = do + Native.initializeNativeTarget + + putStrLn =<< getString Host.getHostCPUName + putStrLn LLVM.hostTriple + + modul <- withCString "host" LLVM.moduleCreateWithName + withCString LLVM.hostTriple $ LLVM.setTarget modul + bracket (createExecutionEngine modul) EE.disposeExecutionEngine $ + \execEngine -> do + td <- EE.getExecutionEngineTargetData execEngine + putStrLn =<< getString (Target.copyStringRepOfTargetData td) diff --git a/example/JIT.hs b/example/JIT.hs --- a/example/JIT.hs +++ b/example/JIT.hs @@ -7,10 +7,11 @@ -} module Main where +import Common (withArrayLen, createExecutionEngine) + import qualified LLVM.FFI.Transforms.PassManagerBuilder as PMB import qualified LLVM.FFI.Transforms.Scalar as Transform import qualified LLVM.FFI.ExecutionEngine as EE -import qualified LLVM.FFI.Support.Host as Host import qualified LLVM.FFI.BitWriter as BW import qualified LLVM.FFI.Core as Core import qualified LLVM.Target.Native as Native @@ -19,19 +20,16 @@ import qualified Foreign.Marshal.Array as Array import qualified Foreign.Marshal.Alloc as Alloc import Foreign.C.String (withCString) -import Foreign.C.Types (CUInt, CFloat) -import Foreign.Storable (Storable, peek, sizeOf) +import Foreign.C.Types (CFloat) +import Foreign.Storable (sizeOf) import Foreign.Ptr (Ptr, FunPtr) -import Control.Exception (bracket, bracket_, finally) +import Control.Exception (bracket, bracket_) import Control.Monad (when, void) import Data.Tuple.HT (mapSnd) -import qualified System.Exit as Exit -import Text.Printf (printf) - vectorSize :: Int roundName :: String @@ -40,13 +38,6 @@ then (4, "llvm.x86.sse41.round.ps") else (8, "llvm.x86.avx.round.ps.256") -withArrayLen :: (Storable a) => [a] -> (CUInt -> Ptr a -> IO b) -> IO b -withArrayLen xs act = - Array.withArrayLen xs $ \len ptr -> act (fromIntegral len) ptr - -noResult :: IO () -> IO () -noResult = id - type Importer f = FunPtr f -> f foreign import ccall safe "dynamic" derefFuncPtr :: Importer (Ptr a -> IO ()) @@ -57,9 +48,6 @@ main = do Native.initializeNativeTarget - bracket Host.getHostCPUName Core.disposeMessage $ \strPtr -> - putStrLn =<< CStr.peekCString strPtr - modul <- withCString "_module" Core.moduleCreateWithName withCString Core.hostTriple $ Core.setTarget modul vectorType <- @@ -136,22 +124,12 @@ void $ withCString "round-avx-opt.bc" $ BW.writeBitcodeToFile modul - Alloc.alloca $ \execEngineRef -> do - Alloc.alloca $ \errorMsgRef -> do - err <- - EE.createExecutionEngineForModuleCPU execEngineRef modul errorMsgRef - when (err/=Core.false) $ do - noResult $ - printf "createExecutionEngine: %s\n" - =<< CStr.peekCString =<< peek errorMsgRef - Exit.exitFailure - - execEngine <- peek execEngineRef - flip finally (EE.disposeExecutionEngine execEngine) $ do - let vector = take vectorSize $ iterate (1+) (-1.3 :: CFloat) - funcPtr <- EE.getPointerToFunction execEngine func - let size = sum $ map sizeOf vector - Alloc.allocaBytesAligned size size $ \ptr -> do - Array.pokeArray ptr vector - derefFuncPtr funcPtr ptr - print =<< Array.peekArray vectorSize ptr + bracket (createExecutionEngine modul) EE.disposeExecutionEngine $ + \execEngine -> do + let vector = take vectorSize $ iterate (1+) (-1.3 :: CFloat) + funcPtr <- EE.getPointerToFunction execEngine func + let size = sum $ map sizeOf vector + Alloc.allocaBytesAligned size size $ \ptr -> do + Array.pokeArray ptr vector + derefFuncPtr funcPtr ptr + print =<< Array.peekArray vectorSize ptr diff --git a/example/Offset.hs b/example/Offset.hs --- a/example/Offset.hs +++ b/example/Offset.hs @@ -1,28 +1,18 @@ module Main where +import Common (withArrayLen, createExecutionEngine) + import qualified LLVM.FFI.ExecutionEngine as EE import qualified LLVM.FFI.Target as Target import qualified LLVM.FFI.Core as LLVM import qualified LLVM.Target.Native as Native -import qualified Foreign.Marshal.Array as Array -import qualified Foreign.Marshal.Alloc as Alloc -import Foreign.C.String (withCString, peekCString) -import Foreign.C.Types (CUInt, CULLong) -import Foreign.Storable (Storable, peek) -import Foreign.Ptr (Ptr) - -import qualified System.Exit as Exit -import Control.Exception (finally) -import Control.Monad (when) +import Foreign.C.String (withCString) +import Foreign.C.Types (CULLong) -import Text.Printf (printf) +import Control.Exception (bracket) -withArrayLen :: (Storable a) => [a] -> (CUInt -> Ptr a -> IO b) -> IO b -withArrayLen xs act = - Array.withArrayLen xs $ \len ptr -> act (fromIntegral len) ptr - offset :: IO CULLong offset = do Native.initializeNativeTarget @@ -45,9 +35,6 @@ elementOffset <- LLVM.constPtrToInt elementPtr int64Type LLVM.constIntGetZExtValue elementOffset -noResult :: IO () -> IO () -noResult = id - offsetTarget :: IO [CULLong] offsetTarget = do Native.initializeNativeTarget @@ -61,21 +48,10 @@ modul <- withCString "_module" LLVM.moduleCreateWithName withCString LLVM.hostTriple $ LLVM.setTarget modul - Alloc.alloca $ \execEngineRef -> do - Alloc.alloca $ \errorMsgRef -> do - err <- - EE.createExecutionEngineForModuleCPU - execEngineRef modul errorMsgRef - when (err/=LLVM.false) $ do - noResult $ - printf "createExecutionEngine: %s\n" - =<< peekCString =<< peek errorMsgRef - Exit.exitFailure - - execEngine <- peek execEngineRef - flip finally (EE.disposeExecutionEngine execEngine) $ do - td <- EE.getExecutionEngineTargetData execEngine - mapM (Target.offsetOfElement td structType) [0..2] + bracket (createExecutionEngine modul) EE.disposeExecutionEngine $ + \execEngine -> do + td <- EE.getExecutionEngineTargetData execEngine + mapM (Target.offsetOfElement td structType) [0..2] main :: IO () main = print =<< offsetTarget diff --git a/llvm-ffi.cabal b/llvm-ffi.cabal --- a/llvm-ffi.cabal +++ b/llvm-ffi.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: llvm-ffi -Version: 9.1.0 +Version: 9.1.0.1 License: BSD-3-Clause License-File: LICENSE Synopsis: FFI bindings to the LLVM compiler toolkit. @@ -19,6 +19,17 @@ . > cabal install --extra-include-dirs=/usr/lib/llvm-9/include --extra-lib-dirs=/usr/lib/llvm-9/lib llvm-ffi . + For @cabal new-build@ this does not work, + because every package build is bound to all influencing flags. + That is, if you build, say @llvm-tf@, + it depends on @llvm-ffi@ without the extra-lib-dirs flag. + In order to solve this problem, + you may specify the extra directories in the global Cabal configuration. + I.e. you may add the following lines to @.cabal/config@: + . + > extra-include-dirs: /usr/lib/llvm-9/include + > extra-lib-dirs: /usr/lib/llvm-9/lib + . You can store such paths permanently in a @pkg-config@ file like @llvm.pc@. The optimal way would be if LLVM installations or GNU/Linux distributions would contain such a file, but they don't. @@ -102,7 +113,7 @@ Location: http://hub.darcs.net/thielema/llvm-ffi/ Source-Repository this - Tag: 9.1.0 + Tag: 9.1.0.1 Type: darcs Location: http://hub.darcs.net/thielema/llvm-ffi/ @@ -246,7 +257,7 @@ Cxx-Sources: cbits/support.cpp -Executable llvm-ffi-example +Executable llvm-ffi-host If flag(buildExamples) Build-Depends: llvm-ffi, @@ -261,7 +272,26 @@ Hs-Source-Dirs: example GHC-Options: -Wall Default-Language: Haskell2010 + Main-Is: Host.hs + Other-Modules: Common + +Executable llvm-ffi-jit + If flag(buildExamples) + Build-Depends: + llvm-ffi, + utility-ht >=0.0.9 && <0.1, + base + Else + Buildable: False + + If flag(developer) + GHC-Options: -Werror + + Hs-Source-Dirs: example + GHC-Options: -Wall + Default-Language: Haskell2010 Main-Is: JIT.hs + Other-Modules: Common Executable llvm-ffi-offset If flag(buildExamples) @@ -279,3 +309,4 @@ GHC-Options: -Wall Default-Language: Haskell2010 Main-Is: Offset.hs + Other-Modules: Common diff --git a/src/LLVM/FFI/Target.hsc b/src/LLVM/FFI/Target.hsc --- a/src/LLVM/FFI/Target.hsc +++ b/src/LLVM/FFI/Target.hsc @@ -39,6 +39,10 @@ foreign import ccall unsafe "LLVMCreateTargetData" createTargetData :: CString -> IO TargetDataRef +foreign import ccall unsafe "LLVMDisposeTargetData" disposeTargetData + :: TargetDataRef -> IO () +foreign import ccall unsafe "&LLVMDisposeTargetData" ptrDisposeTargetData + :: FunPtr (TargetDataRef -> IO ()) foreign import ccall unsafe "LLVMAddTargetLibraryInfo" addTargetLibraryInfo :: TargetLibraryInfoRef -> PassManagerRef -> IO () foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" copyStringRepOfTargetData @@ -67,7 +71,3 @@ :: TargetDataRef -> TypeRef -> CULLong -> IO CUInt foreign import ccall unsafe "LLVMOffsetOfElement" offsetOfElement :: TargetDataRef -> TypeRef -> CUInt -> IO CULLong -foreign import ccall unsafe "LLVMDisposeTargetData" disposeTargetData - :: TargetDataRef -> IO () -foreign import ccall unsafe "&LLVMDisposeTargetData" ptrDisposeTargetData - :: FunPtr (TargetDataRef -> IO ())