nvvm 0.8.0.3 → 0.9.0.0
raw patch · 5 files changed
+170/−61 lines, 5 filessetup-changed
Files
- CHANGELOG.md +11/−0
- Foreign/NVVM/Compile.chs +138/−48
- Foreign/NVVM/Error.chs +5/−1
- Setup.hs +12/−8
- nvvm.cabal +4/−4
CHANGELOG.md view
@@ -4,6 +4,16 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/). +## [0.9.0.0] - 2018-10-02+### Fixed+ * Build fix for ghc-8.6++### Added+ * `addModuleLazy` and `addModuleLazyFromPtr` from CUDA-10.0++### Changed+ * Replace uses of `String` with `ShortByteString`+ ## [0.8.0.3] - 2018-03-12 ### Fixed * Build fix for Cabal-2.2 (ghc-8.4)@@ -32,6 +42,7 @@ * First version. Released on an unsuspecting world. +[0.9.0.0]: https://github.com/tmcdonell/nvvm/compare/v0.8.0.3...v0.9.0.0 [0.8.0.3]: https://github.com/tmcdonell/nvvm/compare/v0.8.0.2...v0.8.0.3 [0.8.0.2]: https://github.com/tmcdonell/nvvm/compare/v0.8.0.1...v0.8.0.2 [0.8.0.1]: https://github.com/tmcdonell/nvvm/compare/v0.8.0.0...v0.8.0.1
Foreign/NVVM/Compile.chs view
@@ -1,4 +1,9 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -------------------------------------------------------------------------------- -- |@@ -20,7 +25,8 @@ create, destroy,- addModule, addModuleFromPtr,+ addModule, addModuleFromPtr,+ addModuleLazy, addModuleLazyFromPtr, compile, verify @@ -38,13 +44,19 @@ import Control.Exception import Data.Word-import Data.ByteString ( ByteString ) import Text.Printf+import Data.ByteString ( ByteString )+import Data.ByteString.Short ( ShortByteString ) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Short as BS+import qualified Data.ByteString.Short.Internal as BSI +import GHC.Exts+import GHC.Base ( IO(..) ) + #include "cbits/stubs.h" {# context lib="nvvm" #} @@ -79,7 +91,7 @@ -- {-# INLINEABLE compileModule #-} compileModule- :: String -- ^ name of the module+ :: ShortByteString -- ^ name of the module -> ByteString -- ^ NVVM IR in either textual or bitcode representation -> [CompileOption] -- ^ compiler options -> IO Result@@ -91,8 +103,8 @@ -- {-# INLINEABLE compileModules #-} compileModules- :: [(String, ByteString)] -- ^ (module name, module NVVM IR) pairs to compile- -> [CompileOption] -- ^ compiler options+ :: [(ShortByteString, ByteString)] -- ^ (module name, module NVVM IR) pairs to compile+ -> [CompileOption] -- ^ compiler options -> IO Result compileModules !bss !opts = bracket create destroy $ \prg -> do@@ -108,16 +120,11 @@ -- <http://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1g46a0ab04a063cba28bfbb41a1939e3f4> -- {-# INLINEABLE create #-}-create :: IO Program-create = resultIfOk =<< nvvmCreateProgram- where- peekProgram ptr = Program `fmap` peek ptr- {#- fun unsafe nvvmCreateProgram- { alloca- `Program' peekProgram*- }- -> `Status' cToEnum- #}+{# fun unsafe nvvmCreateProgram as create+ { alloca- `Program' peekProgram*+ }+ -> `()' checkStatus*-+#} -- | Destroy a 'Program'@@ -125,16 +132,12 @@ -- <http://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1gfba94cab1224c0152841b80690d366aa> -- {-# INLINEABLE destroy #-}-destroy :: Program -> IO ()-destroy !prg = nothingIfOk =<< nvvmDestroyProgram prg- where- withProgram p = with (useProgram p)- {#- fun unsafe nvvmDestroyProgram- { withProgram* `Program'- }- -> `Status' cToEnum- #}+{#+ fun unsafe nvvmDestroyProgram as destroy+ { withProgram* `Program'+ }+ -> `()' checkStatus*-+#} -- | Add a module level NVVM IR to a program@@ -143,9 +146,9 @@ -- {-# INLINEABLE addModule #-} addModule- :: Program -- ^ NVVM program to add to- -> String -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)- -> ByteString -- ^ NVVM IR module in either bitcode or textual representation+ :: Program -- ^ NVVM program to add to+ -> ShortByteString -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)+ -> ByteString -- ^ NVVM IR module in either bitcode or textual representation -> IO () addModule !prg !name !bs = B.unsafeUseAsCStringLen bs $ \(ptr,len) ->@@ -157,25 +160,84 @@ -- {-# INLINEABLE addModuleFromPtr #-} addModuleFromPtr- :: Program -- ^ NVVM program to add to- -> String -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)- -> Int -- ^ Number of bytes in the module- -> Ptr Word8 -- ^ NVVM IR module in bitcode or textual representation+ :: Program -- ^ NVVM program to add to+ -> ShortByteString -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)+ -> Int -- ^ Number of bytes in the module+ -> Ptr Word8 -- ^ NVVM IR module in bitcode or textual representation -> IO () addModuleFromPtr !prg !name !size !buffer =- nothingIfOk =<< nvvmAddModuleToProgram prg buffer size name+ nvvmAddModuleToProgram prg buffer size name where {# fun unsafe nvvmAddModuleToProgram- { useProgram `Program'- , castPtr `Ptr Word8'- , cIntConv `Int'- , withCString* `String'+ { useProgram `Program'+ , castPtr `Ptr Word8'+ , cIntConv `Int'+ , useAsCString* `ShortByteString' }- -> `Status' cToEnum+ -> `()' checkStatus*- #} +-- | Add a module level NVVM IR to a program.+--+-- The module is loaded lazily: only symbols required by modules loaded using+-- 'addModule' or 'addModuleFromPtr' will be loaded.+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/libnvvm-api/group__compilation.html#group__compilation_1g5356ce5063db232cd4330b666c62219b>+--+-- @since 0.9.0.0+--+{-# INLINEABLE addModuleLazy #-}+addModuleLazy+ :: Program -- ^ NVVM program to add to+ -> ShortByteString -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)+ -> ByteString -- ^ NVVM IR module in either bitcode or textual representation+ -> IO ()+#if CUDA_VERSION < 10000+addModuleLazy = requireSDK 'addModuleLazy 10.0+#else+addModuleLazy !prg !name !bs =+ B.unsafeUseAsCStringLen bs $ \(buffer, size) ->+ addModuleLazyFromPtr prg name size (castPtr buffer)+#endif+++-- | As with 'addModuleLazy', but read the specified number of bytes from the+-- given pointer (the symbols are loaded lazily, the data in the buffer will be+-- read immediately).+--+-- Requires CUDA-10.0+--+-- @since 0.9.0.0+--+{-# INLINEABLE addModuleLazyFromPtr #-}+addModuleLazyFromPtr+ :: Program -- ^ NVVM program to add to+ -> ShortByteString -- ^ Name of the module (defaults to \"@\<unnamed\>@\" if empty)+ -> Int -- ^ Number of bytes in the module+ -> Ptr Word8 -- ^ NVVM IR in bitcode or textual representation+ -> IO ()+#if CUDA_VERSION < 10000+addModuleLazyFromPtr = requireSDK 'addModuleLazyFromPtr 10.0+#else+addModuleLazyFromPtr !prg !name !size !buffer =+ nvvmLazyAddModuleToProgram prg buffer size name+ where+ {#+ fun unsafe nvvmLazyAddModuleToProgram+ { useProgram `Program'+ , castPtr `Ptr Word8'+ , cIntConv `Int'+ , useAsCString* `ShortByteString'+ }+ -> `()' checkStatus*-+ #}+#endif++ -- | Compile the NVVM program. Returns the log from the compiler/verifier and, -- if successful, the compiled program. --@@ -203,14 +265,14 @@ { useProgram `Program' , alloca- `Int' peekIntConv* }- -> `Status' cToEnum+ -> `()' checkStatus*- #} {# fun unsafe nvvmGetCompiledResult { useProgram `Program' , withForeignPtr'* `ForeignPtr Word8' }- -> `Status' cToEnum+ -> `()' checkStatus*- #} @@ -238,14 +300,14 @@ { useProgram `Program' , alloca- `Int' peekIntConv* }- -> `Status' cToEnum+ -> `()' checkStatus*- #} {# fun unsafe nvvmGetProgramLog { useProgram `Program' , withForeignPtr'* `ForeignPtr Word8' }- -> `Status' cToEnum+ -> `()' checkStatus*- #} @@ -272,12 +334,40 @@ toStr GenerateDebugInfo = "-g" {-# INLINEABLE retrieve #-}-retrieve :: IO (Status, Int) -> (ForeignPtr Word8 -> IO Status) -> IO ByteString-retrieve size payload = do- bytes <- resultIfOk =<< size- if bytes <= 1 -- size includes NULL terminator+retrieve :: IO Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString+retrieve size fill = do+ bytes <- size+ if bytes <= 1 -- size includes NULL terminator then return B.empty else do fp <- mallocForeignPtrBytes bytes- _ <- nothingIfOk =<< payload fp+ _ <- fill fp return (B.fromForeignPtr fp 0 bytes)++{-# INLINEABLE peekProgram #-}+peekProgram :: Ptr {# type nvvmProgram #} -> IO Program+peekProgram p = Program `fmap` peek p++{-# INLINEABLE withProgram #-}+withProgram :: Program -> (Ptr {# type nvvmProgram #} -> IO a) -> IO a+withProgram p = with (useProgram p)+++-- [Short]ByteStrings are not null-terminated, so can't be passed directly to C.+--+-- unsafeUseAsCString :: ShortByteString -> CString+-- unsafeUseAsCString (BI.SBS ba#) = Ptr (byteArrayContents# ba#)++{-# INLINE useAsCString #-}+useAsCString :: ShortByteString -> (CString -> IO a) -> IO a+useAsCString (BSI.SBS ba#) action = IO $ \s0 ->+ case sizeofByteArray# ba# of { n# ->+ case newPinnedByteArray# (n# +# 1#) s0 of { (# s1, mba# #) ->+ case byteArrayContents# (unsafeCoerce# mba#) of { addr# ->+ case copyByteArrayToAddr# ba# 0# addr# n# s1 of { s2 ->+ case writeWord8OffAddr# addr# n# 0## s2 of { s3 ->+ case action (Ptr addr#) of { IO action' ->+ case action' s3 of { (# s4, r #) ->+ case touch# mba# s4 of { s5 ->+ (# s5, r #)+ }}}}}}}}
Foreign/NVVM/Error.chs view
@@ -13,7 +13,7 @@ Status(..), describe,- resultIfOk, nothingIfOk,+ resultIfOk, nothingIfOk, checkStatus, nvvmError, nvvmErrorIO, requireSDK, ) where@@ -113,4 +113,8 @@ case status of Success -> return () _ -> throwIO (ExitCode status)++{-# INLINE checkStatus #-}+checkStatus :: CInt -> IO ()+checkStatus = nothingIfOk . cToEnum
Setup.hs view
@@ -50,8 +50,8 @@ customBuildInfoFilePath :: FilePath customBuildInfoFilePath = "nvvm" <.> "buildinfo" -generatedBuldInfoFilePath :: FilePath-generatedBuldInfoFilePath = customBuildInfoFilePath <.> "generated"+generatedBuildInfoFilePath :: FilePath+generatedBuildInfoFilePath = customBuildInfoFilePath <.> "generated" -- Location of the NVVM library relative to the base CUDA installation --@@ -125,7 +125,7 @@ compilerId_ = compilerId (compiler lbi) -- noExtraFlags args- generateAndStoreBuildInfo verbosity profile currentPlatform compilerId_ generatedBuldInfoFilePath+ generateAndStoreBuildInfo verbosity profile currentPlatform compilerId_ generatedBuildInfoFilePath validateLinker verbosity currentPlatform $ withPrograms lbi -- actualBuildInfoToUse <- getHookedBuildInfo verbosity@@ -153,7 +153,11 @@ -- False -> [| head (componentLibraries (getComponentLocalBuildInfo lbi CLibName)) |] ) #endif- sharedLib = buildDir lbi </> mkSharedLibName cid uid+#if MIN_VERSION_Cabal(2,3,0)+ sharedLib = buildDir lbi </> mkSharedLibName platform cid uid+#else+ sharedLib = buildDir lbi </> mkSharedLibName cid uid+#endif Just extraLibDirs' = extraLibDirs . libBuildInfo <$> library pkg_descr -- updateLibraryRPATHs verbosity platform sharedLib extraLibDirs'@@ -202,14 +206,14 @@ notice verbosity $ printf "The user-provided buildinfo from file '%s' will be used. To use default settings, delete this file." customBuildInfoFilePath readHookedBuildInfo verbosity customBuildInfoFilePath else do- generatedBuildInfoExists <- doesFileExist generatedBuldInfoFilePath+ generatedBuildInfoExists <- doesFileExist generatedBuildInfoFilePath if generatedBuildInfoExists then do- notice verbosity $ printf "Using build information from '%s'" generatedBuldInfoFilePath+ notice verbosity $ printf "Using build information from '%s'" generatedBuildInfoFilePath notice verbosity $ printf "Provide a '%s' file to override this behaviour" customBuildInfoFilePath- readHookedBuildInfo verbosity generatedBuldInfoFilePath+ readHookedBuildInfo verbosity generatedBuildInfoFilePath else- die' verbosity $ printf "Unexpected failure: neither the default '%s' nor custom '%s' exist" generatedBuldInfoFilePath customBuildInfoFilePath+ die' verbosity $ printf "Unexpected failure: neither the default '%s' nor custom '%s' exist" generatedBuildInfoFilePath customBuildInfoFilePath -- Runs CUDA detection procedure and stores .buildinfo to a file.
nvvm.cabal view
@@ -1,5 +1,5 @@ name: nvvm-version: 0.8.0.3+version: 0.9.0.0 synopsis: FFI bindings to NVVM description: The NVVM library compiles NVVM IR (a subset of LLVM IR) into PTX code which@@ -23,8 +23,8 @@ license: BSD3 license-file: LICENSE homepage: https://github.com/tmcdonell/nvvm-author: Trevor L. McDonell-maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+author: Trevor L. McDonell <trevor.mcdonell@gmail.com>+maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com> copyright: [2016] Trevor L. McDonell category: Foreign build-type: Custom@@ -83,7 +83,7 @@ source-repository this type: git location: https://github.com/tmcdonell/nvvm- tag: v0.8.0.3+ tag: v0.9.0.0 -- vim: nospell