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


{-# LINE 1 "src/Foreign/CUDA/Driver/IPC/Event.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.IPC.Event
-- Copyright : [2009..2018] Trevor L. McDonell
-- License   : BSD
--
-- IPC event management for low-level driver interface.
--
-- Restricted to devices which support unified addressing on Linux
-- operating systems.
--
-- Since CUDA-4.1.
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.IPC.Event (

  IPCEvent,
  export, open,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





{-# LINE 28 "src/Foreign/CUDA/Driver/IPC/Event.chs" #-}


-- Friends
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Event
import Foreign.CUDA.Internal.C2HS

-- System
import Control.Monad
import Prelude

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Storable


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

-- |
-- A CUDA inter-process event handle.
--
newtype IPCEvent = IPCEvent { IPCEvent -> IPCEventHandle
useIPCEvent :: IPCEventHandle }
  deriving (IPCEvent -> IPCEvent -> Bool
(IPCEvent -> IPCEvent -> Bool)
-> (IPCEvent -> IPCEvent -> Bool) -> Eq IPCEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPCEvent -> IPCEvent -> Bool
$c/= :: IPCEvent -> IPCEvent -> Bool
== :: IPCEvent -> IPCEvent -> Bool
$c== :: IPCEvent -> IPCEvent -> Bool
Eq, Int -> IPCEvent -> ShowS
[IPCEvent] -> ShowS
IPCEvent -> String
(Int -> IPCEvent -> ShowS)
-> (IPCEvent -> String) -> ([IPCEvent] -> ShowS) -> Show IPCEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPCEvent] -> ShowS
$cshowList :: [IPCEvent] -> ShowS
show :: IPCEvent -> String
$cshow :: IPCEvent -> String
showsPrec :: Int -> IPCEvent -> ShowS
$cshowsPrec :: Int -> IPCEvent -> ShowS
Show)


--------------------------------------------------------------------------------
-- IPC event management
--------------------------------------------------------------------------------

-- |
-- Create an inter-process event handle for a previously allocated event.
-- The event must be created with the 'Interprocess' and 'DisableTiming'
-- event flags. The returned handle may then be sent to another process and
-- 'open'ed to allow efficient hardware synchronisation between GPU work in
-- other processes.
--
-- After the event has been opened in the importing process, 'record',
-- 'block', 'wait', 'query' may be used in either process.
--
-- Performing operations on the imported event after the event has been
-- 'destroy'ed in the exporting process is undefined.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gea02eadd12483de5305878b13288a86c>
--
{-# INLINEABLE export #-}
export :: Event -> IO IPCEvent
export :: Event -> IO IPCEvent
export !Event
ev = do
  IPCEventHandle
h <- IO IPCEventHandle
newIPCEventHandle
  Status
r <- IPCEventHandle -> Event -> IO Status
cuIpcGetEventHandle IPCEventHandle
h Event
ev
  (Status, IPCEvent) -> IO IPCEvent
forall a. (Status, a) -> IO a
resultIfOk (Status
r, IPCEventHandle -> IPCEvent
IPCEvent IPCEventHandle
h)

{-# INLINE cuIpcGetEventHandle #-}
cuIpcGetEventHandle :: (IPCEventHandle) -> (Event) -> IO ((Status))
cuIpcGetEventHandle :: IPCEventHandle -> Event -> IO Status
cuIpcGetEventHandle IPCEventHandle
a1 Event
a2 =
  IPCEventHandle -> (Ptr () -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr IPCEventHandle
a1 ((Ptr () -> IO Status) -> IO Status)
-> (Ptr () -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' -> 
  let {a2' :: Ptr ()
a2' = Event -> Ptr ()
useEvent Event
a2} in 
  Ptr () -> Ptr () -> IO CInt
cuIpcGetEventHandle'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 94 "src/Foreign/CUDA/Driver/IPC/Event.chs" #-}



-- |
-- Open an inter-process event handle for use in the current process,
-- returning an event that can be used in the current process and behaving
-- as a locally created event with the 'DisableTiming' flag specified.
--
-- The event must be freed with 'destroy'. Performing operations on the
-- imported event after the exported event has been 'destroy'ed in the
-- exporting process is undefined.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf1d525918b6c643b99ca8c8e42e36c2e>
--
{-# INLINEABLE open #-}
open :: IPCEvent -> IO Event
open :: IPCEvent -> IO Event
open !IPCEvent
ev = (Status, Event) -> IO Event
forall a. (Status, a) -> IO a
resultIfOk ((Status, Event) -> IO Event) -> IO (Status, Event) -> IO Event
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IPCEventHandle -> IO (Status, Event)
cuIpcOpenEventHandle (IPCEvent -> IPCEventHandle
useIPCEvent IPCEvent
ev)

{-# INLINE cuIpcOpenEventHandle #-}
cuIpcOpenEventHandle :: (IPCEventHandle) -> IO ((Status), (Event))
cuIpcOpenEventHandle :: IPCEventHandle -> IO (Status, Event)
cuIpcOpenEventHandle IPCEventHandle
a2 =
  (Ptr (Ptr ()) -> IO (Status, Event)) -> IO (Status, Event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Status, Event)) -> IO (Status, Event))
-> (Ptr (Ptr ()) -> IO (Status, Event)) -> IO (Status, Event)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' -> 
  IPCEventHandle
-> (Ptr () -> IO (Status, Event)) -> IO (Status, Event)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr IPCEventHandle
a2 ((Ptr () -> IO (Status, Event)) -> IO (Status, Event))
-> (Ptr () -> IO (Status, Event)) -> IO (Status, Event)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a2' -> 
  Ptr (Ptr ()) -> Ptr () -> IO CInt
cuIpcOpenEventHandle'_ Ptr (Ptr ())
a1' Ptr ()
a2' IO CInt -> (CInt -> IO (Status, Event)) -> IO (Status, Event)
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 (Ptr ()) -> IO Event
peekEvent  Ptr (Ptr ())
a1'IO Event -> (Event -> IO (Status, Event)) -> IO (Status, Event)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Event
a1'' -> 
  (Status, Event) -> IO (Status, Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Event
a1'')

{-# LINE 122 "src/Foreign/CUDA/Driver/IPC/Event.chs" #-}

  where
    peekEvent = liftM Event . peek


--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

type IPCEventHandle = ForeignPtr ()

newIPCEventHandle :: IO IPCEventHandle
newIPCEventHandle :: IO IPCEventHandle
newIPCEventHandle = Int -> IO IPCEventHandle
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
64
{-# LINE 139 "src/Foreign/CUDA/Driver/IPC/Event.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Event.chs.h cuIpcGetEventHandle"
  cuIpcGetEventHandle'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Event.chs.h cuIpcOpenEventHandle"
  cuIpcOpenEventHandle'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))