diff --git a/Foreign/LibNVVM.hs b/Foreign/LibNVVM.hs new file mode 100644 --- /dev/null +++ b/Foreign/LibNVVM.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +-- | +-- Module : Foreign.LibNVVM.Compile +-- Copyright : NVIDIA Corporation +-- License : MIT +-- +-- Maintainer : Sean Lee +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +module Foreign.LibNVVM ( + module Foreign.LibNVVM.Compile, + module Foreign.LibNVVM.Error, + module Foreign.LibNVVM.Info, +) where + +import Foreign.LibNVVM.Compile +import Foreign.LibNVVM.Error +import Foreign.LibNVVM.Info diff --git a/Foreign/LibNVVM/Compile.chs b/Foreign/LibNVVM/Compile.chs new file mode 100644 --- /dev/null +++ b/Foreign/LibNVVM/Compile.chs @@ -0,0 +1,320 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +-- | +-- Module : Foreign.LibNVVM.Compile +-- Copyright : NVIDIA Corporation +-- License : MIT +-- +-- Maintainer : Sean Lee +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +module Foreign.LibNVVM.Compile ( + + -- * Compilation result + Result(..), CompileFlag(..), VerifyFlag, + + -- * Compilation + compileModule, compileModules, + +) where + +import Prelude hiding ( log ) +import Data.ByteString ( ByteString ) +import Data.Word +import Control.Exception +import Control.Monad +import Text.Printf +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Unsafe as B +import qualified Data.ByteString.Internal as B + +import Foreign.C +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.Marshal +import Foreign.Storable +import Foreign.CUDA.Analysis +import Foreign.LibNVVM.Error +import Foreign.LibNVVM.Internal + +#include "cbits/stubs.h" +{# context lib="nvvm" #} + + +-- | The return type of compiling a module(s) is the compilation log together +-- with the resulting binary ptx/cubin. +-- +data Result = Result { + -- | Any compilation or verification messages and warnings that were + -- generated during compilation of the NVVM module. Note that even upon + -- successful completion, the log may not be empty. + -- + nvvmLog :: {-# UNPACK #-} !ByteString + , nvvmResult :: {-# UNPACK #-} !ByteString + } + + +-- | An opaque handle to an NVVM program +-- +newtype Program = Program { useProgram :: {# type nvvmProgram #}} + deriving (Eq, Show) + + +-- | The available program compilation flags +-- +data CompileFlag + -- | Level of optimisation to apply (0-3) (Default: 3) + = OptimisationLevel !Int + + -- | Compute architecture to target (Default: Compute 2.0) + | Target !Compute + + -- | Flush denormal values to zero when performing single-precision floating + -- point operations (Default: preserve denormal values) + | FlushToZero + + -- | Use a faster approximation for single-precision floating-point square + -- root (Default: use IEEE round-to-nearest mode) + | FastSqrt + + -- | Use a faster approximation for single-precision floating-point division + -- and reciprocal operations (Default: use IEEE round-to-nearest mode) + | FastDiv + + -- | Disable fused-multiply-add contraction (Default: enabled) + | DisableFMA + + -- | Generate debugging symbols (-g) (Default: no) + | GenerateDebugInfo + + +-- | The available program verification flags +-- +data VerifyFlag + + +compileFlagToArg :: CompileFlag -> String +compileFlagToArg f = + case f of + OptimisationLevel o -> printf "-opt=%d" o + Target (Compute n m) -> printf "-arch=compute_%d%d" n m + FlushToZero -> "-ftz=1" + FastSqrt -> "-prec-sqrt=0" + FastDiv -> "-prec-div=0" + DisableFMA -> "-fma=0" + GenerateDebugInfo -> "-g" + + +verifyFlagToArg :: VerifyFlag -> String +verifyFlagToArg _ = error "verifyFlagToArg" + + +-- High-level interface +-- -------------------- + +-- | Compile an NVVM IR module according to the specified options. If an error +-- occurs an exception is thrown, otherwise the generated PTX is returned +-- together with any warning or verification messages generated during +-- compilation. +-- +-- The input NVVM IR module can be either in the bitcode representation or the +-- text representation. +-- +compileModule + :: String -- ^ name of the module (optional) + -> ByteString -- ^ module NVVM IR + -> [CompileFlag] -- ^ compilation options + -> Bool -- ^ verify program? + -> IO Result +compileModule name bc = compileModules [(name,bc)] + + +-- | Compile and link multiple NVVM IR modules together to form a single +-- program. The compiled result is represented in PTX. +-- +-- Each NVVM IR module may individually be in either the bitcode representation +-- or in the text representation. +-- +compileModules + :: [(String, ByteString)] -- ^ modules to compile and link + -> [CompileFlag] -- ^ compilation options + -> Bool -- ^ verify program? + -> IO Result +compileModules modules opts verify = + bracket create destroy $ \prg -> do + res <- try $ do + mapM_ (uncurry (addModule prg)) modules + when verify (verifyProgram prg []) + compileProgram prg opts + compilerResult prg + log <- compilerLog prg + case res of + Left (err :: NVVMException) -> nvvmError (unlines [show err, B.unpack log]) + Right ptx -> return $! Result log ptx + + +-- The raw interface to libNVVM +-- ---------------------------- + +-- | Create a new program handle +-- +create :: IO Program +create = resultIfOk =<< nvvmCreateProgram + +{-# INLINE nvvmCreateProgram #-} +{# fun unsafe nvvmCreateProgram + { alloca- `Program' peekProgram* + } + -> `Status' cToEnum #} + where + peekProgram = liftM Program . peek + + +-- | Destroy a program handle +-- +destroy :: Program -> IO () +destroy p = nothingIfOk =<< nvvmDestroyProgram p + +{-# INLINE nvvmDestroyProgram #-} +{# fun unsafe nvvmDestroyProgram + { withProgram* `Program' } -> `Status' cToEnum #} + where + withProgram = with . useProgram + + +-- | Add an NVVM IR module to the given program compilation unit. An exception +-- is raised if: +-- +-- * The 'Program' to add to is invalid; or +-- +-- * The NVVM module IR is invalid. +-- +addModule :: Program -> String -> ByteString -> IO () +addModule prg name mdl = + B.unsafeUseAsCStringLen mdl $ \(b,n) -> do + nothingIfOk =<< nvvmAddModuleToProgram prg b n name + +{-# INLINE nvvmAddModuleToProgram #-} +{# fun unsafe nvvmAddModuleToProgram + { useProgram `Program' + , id `CString' + , cIntConv `Int' + , withCString'* `String' + } + -> `Status' cToEnum #} + where + withCString' [] f = f nullPtr -- defaults to "" + withCString' s f = withCString s f + + +-- | Compile the given 'Program' and all modules that have been previously added +-- to it. +-- +compileProgram :: Program -> [CompileFlag] -> IO () +compileProgram prg opts = + bracket + (mapM (newCString . compileFlagToArg) opts) + (mapM free) + (\args -> nothingIfOk =<< withArrayLen args (nvvmCompileProgram prg)) + +{-# INLINE nvvmCompileProgram #-} +{# fun unsafe nvvmCompileProgram + { useProgram `Program' + , cIntConv `Int' + , id `Ptr CString' + } + -> `Status' cToEnum #} + + +-- | Retrieve the result of compiling a 'Program' as a 'ByteString' containing +-- the generated PTX. An exception is raised if the compilation unit is invalid. +-- +compilerResult :: Program -> IO ByteString +compilerResult prg = do + n <- resultIfOk =<< nvvmGetCompiledResultSize prg + log <- B.mallocByteString n + nothingIfOk =<< nvvmGetCompiledResult prg log + return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator + +{-# INLINE nvvmGetCompiledResult #-} +{# fun unsafe nvvmGetCompiledResult + { useProgram `Program' + , withForeignPtr'* `ForeignPtr Word8' + } + -> `Status' cToEnum #} + where + withForeignPtr' p f = withForeignPtr (castForeignPtr p) f + +{-# INLINE nvvmGetCompiledResultSize #-} +{# fun unsafe nvvmGetCompiledResultSize + { useProgram `Program' + , alloca- `Int' peekIntConv* + } + -> `Status' cToEnum #} + + +-- | Retrieve the log of compiling a 'Program' as a 'ByteString'. +-- +compilerLog :: Program -> IO ByteString +compilerLog prg = do + n <- resultIfOk =<< nvvmGetProgramLogSize prg + log <- B.mallocByteString n + nothingIfOk =<< nvvmGetProgramLog prg log + return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator + +{-# INLINE nvvmGetProgramLog #-} +{# fun unsafe nvvmGetProgramLog + { useProgram `Program' + , withForeignPtr'* `ForeignPtr Word8' + } + -> `Status' cToEnum #} + where + withForeignPtr' p f = withForeignPtr (castForeignPtr p) f + +{-# INLINE nvvmGetProgramLogSize #-} +{# fun unsafe nvvmGetProgramLogSize + { useProgram `Program' + , alloca- `Int' peekIntConv* + } + -> `Status' cToEnum #} + + +-- | Verify the NVVM program. If an error is encountered, an exception is +-- thrown. +-- +verifyProgram :: Program -> [VerifyFlag] -> IO () +verifyProgram prg opts = + bracket + (mapM (newCString . verifyFlagToArg) opts) + (mapM free) + (\args -> nothingIfOk =<< withArrayLen args (nvvmVerifyProgram prg)) + +{# fun unsafe nvvmVerifyProgram + { useProgram `Program' + , cIntConv `Int' + , id `Ptr CString' + } + -> `Status' cToEnum #} + diff --git a/Foreign/LibNVVM/Error.chs b/Foreign/LibNVVM/Error.chs new file mode 100644 --- /dev/null +++ b/Foreign/LibNVVM/Error.chs @@ -0,0 +1,111 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ForeignFunctionInterface #-} +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +-- | +-- Module : Foreign.LibNVVM.Error +-- Copyright : NVIDIA Corporation +-- License : MIT +-- +-- Maintainer : Sean Lee +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +module Foreign.LibNVVM.Error ( + + -- * Error code + Status(..), NVVMException(..), + nvvmError, describe, + + -- * Helper functions + resultIfOk, nothingIfOk, + +) where + +import Control.Exception +import Data.Typeable +import System.IO.Unsafe +import Foreign.C +import Foreign.Ptr +import Foreign.LibNVVM.Internal + +#include "cbits/stubs.h" +{# context lib = "nvvm" #} + +-- | +-- The type 'Status' is an enumeration whose values represent the status of the +-- last libNVVM operation. +-- +{# enum nvvmResult as Status + { underscoreToCase + , NVVM_SUCCESS as Success + } + with prefix="NVVM_ERROR" deriving (Eq, Show) #} + + +-- | An NVVM Exception +-- +data NVVMException + = ExitCode Status + | UserError String + deriving Typeable + +instance Exception NVVMException + +instance Show NVVMException where + showsPrec n (ExitCode s) = showsPrec n ("NVVM Exception: " ++ describe s) + showsPrec _ (UserError s) = showString s + +-- | Raise an 'NVVMException' in the IO monad +-- +nvvmError :: String -> IO a +nvvmError s = throwIO (UserError s) + + +-- Helper function +-- --------------- + +-- | Get the message string for a given NVVM result code +-- +{# fun pure unsafe nvvmGetErrorString as describe + { cFromEnum `Status' } -> `String' #} + +-- | +-- Return the results of a function on successful execution, otherwise throw an +-- exception with an error string associated with the return code +-- +{-# INLINE resultIfOk #-} +resultIfOk :: (Status, a) -> IO a +resultIfOk (status, result) = + case status of + Success -> return result + _ -> throwIO (ExitCode status) + +-- | +-- Throw an exception with an error string associated with an unsuccessful +-- return code, otherwise return unit. +-- +{-# INLINE nothingIfOk #-} +nothingIfOk :: Status -> IO () +nothingIfOk status = + case status of + Success -> return () + _ -> throwIO (ExitCode status) + diff --git a/Foreign/LibNVVM/Info.chs b/Foreign/LibNVVM/Info.chs new file mode 100644 --- /dev/null +++ b/Foreign/LibNVVM/Info.chs @@ -0,0 +1,62 @@ +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +-- | +-- Module : Foreign.LibNVVM.Info +-- Copyright : NVIDIA Corporation +-- License : MIT +-- +-- Maintainer : Sean Lee +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- + +module Foreign.LibNVVM.Info ( + + nvvmVersion, + +) where + +import Foreign.LibNVVM.Internal +import Foreign.LibNVVM.Error + +import Data.Version +import Foreign.C +import Foreign.Ptr +import Foreign.Marshal + +#include "cbits/stubs.h" +{# context lib="nvvm" #} + + +-- | Return the libNVVM version number +-- +nvvmVersion :: IO Version +nvvmVersion = do + (r, major,minor) <- nvvmVersion' + resultIfOk (r, Version [major,minor] []) + + +{-# INLINE nvvmVersion' #-} +{# fun unsafe nvvmVersion as nvvmVersion' + { alloca- `Int' peekIntConv* + , alloca- `Int' peekIntConv* + } + -> `Status' cToEnum #} + diff --git a/Foreign/LibNVVM/Internal.chs b/Foreign/LibNVVM/Internal.chs new file mode 100644 --- /dev/null +++ b/Foreign/LibNVVM/Internal.chs @@ -0,0 +1,89 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +-- | +-- Module : Foreign.LibNVVM.Internal +-- Copyright : NVIDIA Corporation +-- License : MIT +-- +-- Maintainer : Sean Lee +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- + +module Foreign.LibNVVM.Internal ( + + withIntConv, withFloatConv, peekIntConv, peekFloatConv, + + cIntConv, cFloatConv, + cToEnum, cFromEnum, + +) where + +import Control.Monad +import Foreign.C +import Foreign.Ptr +import Foreign.Marshal +import Foreign.Storable + + +-- Composite marshalling functions +-- ------------------------------- + +withIntConv :: (Storable b, Integral a, Integral b) => a -> (Ptr b -> IO c) -> IO c +withIntConv = with . cIntConv + +withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c +withFloatConv = with . cFloatConv + +peekIntConv :: (Storable a, Integral a, Integral b) => Ptr a -> IO b +peekIntConv = liftM cIntConv . peek + +peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b +peekFloatConv = liftM cFloatConv . peek + + +-- Conversion routines +-- ------------------- + +{-# INLINE cIntConv #-} +cIntConv :: (Integral a, Integral b) => a -> b +cIntConv = fromIntegral + +{-# INLINE [1] cFloatConv #-} +cFloatConv :: (RealFloat a, RealFloat b) => a -> b +cFloatConv = realToFrac +-- As this conversion by default goes via `Rational', it can be very slow... +{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; + "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x; + "cFloatConv/Float->CFloat" forall (x::Float). cFloatConv x = CFloat x; + "cFloatConv/CFloat->Float" forall (x::Float). cFloatConv CFloat x = x; + "cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x; + "cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x + #-} + +cToEnum :: (Integral i, Enum e) => i -> e +cToEnum = toEnum . cIntConv + +cFromEnum :: (Enum e, Integral i) => e -> i +cFromEnum = cIntConv . fromEnum + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,22 @@ +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. + +import Distribution.Simple +main = defaultMain diff --git a/Test/simple/Simple.hs b/Test/simple/Simple.hs new file mode 100644 --- /dev/null +++ b/Test/simple/Simple.hs @@ -0,0 +1,164 @@ +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. + +module Main (main) where + +import Foreign.LibNVVM + +import Control.Monad +import Control.Exception +import Text.Printf +import Test.HUnit hiding (Test) +import Test.Framework.Providers.HUnit (testCase) + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Test.Framework as TF (Test, defaultMain, testGroup) + +main :: IO () +main = TF.defaultMain tests + +tests :: [TF.Test] +tests = + [ TF.testGroup "Positive tests" + [ testCase "compile HelloWorld.ll" + pCompileHelloWorldLL + , testCase "compile HelloWorld.bc" + pCompileHelloWorldBC + , testCase "compile multiple .ll files" + pCompileMultipleLL + , testCase "compile multiple .bc files" + pCompileMultipleBC + , testCase "compile multiple .ll and .bc files" + pCompileMultipleLLBC + ] + , TF.testGroup "Negative tests" + [ testCase "compile HelloWorldWithError.ll" + nCompileHelloWorldWithErrorLL + , testCase "compile multiple .ll files with redefinitions" + nCompileMultipleLL + , testCase "compile multiple .bc files with redefinitions" + nCompileMultipleBC + , testCase "compile multiple .ll and .bc files with redefinitions" + nCompileMultipleLLBC + ] + ] + + +assertRaises + :: (Exception e, Show e, Eq e) + => String + -> e + -> IO a + -> Assertion +assertRaises msg selector action = + let testErr e + | e == selector = return () + | otherwise = assertFailure $ printf "%s\nReceived unexpected exception: %s\nInstead of exception: %s" + msg (show e) (show selector) + in do + r <- try action + case r of + Left e -> testErr e + Right _ -> assertFailure $ printf "%s\nReceived no exception, but was expecting: %s" msg (show selector) + + +-- Compilation actually returns a UserError so that the compilation error +-- message is returned as part of the string. The first line of the error +-- message does contain the Status error string, however, so just compare that. +-- +instance Eq NVVMException where + s == t = head (lines (show s)) == head (lines (show t)) + + +-- Positive tests +-- -------------- + +pCompileHelloWorldLL :: Assertion +pCompileHelloWorldLL = do + ll <- B8.readFile "Test/data/HelloWorld.ll" + void $! compileModule "compileLL" ll [] True + +pCompileHelloWorldBC :: Assertion +pCompileHelloWorldBC = do + bc <- B.readFile "Test/data/HelloWorld.bc" + void $! compileModule "compileBC" bc [] True + +pCompileMultipleLL :: Assertion +pCompileMultipleLL = do + lls <- mapM B8.readFile [ "Test/data/HelloWorld0.ll" + , "Test/data/HelloWorld1.ll" + , "Test/data/HelloWorld2.ll" + , "Test/data/HelloWorld3.ll" + ] + void $! compileModules (zip (repeat "compileMultipleLL") lls) [] True + +pCompileMultipleBC :: Assertion +pCompileMultipleBC = do + bcs <- mapM B.readFile [ "Test/data/HelloWorld0.bc" + , "Test/data/HelloWorld1.bc" + , "Test/data/HelloWorld2.bc" + , "Test/data/HelloWorld3.bc" + ] + void $! compileModules (zip (repeat "compileMultipleBC") bcs) [] True + +pCompileMultipleLLBC :: Assertion +pCompileMultipleLLBC = do + llbcs <- sequence [ B8.readFile "Test/data/HelloWorld0.ll" + , B.readFile "Test/data/HelloWorld1.bc" + , B8.readFile "Test/data/HelloWorld2.ll" + , B.readFile "Test/data/HelloWorld3.bc" + ] + void $! compileModules (zip (repeat "compileMultipleLLBC") llbcs) [] True + +-- Negative tests +-- -------------- + +compilationError :: IO Result -> Assertion +compilationError action = + assertRaises "Compilation Error" (ExitCode Compilation) action + + +nCompileHelloWorldWithErrorLL :: Assertion +nCompileHelloWorldWithErrorLL = do + ll <- B8.readFile "Test/data/HelloWorldWithError.ll" + compilationError $ compileModule "errorLL" ll [] True + +nCompileMultipleLL :: Assertion +nCompileMultipleLL = do + lls <- mapM B8.readFile [ "Test/data/HelloWorld.ll" + , "Test/data/HelloWorld.ll" + ] + compilationError $ compileModules (zip (repeat "errorMultipleLL") lls) [] True + +nCompileMultipleBC :: Assertion +nCompileMultipleBC = do + bcs <- mapM B.readFile [ "Test/data/HelloWorld.bc" + , "Test/data/HelloWorld.bc" + ] + compilationError $ compileModules (zip (repeat "errorMultipleBC") bcs) [] True + +nCompileMultipleLLBC :: Assertion +nCompileMultipleLLBC = do + llbcs <- sequence [ B8.readFile "Test/data/HelloWorld.ll" + , B.readFile "Test/data/HelloWorld.bc" + ] + compilationError $ compileModules (zip (repeat "errorMultipleLLBC") llbcs) [] True + diff --git a/cbits/stubs.h b/cbits/stubs.h new file mode 100644 --- /dev/null +++ b/cbits/stubs.h @@ -0,0 +1,26 @@ +#ifndef C_STUBS_H +#define C_STUBS_H + +/* + * This part of the code is from https://github.com/tmcdonell/cuda, which + * is under BSD3 (https://github.com/tmcdonell/cuda/blob/master/LICENSE). + */ + + +/* + * We need to work around some shortcomings in the C parser of c2hs by disabling advanced attributes etc on Apple platforms. + */ +#ifdef __APPLE__ +#define _ANSI_SOURCE +#define __AVAILABILITY__ +#define __OSX_AVAILABLE_STARTING(_mac, _iphone) +#define __OSX_AVAILABLE_BUT_DEPRECATED(_macIntro, _macDep, _iphoneIntro, _iphoneDep) +#endif + + +/* + * Standard NVVM include. Make sure this comes after the above defines. + */ +#include + +#endif /* C_STUBS_H */ diff --git a/libnvvm.cabal b/libnvvm.cabal new file mode 100644 --- /dev/null +++ b/libnvvm.cabal @@ -0,0 +1,116 @@ +-- Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. + +Name: libnvvm +Version: 1.0.0 +License: MIT +License-file: LICENSE +Copyright: Copyright (c) 2012-2014 NVIDIA Corporation. All rights reserved. +Author: Sean Lee, + Trevor McDonell +Maintainer: Sean Lee +Build-type: Simple +Category: Foreign +Stability: Experimental +Homepage: https://github.com/nvidia-compiler-sdk/hsnvvm +Bug-reports: https://github.com/nvidia-compiler-sdk/hsnvvm/issues +Cabal-version: >= 1.18 +Tested-with: GHC == 7.6.* +Synopsis: FFI binding to libNVVM, a compiler SDK component from NVIDIA +Description: FFI binding to libNVVM, a compiler SDK component from NVIDIA + +Extra-source-files: cbits/stubs.h + +Library + Exposed-modules: Foreign.LibNVVM + Foreign.LibNVVM.Compile + Foreign.LibNVVM.Error + Foreign.LibNVVM.Info + + Other-modules: Foreign.LibNVVM.Internal + + Include-dirs: . + Includes: nvvm.h + Extra-Libraries: nvvm + + if os(darwin) + CC-options: -U__BLOCKS__ + Include-dirs: /usr/local/cuda/nvvm/include + Extra-lib-dirs: /usr/local/cuda/nvvm/lib + + if os(linux) + Include-dirs: /usr/local/cuda/nvvm/include + + if arch(i386) + Extra-lib-dirs: /usr/local/cuda/nvvm/lib + + if arch(x86_64) + Extra-lib-dirs: /usr/local/cuda/nvvm/lib64 + + GHC-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields + + Build-tools: c2hs + Build-depends: base >= 4 && < 5, + bytestring >= 0.9, + cuda >= 0.5 + + Default-language: Haskell2010 + + +Test-suite test-simple + Main-is: Simple.hs + hs-source-dirs: Test/simple + + Build-depends: libnvvm, + base >= 4 && < 5, + bytestring >= 0.9, + test-framework >= 0.2, + test-framework-hunit >= 0.2, + Cabal >= 1.10.1, + HUnit >= 1.2 + + Type: exitcode-stdio-1.0 + GHC-options: -Wall -O2 -fwarn-tabs + Default-language: Haskell2010 + + +-- Disable due to a libNVVM parsing error bug of the DataLayout field +-- +-- Test-suite test-llvmgen +-- Main-is: LLVMGen.hs +-- Other-modules: HelloWorld +-- hs-source-dirs: Test/llvm-gen +-- +-- Build-depends: libnvvm, +-- base >= 4 && < 5, +-- bytestring >= 0.9, +-- containers >= 0.5, +-- cuda >= 0.5, +-- llvm-general == 3.2.*, +-- llvm-general-pure == 3.2.*, +-- mtl >= 2.0 +-- +-- Type: exitcode-stdio-1.0 +-- GHC-options: -Wall -O2 -fwarn-tabs +-- Default-language: Haskell2010 + +Source-repository head + Type: git + Location: https://github.com/nvidia-compiler-sdk/hsnvvm.git