-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Runtime/Device.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards          #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE EmptyCase                #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Runtime.Device
-- Copyright : [2009..2023] Trevor L. McDonell
-- License   : BSD
--
-- Device management routines
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Runtime.Device (

  -- * Device Management
  Device, DeviceFlag(..), DeviceProperties(..), Compute(..), ComputeMode(..),
  choose, get, count, props, set, setFlags, setOrder, reset, sync,

  -- * Peer Access
  PeerFlag,
  accessible, add, remove,

  -- * Cache Configuration
  Limit(..),
  getLimit, setLimit

) 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 38 "src/Foreign/CUDA/Runtime/Device.chs" #-}


-- Friends
import Foreign.CUDA.Analysis.Device
import Foreign.CUDA.Runtime.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Control.Applicative
import Foreign
import Foreign.C
import Prelude

--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- A device identifier
--
type Device = Int


{-# LINE 76 "src/Foreign/CUDA/Runtime/Device.chs" #-}


-- |
-- Device execution flags
--
data DeviceFlag = ScheduleAuto
                | ScheduleSpin
                | ScheduleYield
                | BlockingSync
                | MapHost
                | LMemResizeToMax
  deriving (DeviceFlag -> DeviceFlag -> Bool
(DeviceFlag -> DeviceFlag -> Bool)
-> (DeviceFlag -> DeviceFlag -> Bool) -> Eq DeviceFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeviceFlag -> DeviceFlag -> Bool
== :: DeviceFlag -> DeviceFlag -> Bool
$c/= :: DeviceFlag -> DeviceFlag -> Bool
/= :: DeviceFlag -> DeviceFlag -> Bool
Eq,Int -> DeviceFlag -> ShowS
[DeviceFlag] -> ShowS
DeviceFlag -> String
(Int -> DeviceFlag -> ShowS)
-> (DeviceFlag -> String)
-> ([DeviceFlag] -> ShowS)
-> Show DeviceFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeviceFlag -> ShowS
showsPrec :: Int -> DeviceFlag -> ShowS
$cshow :: DeviceFlag -> String
show :: DeviceFlag -> String
$cshowList :: [DeviceFlag] -> ShowS
showList :: [DeviceFlag] -> ShowS
Show,DeviceFlag
DeviceFlag -> DeviceFlag -> Bounded DeviceFlag
forall a. a -> a -> Bounded a
$cminBound :: DeviceFlag
minBound :: DeviceFlag
$cmaxBound :: DeviceFlag
maxBound :: DeviceFlag
Bounded)
instance Enum DeviceFlag where
  succ ScheduleAuto = ScheduleSpin
  succ ScheduleSpin = ScheduleYield
  succ ScheduleYield = BlockingSync
  succ BlockingSync = MapHost
  succ MapHost = LMemResizeToMax
  succ LMemResizeToMax = error "DeviceFlag.succ: LMemResizeToMax has no successor"

  pred ScheduleSpin = ScheduleAuto
  pred ScheduleYield = ScheduleSpin
  pred BlockingSync = ScheduleYield
  pred MapHost = BlockingSync
  pred LMemResizeToMax = MapHost
  pred ScheduleAuto = error "DeviceFlag.pred: ScheduleAuto has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from LMemResizeToMax

  fromEnum ScheduleAuto = 0
  fromEnum ScheduleSpin = 1
  fromEnum ScheduleYield = 2
  fromEnum BlockingSync = 4
  fromEnum MapHost = 8
  fromEnum LMemResizeToMax = 16

  toEnum 0 = ScheduleAuto
  toEnum 1 = ScheduleSpin
  toEnum 2 = ScheduleYield
  toEnum 4 = BlockingSync
  toEnum 8 = MapHost
  toEnum 16 = LMemResizeToMax
  toEnum unmatched = error ("DeviceFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 82 "src/Foreign/CUDA/Runtime/Device.chs" #-}



instance Storable DeviceProperties where
  sizeOf _    = 728
{-# LINE 86 "src/Foreign/CUDA/Runtime/Device.chs" #-}

  alignment _ = alignment (undefined :: Ptr ())

  poke _ _    = error "no instance for Foreign.Storable.poke DeviceProperties"
  peek p      = do
    deviceName                    <- peekCString =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
    computeCapability             <- Compute <$> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 360 :: IO C2HSImp.CInt}) p)
                                             <*> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 364 :: IO C2HSImp.CInt}) p)
    totalGlobalMem                <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 288 :: IO C2HSImp.CULong}) p
    sharedMemPerBlock             <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 296 :: IO C2HSImp.CULong}) p
    regsPerBlock                  <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 304 :: IO C2HSImp.CInt}) p
    warpSize                      <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 308 :: IO C2HSImp.CInt}) p
    memPitch                      <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 312 :: IO C2HSImp.CULong}) p
    maxThreadsPerBlock            <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 320 :: IO C2HSImp.CInt}) p
    clockRate                     <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 348 :: IO C2HSImp.CInt}) p
    totalConstMem                 <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 352 :: IO C2HSImp.CULong}) p
    textureAlignment              <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 368 :: IO C2HSImp.CULong}) p
    deviceOverlap                 <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 384 :: IO C2HSImp.CInt}) p
    multiProcessorCount           <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 388 :: IO C2HSImp.CInt}) p
    kernelExecTimeoutEnabled      <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 392 :: IO C2HSImp.CInt}) p
    integrated                    <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 396 :: IO C2HSImp.CInt}) p
    canMapHostMemory              <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 400 :: IO C2HSImp.CInt}) p
    computeMode                   <- cToEnum  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 404 :: IO C2HSImp.CInt}) p
    concurrentKernels             <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 576 :: IO C2HSImp.CInt}) p
    maxTextureDim1D               <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 408 :: IO C2HSImp.CInt}) p
    eccEnabled                    <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 580 :: IO C2HSImp.CInt}) p
    asyncEngineCount              <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 600 :: IO C2HSImp.CInt}) p
    cacheMemL2                    <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 616 :: IO C2HSImp.CInt}) p
    maxThreadsPerMultiProcessor   <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 624 :: IO C2HSImp.CInt}) p
    memBusWidth                   <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 612 :: IO C2HSImp.CInt}) p
    memClockRate                  <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 608 :: IO C2HSImp.CInt}) p
    pciInfo                       <- PCI <$> (cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 584 :: IO C2HSImp.CInt}) p)
                                         <*> (cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 588 :: IO C2HSImp.CInt}) p)
                                         <*> (cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 592 :: IO C2HSImp.CInt}) p)
    tccDriverEnabled              <- cToBool <$> (\ptr -> do {C2HSImp.peekByteOff ptr 596 :: IO C2HSImp.CInt}) p
    unifiedAddressing             <- cToBool <$> (\ptr -> do {C2HSImp.peekByteOff ptr 604 :: IO C2HSImp.CInt}) p
    [t1,t2,t3]                    <- peekArrayWith cIntConv 3 =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 324 :: IO (C2HSImp.Ptr C2HSImp.CInt)}) p
    [g1,g2,g3]                    <- peekArrayWith cIntConv 3 =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 336 :: IO (C2HSImp.Ptr C2HSImp.CInt)}) p
    let maxBlockSize = (t1,t2,t3)
        maxGridSize  = (g1,g2,g3)
    [u21,u22]                     <- peekArrayWith cIntConv 2 =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 420 :: IO (C2HSImp.Ptr C2HSImp.CInt)}) p
    [u31,u32,u33]                 <- peekArrayWith cIntConv 3 =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 456 :: IO (C2HSImp.Ptr C2HSImp.CInt)}) p
    let maxTextureDim2D = (u21,u22)
        maxTextureDim3D = (u31,u32,u33)
    streamPriorities              <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 628 :: IO C2HSImp.CInt}) p
    globalL1Cache                 <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 632 :: IO C2HSImp.CInt}) p
    localL1Cache                  <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 636 :: IO C2HSImp.CInt}) p
    managedMemory                 <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 652 :: IO C2HSImp.CInt}) p
    multiGPUBoard                 <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 656 :: IO C2HSImp.CInt}) p
    multiGPUBoardGroupID          <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 660 :: IO C2HSImp.CInt}) p
    preemption                    <- cToBool  <$> (\ptr -> do {C2HSImp.peekByteOff ptr 680 :: IO C2HSImp.CInt}) p
    singleToDoublePerfRatio       <- cIntConv <$> (\ptr -> do {C2HSImp.peekByteOff ptr 668 :: IO C2HSImp.CInt}) p
    cooperativeLaunch             <- cToBool <$> (\ptr -> do {C2HSImp.peekByteOff ptr 688 :: IO C2HSImp.CInt}) p
    cooperativeLaunchMultiDevice  <- cToBool <$> (\ptr -> do {C2HSImp.peekByteOff ptr 692 :: IO C2HSImp.CInt}) p

    return DeviceProperties{..}


--------------------------------------------------------------------------------
-- Device Management
--------------------------------------------------------------------------------

-- |
-- Select the compute device which best matches the given criteria
--
{-# INLINEABLE choose #-}
choose :: DeviceProperties -> IO Device
choose :: DeviceProperties -> IO Int
choose !DeviceProperties
dev = (Status, Int) -> IO Int
forall a. (Status, a) -> IO a
resultIfOk ((Status, Int) -> IO Int) -> IO (Status, Int) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DeviceProperties -> IO (Status, Int)
cudaChooseDevice DeviceProperties
dev

{-# INLINE cudaChooseDevice #-}
cudaChooseDevice :: (DeviceProperties) -> IO ((Status), (Int))
cudaChooseDevice :: DeviceProperties -> IO (Status, Int)
cudaChooseDevice DeviceProperties
a2 =
  (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  DeviceProperties
-> (Ptr DeviceProperties -> IO (Status, Int)) -> IO (Status, Int)
forall {b}.
DeviceProperties -> (Ptr DeviceProperties -> IO b) -> IO b
withDevProp DeviceProperties
a2 ((Ptr DeviceProperties -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr DeviceProperties -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr DeviceProperties
a2' -> 
  Ptr CInt -> Ptr DeviceProperties -> IO CInt
cudaChooseDevice'_ Ptr CInt
a1' Ptr DeviceProperties
a2' IO CInt -> (CInt -> IO (Status, Int)) -> IO (Status, Int)
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
  Ptr CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CInt
a1'IO Int -> (Int -> IO (Status, Int)) -> IO (Status, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' -> 
  (Status, Int) -> IO (Status, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'')

{-# LINE 183 "src/Foreign/CUDA/Runtime/Device.chs" #-}

  where
      withDevProp :: DeviceProperties -> (Ptr DeviceProperties -> IO b) -> IO b
withDevProp = DeviceProperties -> (Ptr DeviceProperties -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with


-- |
-- Returns which device is currently being used
--
{-# INLINEABLE get #-}
get :: IO Device
get :: IO Int
get = (Status, Int) -> IO Int
forall a. (Status, a) -> IO a
resultIfOk ((Status, Int) -> IO Int) -> IO (Status, Int) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Status, Int)
cudaGetDevice

{-# INLINE cudaGetDevice #-}
cudaGetDevice :: IO ((Status), (Int))
cudaGetDevice :: IO (Status, Int)
cudaGetDevice =
  (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  Ptr CInt -> IO CInt
cudaGetDevice'_ Ptr CInt
a1' IO CInt -> (CInt -> IO (Status, Int)) -> IO (Status, Int)
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
  Ptr CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CInt
a1'IO Int -> (Int -> IO (Status, Int)) -> IO (Status, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' -> 
  (Status, Int) -> IO (Status, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'')

{-# LINE 197 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Returns the number of devices available for execution, with compute
-- capability >= 1.0
--
{-# INLINEABLE count #-}
count :: IO Int
count :: IO Int
count = (Status, Int) -> IO Int
forall a. (Status, a) -> IO a
resultIfOk ((Status, Int) -> IO Int) -> IO (Status, Int) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Status, Int)
cudaGetDeviceCount

{-# INLINE cudaGetDeviceCount #-}
cudaGetDeviceCount :: IO ((Status), (Int))
cudaGetDeviceCount :: IO (Status, Int)
cudaGetDeviceCount =
  (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  Ptr CInt -> IO CInt
cudaGetDeviceCount'_ Ptr CInt
a1' IO CInt -> (CInt -> IO (Status, Int)) -> IO (Status, Int)
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
  Ptr CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CInt
a1'IO Int -> (Int -> IO (Status, Int)) -> IO (Status, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' -> 
  (Status, Int) -> IO (Status, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'')

{-# LINE 210 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Return information about the selected compute device
--
{-# INLINEABLE props #-}
props :: Device -> IO DeviceProperties
props :: Int -> IO DeviceProperties
props !Int
n = (Status, DeviceProperties) -> IO DeviceProperties
forall a. (Status, a) -> IO a
resultIfOk ((Status, DeviceProperties) -> IO DeviceProperties)
-> IO (Status, DeviceProperties) -> IO DeviceProperties
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (Status, DeviceProperties)
cudaGetDeviceProperties Int
n

{-# INLINE cudaGetDeviceProperties #-}
cudaGetDeviceProperties :: (Int) -> IO ((Status), (DeviceProperties))
cudaGetDeviceProperties :: Int -> IO (Status, DeviceProperties)
cudaGetDeviceProperties Int
a2 =
  (Ptr DeviceProperties -> IO (Status, DeviceProperties))
-> IO (Status, DeviceProperties)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr DeviceProperties -> IO (Status, DeviceProperties))
 -> IO (Status, DeviceProperties))
-> (Ptr DeviceProperties -> IO (Status, DeviceProperties))
-> IO (Status, DeviceProperties)
forall a b. (a -> b) -> a -> b
$ \Ptr DeviceProperties
a1' -> 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  Ptr DeviceProperties -> CInt -> IO CInt
cudaGetDeviceProperties'_ Ptr DeviceProperties
a1' CInt
a2' IO CInt
-> (CInt -> IO (Status, DeviceProperties))
-> IO (Status, DeviceProperties)
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
  Ptr DeviceProperties -> IO DeviceProperties
forall a. Storable a => Ptr a -> IO a
peek  Ptr DeviceProperties
a1'IO DeviceProperties
-> (DeviceProperties -> IO (Status, DeviceProperties))
-> IO (Status, DeviceProperties)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DeviceProperties
a1'' -> 
  (Status, DeviceProperties) -> IO (Status, DeviceProperties)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', DeviceProperties
a1'')

{-# LINE 223 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Set device to be used for GPU execution
--
{-# INLINEABLE set #-}
set :: Device -> IO ()
set :: Int -> IO ()
set !Int
n = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Status
cudaSetDevice Int
n

{-# INLINE cudaSetDevice #-}
cudaSetDevice :: (Int) -> IO ((Status))
cudaSetDevice :: Int -> IO Status
cudaSetDevice Int
a1 =
  let {a1' :: CInt
a1' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a1} in 
  CInt -> IO CInt
cudaSetDevice'_ CInt
a1' 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 235 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Set flags to be used for device executions
--
{-# INLINEABLE setFlags #-}
setFlags :: [DeviceFlag] -> IO ()
setFlags :: [DeviceFlag] -> IO ()
setFlags ![DeviceFlag]
f = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Status
cudaSetDeviceFlags ([DeviceFlag] -> Int
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [DeviceFlag]
f)

{-# INLINE cudaSetDeviceFlags #-}
cudaSetDeviceFlags :: (Int) -> IO ((Status))
cudaSetDeviceFlags :: Int -> IO Status
cudaSetDeviceFlags Int
a1 =
  let {a1' :: CUInt
a1' = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a1} in 
  CUInt -> IO CInt
cudaSetDeviceFlags'_ CUInt
a1' 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 247 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Set list of devices for CUDA execution in priority order
--
{-# INLINEABLE setOrder #-}
setOrder :: [Device] -> IO ()
setOrder :: [Int] -> IO ()
setOrder ![Int]
l = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Int] -> Int -> IO Status
cudaSetValidDevices [Int]
l ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
l)

{-# INLINE cudaSetValidDevices #-}
cudaSetValidDevices :: ([Int]) -> (Int) -> IO ((Status))
cudaSetValidDevices :: [Int] -> Int -> IO Status
cudaSetValidDevices [Int]
a1 Int
a2 =
  [Int] -> (Ptr CInt -> IO Status) -> IO Status
forall {b}. [Int] -> (Ptr CInt -> IO b) -> IO b
withArrayIntConv [Int]
a1 ((Ptr CInt -> IO Status) -> IO Status)
-> (Ptr CInt -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  Ptr CInt -> CInt -> IO CInt
cudaSetValidDevices'_ Ptr CInt
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 260 "src/Foreign/CUDA/Runtime/Device.chs" #-}

  where
      withArrayIntConv = withArray . map cIntConv

-- |
-- Block until the device has completed all preceding requested tasks. Returns
-- an error if one of the tasks fails.
--
{-# INLINEABLE sync #-}
sync :: IO ()
{-# INLINE cudaDeviceSynchronize #-}
sync :: IO ()
sync = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Status
cudaDeviceSynchronize
cudaDeviceSynchronize :: IO ((Status))
cudaDeviceSynchronize :: IO Status
cudaDeviceSynchronize =
  IO CInt
cudaDeviceSynchronize'_ 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 278 "src/Foreign/CUDA/Runtime/Device.chs" #-}


-- |
-- Explicitly destroys and cleans up all runtime resources associated with the
-- current device in the current process. Any subsequent API call will
-- reinitialise the device.
--
-- Note that this function will reset the device immediately. It is the caller’s
-- responsibility to ensure that the device is not being accessed by any other
-- host threads from the process when this function is called.
--
{-# INLINEABLE reset #-}
reset :: IO ()
{-# INLINE cudaDeviceReset #-}
reset :: IO ()
reset = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Status
cudaDeviceReset
cudaDeviceReset :: IO ((Status))
cudaDeviceReset :: IO Status
cudaDeviceReset =
  IO CInt
cudaDeviceReset'_ 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 299 "src/Foreign/CUDA/Runtime/Device.chs" #-}



--------------------------------------------------------------------------------
-- Peer Access
--------------------------------------------------------------------------------

-- |
-- Possible option values for direct peer memory access
--
data PeerFlag
instance Enum PeerFlag where
  toEnum :: Int -> PeerFlag
toEnum   Int
x = String -> PeerFlag
forall a. HasCallStack => String -> a
error (String
"PeerFlag.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x)
  fromEnum :: PeerFlag -> Int
fromEnum PeerFlag
x = case PeerFlag
x of {}

-- |
-- Queries if the first device can directly access the memory of the second. If
-- direct access is possible, it can then be enabled with 'add'. Requires
-- cuda-4.0.
--
{-# INLINEABLE accessible #-}
accessible :: Device -> Device -> IO Bool
accessible :: Int -> Int -> IO Bool
accessible !Int
dev !Int
peer = (Status, Bool) -> IO Bool
forall a. (Status, a) -> IO a
resultIfOk ((Status, Bool) -> IO Bool) -> IO (Status, Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Int -> IO (Status, Bool)
cudaDeviceCanAccessPeer Int
dev Int
peer

{-# INLINE cudaDeviceCanAccessPeer #-}
cudaDeviceCanAccessPeer :: (Device) -> (Device) -> IO ((Status), (Bool))
cudaDeviceCanAccessPeer :: Int -> Int -> IO (Status, Bool)
cudaDeviceCanAccessPeer Int
a2 Int
a3 =
  (Ptr CInt -> IO (Status, Bool)) -> IO (Status, Bool)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Bool)) -> IO (Status, Bool))
-> (Ptr CInt -> IO (Status, Bool)) -> IO (Status, Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a2} in 
  let {a3' :: CInt
a3' = Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a3} in 
  Ptr CInt -> CInt -> CInt -> IO CInt
cudaDeviceCanAccessPeer'_ Ptr CInt
a1' CInt
a2' CInt
a3' IO CInt -> (CInt -> IO (Status, Bool)) -> IO (Status, Bool)
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
  Ptr CInt -> IO Bool
forall a. (Integral a, Storable a) => Ptr a -> IO Bool
peekBool  Ptr CInt
a1'IO Bool -> (Bool -> IO (Status, Bool)) -> IO (Status, Bool)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
a1'' -> 
  (Status, Bool) -> IO (Status, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Bool
a1'')

{-# LINE 333 "src/Foreign/CUDA/Runtime/Device.chs" #-}


-- |
-- If the devices of both the current and supplied contexts support unified
-- addressing, then enable allocations in the supplied context to be accessible
-- by the current context. Requires cuda-4.0.
--
{-# INLINEABLE add #-}
add :: Device -> [PeerFlag] -> IO ()
add :: Int -> [PeerFlag] -> IO ()
add !Int
dev ![PeerFlag]
flags = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> [PeerFlag] -> IO Status
cudaDeviceEnablePeerAccess Int
dev [PeerFlag]
flags

{-# INLINE cudaDeviceEnablePeerAccess #-}
cudaDeviceEnablePeerAccess :: (Device) -> ([PeerFlag]) -> IO ((Status))
cudaDeviceEnablePeerAccess :: Int -> [PeerFlag] -> IO Status
cudaDeviceEnablePeerAccess Int
a1 [PeerFlag]
a2 =
  let {a1' :: CInt
a1' = Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a1} in 
  let {a2' :: CUInt
a2' = [PeerFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [PeerFlag]
a2} in 
  CInt -> CUInt -> IO CInt
cudaDeviceEnablePeerAccess'_ CInt
a1' CUInt
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 351 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Disable direct memory access from the current context to the supplied
-- context. Requires cuda-4.0.
--
{-# INLINEABLE remove #-}
remove :: Device -> IO ()
remove :: Int -> IO ()
remove !Int
dev = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Status
cudaDeviceDisablePeerAccess Int
dev

{-# INLINE cudaDeviceDisablePeerAccess #-}
cudaDeviceDisablePeerAccess :: (Device) -> IO ((Status))
cudaDeviceDisablePeerAccess :: Int -> IO Status
cudaDeviceDisablePeerAccess Int
a1 =
  let {a1' :: CInt
a1' = Int -> CInt
forall a b. (Integral a, Integral b) => a -> b
cIntConv Int
a1} in 
  CInt -> IO CInt
cudaDeviceDisablePeerAccess'_ CInt
a1' 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 368 "src/Foreign/CUDA/Runtime/Device.chs" #-}



--------------------------------------------------------------------------------
-- Cache Configuration
--------------------------------------------------------------------------------

-- |
-- Device limit flags
--
data Limit = Stacksize
           | Printffifosize
           | Mallocheapsize
           | Devruntimesyncdepth
           | Devruntimependinglaunchcount
           | Maxl2fetchgranularity
           | Persistingl2cachesize
  deriving (Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
/= :: Limit -> Limit -> Bool
Eq,Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
(Int -> Limit -> ShowS)
-> (Limit -> String) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Limit -> ShowS
showsPrec :: Int -> Limit -> ShowS
$cshow :: Limit -> String
show :: Limit -> String
$cshowList :: [Limit] -> ShowS
showList :: [Limit] -> ShowS
Show)
instance Enum Limit where
  succ Stacksize = Printffifosize
  succ Printffifosize = Mallocheapsize
  succ Mallocheapsize = Devruntimesyncdepth
  succ Devruntimesyncdepth = Devruntimependinglaunchcount
  succ Devruntimependinglaunchcount = Maxl2fetchgranularity
  succ Maxl2fetchgranularity = Persistingl2cachesize
  succ Persistingl2cachesize = error "Limit.succ: Persistingl2cachesize has no successor"

  pred Printffifosize = Stacksize
  pred Mallocheapsize = Printffifosize
  pred Devruntimesyncdepth = Mallocheapsize
  pred Devruntimependinglaunchcount = Devruntimesyncdepth
  pred Maxl2fetchgranularity = Devruntimependinglaunchcount
  pred Persistingl2cachesize = Maxl2fetchgranularity
  pred Stacksize = error "Limit.pred: Stacksize has no predecessor"

  enumFromTo :: Limit -> Limit -> [Limit]
enumFromTo Limit
from Limit
to = Limit -> [Limit]
forall {t}. Enum t => t -> [t]
go Limit
from
    where
      end :: Int
end = Limit -> Int
forall a. Enum a => a -> Int
fromEnum Limit
to
      go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 Ordering
EQ -> [t
v]
                 Ordering
GT -> []

  enumFrom from = enumFromTo from Persistingl2cachesize

  fromEnum :: Limit -> Int
fromEnum Limit
Stacksize = Int
0
  fromEnum Printffifosize = 1
  fromEnum Mallocheapsize = 2
  fromEnum Devruntimesyncdepth = 3
  fromEnum Limit
Devruntimependinglaunchcount = Int
4
  fromEnum Maxl2fetchgranularity = 5
  fromEnum Limit
Persistingl2cachesize = Int
6

  toEnum 0 = Stacksize
  toEnum 1 = Printffifosize
  toEnum 2 = Mallocheapsize
  toEnum 3 = Devruntimesyncdepth
  toEnum 4 = Devruntimependinglaunchcount
  toEnum 5 = Maxl2fetchgranularity
  toEnum 6 = Persistingl2cachesize
  toEnum unmatched = error ("Limit.toEnum: Cannot match " ++ show unmatched)

{-# LINE 384 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Query compute 2.0 call stack limits. Requires cuda-3.1.
--
{-# INLINEABLE getLimit #-}
getLimit :: Limit -> IO Int
getLimit !l = resultIfOk =<< cudaDeviceGetLimit l

{-# INLINE cudaDeviceGetLimit #-}
cudaDeviceGetLimit :: (Limit) -> IO ((Status), (Int))
cudaDeviceGetLimit a2 =
  alloca $ \a1' -> 
  let {a2' = cFromEnum a2} in 
  cudaDeviceGetLimit'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekIntConv  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 408 "src/Foreign/CUDA/Runtime/Device.chs" #-}



-- |
-- Set compute 2.0 call stack limits. Requires cuda-3.1.
--
{-# INLINEABLE setLimit #-}
setLimit :: Limit -> Int -> IO ()
setLimit !l !n = nothingIfOk =<< cudaDeviceSetLimit l n

{-# INLINE cudaDeviceSetLimit #-}
cudaDeviceSetLimit :: (Limit) -> (Int) -> IO ((Status))
cudaDeviceSetLimit a1 a2 =
  let {a1' = cFromEnum a1} in 
  let {a2' = cIntConv a2} in 
  cudaDeviceSetLimit'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 432 "src/Foreign/CUDA/Runtime/Device.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaChooseDevice"
  cudaChooseDevice'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (DeviceProperties)) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaGetDevice"
  cudaGetDevice'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaGetDeviceCount"
  cudaGetDeviceCount'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaGetDeviceProperties"
  cudaGetDeviceProperties'_ :: ((C2HSImp.Ptr (DeviceProperties)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaSetDevice"
  cudaSetDevice'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaSetDeviceFlags"
  cudaSetDeviceFlags'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaSetValidDevices"
  cudaSetValidDevices'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceSynchronize"
  cudaDeviceSynchronize'_ :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceReset"
  cudaDeviceReset'_ :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceCanAccessPeer"
  cudaDeviceCanAccessPeer'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceEnablePeerAccess"
  cudaDeviceEnablePeerAccess'_ :: (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceDisablePeerAccess"
  cudaDeviceDisablePeerAccess'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceGetLimit"
  cudaDeviceGetLimit'_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Device.chs.h cudaDeviceSetLimit"
  cudaDeviceSetLimit'_ :: (C2HSImp.CInt -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))