{-# LINE 1 "./Foreign/NVVM/Compile.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Foreign.NVVM.Compile (
Program,
Result(..),
CompileOption(..),
compileModule, compileModules,
create,
destroy,
addModule, addModuleFromPtr,
compile,
verify
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign.CUDA.Analysis
import Foreign.NVVM.Error
import Foreign.NVVM.Internal.C2HS
import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Control.Exception
import Data.Word
import Data.ByteString ( ByteString )
import Text.Printf
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Internal as B
{-# LINE 49 "./Foreign/NVVM/Compile.chs" #-}
newtype Program = Program { useProgram :: ((C2HSImp.Ptr ())) }
deriving ( Eq, Show )
data Result = Result
{ compileResult :: !ByteString
, compileLog :: !ByteString
}
data CompileOption
= OptimisationLevel !Int
| Target !Compute
| FlushToZero
| NoFMA
| FastSqrt
| FastDiv
| GenerateDebugInfo
deriving ( Eq, Show )
{-# INLINEABLE compileModule #-}
compileModule
:: String
-> ByteString
-> [CompileOption]
-> IO Result
compileModule !name !bs !opts =
compileModules [(name,bs)] opts
{-# INLINEABLE compileModules #-}
compileModules
:: [(String, ByteString)]
-> [CompileOption]
-> IO Result
compileModules !bss !opts =
bracket create destroy $ \prg -> do
mapM_ (uncurry (addModule prg)) bss
(messages, result) <- compile prg opts
case result of
Nothing -> nvvmErrorIO (B.unpack messages)
Just ptx -> return $ Result ptx messages
{-# INLINEABLE create #-}
create :: IO Program
create = resultIfOk =<< nvvmCreateProgram
where
peekProgram ptr = Program `fmap` peek ptr
nvvmCreateProgram :: IO ((Status), (Program))
nvvmCreateProgram =
alloca $ \a1' ->
nvvmCreateProgram'_ a1' >>= \res ->
let {res' = cToEnum res} in
peekProgram a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 120 "./Foreign/NVVM/Compile.chs" #-}
{-# INLINEABLE destroy #-}
destroy :: Program -> IO ()
destroy !prg = nothingIfOk =<< nvvmDestroyProgram prg
where
withProgram p = with (useProgram p)
nvvmDestroyProgram :: (Program) -> IO ((Status))
nvvmDestroyProgram a1 =
withProgram a1 $ \a1' ->
nvvmDestroyProgram'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 137 "./Foreign/NVVM/Compile.chs" #-}
{-# INLINEABLE addModule #-}
addModule
:: Program
-> String
-> ByteString
-> IO ()
addModule !prg !name !bs =
B.unsafeUseAsCStringLen bs $ \(ptr,len) ->
addModuleFromPtr prg name len (castPtr ptr)
{-# INLINEABLE addModuleFromPtr #-}
addModuleFromPtr
:: Program
-> String
-> Int
-> Ptr Word8
-> IO ()
addModuleFromPtr !prg !name !size !buffer =
nothingIfOk =<< nvvmAddModuleToProgram prg buffer size name
where
nvvmAddModuleToProgram :: (Program) -> (Ptr Word8) -> (Int) -> (String) -> IO ((Status))
nvvmAddModuleToProgram a1 a2 a3 a4 =
let {a1' = useProgram a1} in
let {a2' = castPtr a2} in
let {a3' = cIntConv a3} in
withCString a4 $ \a4' ->
nvvmAddModuleToProgram'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 176 "./Foreign/NVVM/Compile.chs" #-}
{-# INLINEABLE compile #-}
compile :: Program -> [CompileOption] -> IO (ByteString, Maybe ByteString)
compile !prg !opts = do
status <- withCompileOptions opts (nvvmCompileProgram prg)
messages <- retrieve (nvvmGetProgramLogSize prg) (nvvmGetProgramLog prg)
case status of
Success -> do ptx <- retrieve (nvvmGetCompiledResultSize prg) (nvvmGetCompiledResult prg)
return (messages, Just ptx)
_ -> return (messages, Nothing)
where
nvvmCompileProgram :: (Program) -> (Int) -> (Ptr CString) -> IO ((Status))
nvvmCompileProgram a1 a2 a3 =
let {a1' = useProgram a1} in
let {a2' = cIntConv a2} in
let {a3' = id a3} in
nvvmCompileProgram'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 200 "./Foreign/NVVM/Compile.chs" #-}
nvvmGetCompiledResultSize :: (Program) -> IO ((Status), (Int))
nvvmGetCompiledResultSize a1 =
let {a1' = useProgram a1} in
alloca $ \a2' ->
nvvmGetCompiledResultSize'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekIntConv a2'>>= \a2'' ->
return (res', a2'')
{-# LINE 207 "./Foreign/NVVM/Compile.chs" #-}
nvvmGetCompiledResult :: (Program) -> (ForeignPtr Word8) -> IO ((Status))
nvvmGetCompiledResult a1 a2 =
let {a1' = useProgram a1} in
withForeignPtr' a2 $ \a2' ->
nvvmGetCompiledResult'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 214 "./Foreign/NVVM/Compile.chs" #-}
{-# INLINEABLE verify #-}
verify :: Program -> [CompileOption] -> IO (Status, ByteString)
verify !prg !opts = do
status <- withCompileOptions opts (nvvmVerifyProgram prg)
messages <- retrieve (nvvmGetProgramLogSize prg) (nvvmGetProgramLog prg)
return (status, messages)
where
nvvmVerifyProgram :: (Program) -> (Int) -> (Ptr CString) -> IO ((Status))
nvvmVerifyProgram a1 a2 a3 =
let {a1' = useProgram a1} in
let {a2' = cIntConv a2} in
let {a3' = id a3} in
nvvmVerifyProgram'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 234 "./Foreign/NVVM/Compile.chs" #-}
nvvmGetProgramLogSize :: (Program) -> IO ((Status), (Int))
nvvmGetProgramLogSize a1 =
let {a1' = useProgram a1} in
alloca $ \a2' ->
nvvmGetProgramLogSize'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekIntConv a2'>>= \a2'' ->
return (res', a2'')
{-# LINE 242 "./Foreign/NVVM/Compile.chs" #-}
nvvmGetProgramLog :: (Program) -> (ForeignPtr Word8) -> IO ((Status))
nvvmGetProgramLog a1 a2 =
let {a1' = useProgram a1} in
withForeignPtr' a2 $ \a2' ->
nvvmGetProgramLog'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 249 "./Foreign/NVVM/Compile.chs" #-}
{-# INLINEABLE withForeignPtr' #-}
withForeignPtr' :: ForeignPtr Word8 -> (Ptr CChar -> IO a) -> IO a
withForeignPtr' fp f = withForeignPtr fp (f . castPtr)
{-# INLINEABLE withCompileOptions #-}
withCompileOptions :: [CompileOption] -> (Int -> Ptr CString -> IO a) -> IO a
withCompileOptions opts next =
withMany withCString (map toStr opts) $ \cs -> withArrayLen cs next
where
toStr :: CompileOption -> String
toStr (OptimisationLevel n) = printf "-opt=%d" n
toStr (Target (Compute n m)) = printf "-arch=compute_%d%d" n m
toStr FlushToZero = "-ftz=1"
toStr NoFMA = "-fma=0"
toStr FastSqrt = "-prec-sqrt=0"
toStr FastDiv = "-prec-div=0"
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
then return B.empty
else do fp <- mallocForeignPtrBytes bytes
_ <- nothingIfOk =<< payload fp
return (B.fromForeignPtr fp 0 bytes)
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmCreateProgram"
nvvmCreateProgram'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmDestroyProgram"
nvvmDestroyProgram'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmAddModuleToProgram"
nvvmAddModuleToProgram'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmCompileProgram"
nvvmCompileProgram'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetCompiledResultSize"
nvvmGetCompiledResultSize'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetCompiledResult"
nvvmGetCompiledResult'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmVerifyProgram"
nvvmVerifyProgram'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetProgramLogSize"
nvvmGetProgramLogSize'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/NVVM/Compile.chs.h nvvmGetProgramLog"
nvvmGetProgramLog'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))