{-# LINE 1 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
module Foreign.CUDA.Runtime.Exec (
Fun, FunAttributes(..), FunParam(..), CacheConfig(..),
attributes, setCacheConfig, launchKernel,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
{-# LINE 25 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
import Foreign.CUDA.Runtime.Stream ( Stream(..), defaultStream )
import Foreign.CUDA.Runtime.Error
import Foreign.CUDA.Internal.C2HS
import Foreign
import Foreign.C
import Control.Monad
import Data.Maybe
type Fun = FunPtr ()
{-# LINE 62 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
data FunAttributes = FunAttributes
{
FunAttributes -> Int64
constSizeBytes :: !Int64,
FunAttributes -> Int64
localSizeBytes :: !Int64,
FunAttributes -> Int64
sharedSizeBytes :: !Int64,
FunAttributes -> Int
maxKernelThreadsPerBlock :: !Int,
FunAttributes -> Int
numRegs :: !Int
}
deriving (Int -> FunAttributes -> ShowS
[FunAttributes] -> ShowS
FunAttributes -> String
(Int -> FunAttributes -> ShowS)
-> (FunAttributes -> String)
-> ([FunAttributes] -> ShowS)
-> Show FunAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunAttributes -> ShowS
showsPrec :: Int -> FunAttributes -> ShowS
$cshow :: FunAttributes -> String
show :: FunAttributes -> String
$cshowList :: [FunAttributes] -> ShowS
showList :: [FunAttributes] -> ShowS
Show)
instance Storable FunAttributes where
sizeOf :: FunAttributes -> Int
sizeOf FunAttributes
_ = Int
56
{-# LINE 75 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
alignment _ = alignment (undefined :: Ptr ())
poke :: Ptr FunAttributes -> FunAttributes -> IO ()
poke Ptr FunAttributes
_ FunAttributes
_ = String -> IO ()
forall a. HasCallStack => String -> a
error String
"Can not poke Foreign.CUDA.Runtime.FunAttributes"
peek :: Ptr FunAttributes -> IO FunAttributes
peek Ptr FunAttributes
p = do
Int64
cs <- CULong -> Int64
forall a b. (Integral a, Integral b) => a -> b
cIntConv (CULong -> Int64) -> IO CULong -> IO Int64
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr FunAttributes
ptr -> do {Ptr FunAttributes -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr FunAttributes
ptr Int
8 :: IO C2HSImp.CULong}) Ptr FunAttributes
p
Int64
ls <- CULong -> Int64
forall a b. (Integral a, Integral b) => a -> b
cIntConv (CULong -> Int64) -> IO CULong -> IO Int64
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr FunAttributes
ptr -> do {Ptr FunAttributes -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr FunAttributes
ptr Int
16 :: IO C2HSImp.CULong}) Ptr FunAttributes
p
Int64
ss <- CULong -> Int64
forall a b. (Integral a, Integral b) => a -> b
cIntConv (CULong -> Int64) -> IO CULong -> IO Int64
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr FunAttributes
ptr -> do {Ptr FunAttributes -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr FunAttributes
ptr Int
0 :: IO C2HSImp.CULong}) Ptr FunAttributes
p
Int
tb <- CInt -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr FunAttributes
ptr -> do {Ptr FunAttributes -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr FunAttributes
ptr Int
24 :: IO C2HSImp.CInt}) Ptr FunAttributes
p
Int
nr <- CInt -> Int
forall a b. (Integral a, Integral b) => a -> b
cIntConv (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr FunAttributes
ptr -> do {Ptr FunAttributes -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr FunAttributes
ptr Int
28 :: IO C2HSImp.CInt}) Ptr FunAttributes
p
FunAttributes -> IO FunAttributes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunAttributes
{
constSizeBytes :: Int64
constSizeBytes = Int64
cs,
localSizeBytes :: Int64
localSizeBytes = Int64
ls,
sharedSizeBytes :: Int64
sharedSizeBytes = Int64
ss,
maxKernelThreadsPerBlock :: Int
maxKernelThreadsPerBlock = Int
tb,
numRegs :: Int
numRegs = Int
nr
}
data CacheConfig = None
| Shared
| L1
| Equal
deriving (CacheConfig -> CacheConfig -> Bool
(CacheConfig -> CacheConfig -> Bool)
-> (CacheConfig -> CacheConfig -> Bool) -> Eq CacheConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheConfig -> CacheConfig -> Bool
== :: CacheConfig -> CacheConfig -> Bool
$c/= :: CacheConfig -> CacheConfig -> Bool
/= :: CacheConfig -> CacheConfig -> Bool
Eq,Int -> CacheConfig -> ShowS
[CacheConfig] -> ShowS
CacheConfig -> String
(Int -> CacheConfig -> ShowS)
-> (CacheConfig -> String)
-> ([CacheConfig] -> ShowS)
-> Show CacheConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheConfig -> ShowS
showsPrec :: Int -> CacheConfig -> ShowS
$cshow :: CacheConfig -> String
show :: CacheConfig -> String
$cshowList :: [CacheConfig] -> ShowS
showList :: [CacheConfig] -> ShowS
Show)
instance Enum CacheConfig where
succ :: CacheConfig -> CacheConfig
succ CacheConfig
None = CacheConfig
Shared
succ CacheConfig
Shared = CacheConfig
L1
succ CacheConfig
L1 = CacheConfig
Equal
succ CacheConfig
Equal = String -> CacheConfig
forall a. HasCallStack => String -> a
error String
"CacheConfig.succ: Equal has no successor"
pred :: CacheConfig -> CacheConfig
pred CacheConfig
Shared = CacheConfig
None
pred CacheConfig
L1 = CacheConfig
Shared
pred CacheConfig
Equal = CacheConfig
L1
pred CacheConfig
None = String -> CacheConfig
forall a. HasCallStack => String -> a
error String
"CacheConfig.pred: None has no predecessor"
enumFromTo :: CacheConfig -> CacheConfig -> [CacheConfig]
enumFromTo CacheConfig
from CacheConfig
to = CacheConfig -> [CacheConfig]
go CacheConfig
from
where
end :: Int
end = CacheConfig -> Int
forall a. Enum a => a -> Int
fromEnum CacheConfig
to
go :: CacheConfig -> [CacheConfig]
go CacheConfig
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CacheConfig -> Int
forall a. Enum a => a -> Int
fromEnum CacheConfig
v) Int
end of
Ordering
LT -> CacheConfig
v CacheConfig -> [CacheConfig] -> [CacheConfig]
forall a. a -> [a] -> [a]
: CacheConfig -> [CacheConfig]
go (CacheConfig -> CacheConfig
forall a. Enum a => a -> a
succ CacheConfig
v)
Ordering
EQ -> [CacheConfig
v]
Ordering
GT -> []
enumFrom from = enumFromTo from Equal
fromEnum :: CacheConfig -> Int
fromEnum CacheConfig
None = Int
0
fromEnum Shared = 1
fromEnum L1 = 2
fromEnum CacheConfig
Equal = Int
3
toEnum 0 = None
toEnum 1 = Shared
toEnum 2 = L1
toEnum 3 = Equal
toEnum unmatched = error ("CacheConfig.toEnum: Cannot match " ++ show unmatched)
{-# LINE 104 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
data FunParam where
IArg :: !Int -> FunParam
FArg :: !Float -> FunParam
DArg :: !Double -> FunParam
VArg :: Storable a => !a -> FunParam
{-# INLINEABLE attributes #-}
attributes :: Fun -> IO FunAttributes
attributes !fn = resultIfOk =<< cudaFuncGetAttributes fn
{-# INLINE cudaFuncGetAttributes #-}
cudaFuncGetAttributes :: (Fun) -> IO ((Status), (FunAttributes))
cudaFuncGetAttributes a2 =
alloca $ \a1' ->
withFun a2 $ \a2' ->
cudaFuncGetAttributes'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peek a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 132 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
{-# INLINEABLE setCacheConfig #-}
setCacheConfig :: Fun -> CacheConfig -> IO ()
setCacheConfig :: Fun -> CacheConfig -> IO ()
setCacheConfig !Fun
fn !CacheConfig
pref = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fun -> CacheConfig -> IO Status
cudaFuncSetCacheConfig Fun
fn CacheConfig
pref
{-# INLINE cudaFuncSetCacheConfig #-}
cudaFuncSetCacheConfig :: (Fun) -> (CacheConfig) -> IO ((Status))
cudaFuncSetCacheConfig :: Fun -> CacheConfig -> IO Status
cudaFuncSetCacheConfig Fun
a1 CacheConfig
a2 =
Fun -> (Ptr () -> IO Status) -> IO Status
forall a b. Fun -> (Ptr a -> IO b) -> IO b
withFun Fun
a1 ((Ptr () -> IO Status) -> IO Status)
-> (Ptr () -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
let {a2' :: CInt
a2' = CacheConfig -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum CacheConfig
a2} in
Ptr () -> CInt -> IO CInt
cudaFuncSetCacheConfig'_ Ptr ()
a1' CInt
a2' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 155 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
{-# INLINEABLE launchKernel #-}
launchKernel
:: Fun
-> (Int,Int)
-> (Int,Int,Int)
-> Int64
-> Maybe Stream
-> [FunParam]
-> IO ()
launchKernel :: Fun
-> (Int, Int)
-> (Int, Int, Int)
-> Int64
-> Maybe Stream
-> [FunParam]
-> IO ()
launchKernel !Fun
fn (!Int
gx,!Int
gy) (!Int
bx,!Int
by,!Int
bz) !Int64
sm !Maybe Stream
mst ![FunParam]
args
= (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) Status -> IO ()
nothingIfOk
(IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$ (FunParam -> (Ptr FunParam -> IO Status) -> IO Status)
-> [FunParam] -> ([Ptr FunParam] -> IO Status) -> IO Status
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany FunParam -> (Ptr FunParam -> IO Status) -> IO Status
forall b. FunParam -> (Ptr FunParam -> IO b) -> IO b
withFP [FunParam]
args
(([Ptr FunParam] -> IO Status) -> IO Status)
-> ([Ptr FunParam] -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \[Ptr FunParam]
pa -> [Ptr FunParam] -> (Ptr (Ptr FunParam) -> IO Status) -> IO Status
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr FunParam]
pa
((Ptr (Ptr FunParam) -> IO Status) -> IO Status)
-> (Ptr (Ptr FunParam) -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr FunParam)
pp -> Fun
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Ptr (Ptr FunParam)
-> Int64
-> Stream
-> IO Status
cudaLaunchKernel_simple Fun
fn Int
gx Int
gy Int
1 Int
bx Int
by Int
bz Ptr (Ptr FunParam)
pp Int64
sm (Stream -> Maybe Stream -> Stream
forall a. a -> Maybe a -> a
fromMaybe Stream
defaultStream Maybe Stream
mst)
where
withFP :: FunParam -> (Ptr FunParam -> IO b) -> IO b
withFP :: forall b. FunParam -> (Ptr FunParam -> IO b) -> IO b
withFP FunParam
p Ptr FunParam -> IO b
f = case FunParam
p of
IArg Int
v -> Int -> (Ptr Int -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with' Int
v (Ptr FunParam -> IO b
f (Ptr FunParam -> IO b)
-> (Ptr Int -> Ptr FunParam) -> Ptr Int -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Int -> Ptr FunParam
forall a b. Ptr a -> Ptr b
castPtr)
FArg Float
v -> Float -> (Ptr Float -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with' Float
v (Ptr FunParam -> IO b
f (Ptr FunParam -> IO b)
-> (Ptr Float -> Ptr FunParam) -> Ptr Float -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Float -> Ptr FunParam
forall a b. Ptr a -> Ptr b
castPtr)
DArg Double
v -> Double -> (Ptr Double -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with' Double
v (Ptr FunParam -> IO b
f (Ptr FunParam -> IO b)
-> (Ptr Double -> Ptr FunParam) -> Ptr Double -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Double -> Ptr FunParam
forall a b. Ptr a -> Ptr b
castPtr)
VArg a
v -> a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with' a
v (Ptr FunParam -> IO b
f (Ptr FunParam -> IO b) -> (Ptr a -> Ptr FunParam) -> Ptr a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr FunParam
forall a b. Ptr a -> Ptr b
castPtr)
with' :: Storable a => a -> (Ptr a -> IO b) -> IO b
with' :: forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with' !a
val !Ptr a -> IO b
f =
Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (a -> Int
forall a. Storable a => a -> Int
sizeOf a
val) ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val
Ptr a -> IO b
f Ptr a
ptr
{-# INLINE cudaLaunchKernel_simple #-}
cudaLaunchKernel_simple :: (Fun) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Int) -> (Ptr (Ptr FunParam)) -> (Int64) -> (Stream) -> IO ((Status))
cudaLaunchKernel_simple :: Fun
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Ptr (Ptr FunParam)
-> Int64
-> Stream
-> IO Status
cudaLaunchKernel_simple Fun
a1 Int
a2 Int
a3 Int
a4 Int
a5 Int
a6 Int
a7 Ptr (Ptr FunParam)
a8 Int64
a9 Stream
a10 =
Fun -> (Ptr () -> IO Status) -> IO Status
forall a b. Fun -> (Ptr a -> IO b) -> IO b
withFun Fun
a1 ((Ptr () -> IO Status) -> IO Status)
-> (Ptr () -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
let {a2' :: CUInt
a2' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in
let {a3' :: CUInt
a3' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a3} in
let {a4' :: CUInt
a4' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a4} in
let {a5' :: CUInt
a5' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a5} in
let {a6' :: CUInt
a6' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a6} in
let {a7' :: CUInt
a7' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a7} in
let {a8' :: Ptr (Ptr ())
a8' = Ptr (Ptr FunParam) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr FunParam)
a8} in
let {a9' :: CULong
a9' = Int64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a9} in
let {a10' :: Ptr ()
a10' = Stream -> Ptr ()
useStream Stream
a10} in
Ptr ()
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> Ptr (Ptr ())
-> CULong
-> Ptr ()
-> IO CInt
cudaLaunchKernel_simple'_ Ptr ()
a1' CUInt
a2' CUInt
a3' CUInt
a4' CUInt
a5' CUInt
a6' CUInt
a7' Ptr (Ptr ())
a8' CULong
a9' Ptr ()
a10' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 201 "src/Foreign/CUDA/Runtime/Exec.chs" #-}
withFun :: Fun -> (Ptr a -> IO b) -> IO b
withFun :: forall a b. Fun -> (Ptr a -> IO b) -> IO b
withFun Fun
fn Ptr a -> IO b
action = Ptr a -> IO b
action (Fun -> Ptr a
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr Fun
fn)
foreign import ccall unsafe "Foreign/CUDA/Runtime/Exec.chs.h cudaFuncGetAttributes"
cudaFuncGetAttributes'_ :: ((C2HSImp.Ptr (FunAttributes)) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Exec.chs.h cudaFuncSetCacheConfig"
cudaFuncSetCacheConfig'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Exec.chs.h cudaLaunchKernel_simple"
cudaLaunchKernel_simple'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))))))))