module Foreign.OpenCL.Bindings.Event (
createUserEvent, waitForEvents,
eventCommandQueue, eventContext, eventCommandType,
setEventCompleteCallback, setUserEventStatus
) where
import Control.Monad
import Foreign
import Foreign.C.Types
import Foreign.OpenCL.Bindings.Internal.Types
import Foreign.OpenCL.Bindings.Internal.Finalizers
import Foreign.OpenCL.Bindings.Internal.Error
import Foreign.OpenCL.Bindings.Internal.Util
createUserEvent :: Context
-> IO Event
createUserEvent context =
withForeignPtr context $ \ctx ->
alloca $ \ep -> do
event <- clCreateUserEvent ctx ep
checkClError_ "clCreateUserEvent" =<< peek ep
attachFinalizer event
getEventInfo event info =
withForeignPtr event $ \event_ptr ->
getInfo (clGetEventInfo_ event_ptr) info
eventCommandQueue :: Event -> IO CommandQueue
eventCommandQueue ev =
getEventInfo ev EventCommandQueue >>= attachRetainFinalizer
eventContext :: Event -> IO Context
eventContext ev =
getEventInfo ev EventContext >>= attachRetainFinalizer
eventCommandType :: Event -> IO CommandType
eventCommandType ev = liftM toEnum $ getEventInfo ev EventCommandType
setEventCompleteCallback :: Storable a => Event -> a -> (CommandExecStatus -> a -> IO ()) -> IO ()
setEventCompleteCallback event user_data callbackfn =
withForeignPtr event $ \event_ptr ->
with user_data $ \user_data_ptr -> do
let ud_ptr = castPtr user_data_ptr :: Ptr ()
cb_ptr <- wrapCallback callback
err <- clSetEventCallback event_ptr (fromIntegral $ fromEnum Complete) cb_ptr ud_ptr
checkClError_ "clSetEventCallback" err
where
callback :: Ptr CEvent -> CInt -> Ptr () -> IO ()
callback _ status user_data_ptr = do
udata <- peek (castPtr user_data_ptr)
callbackfn (toEnum $ fromIntegral status) udata
setUserEventStatus :: Event -> Int -> IO ()
setUserEventStatus event execution_status =
withForeignPtr event $ \event_ptr -> do
err <- clSetUserEventStatus event_ptr (fromIntegral execution_status)
checkClError_ "clSetUserEventStatus" err
foreign import CALLCONV "wrapper" wrapCallback ::
(Ptr CEvent -> CInt -> Ptr () -> IO ())
-> IO (FunPtr (Ptr CEvent -> CInt -> Ptr () -> IO ()))
waitForEvents :: [Event] -> IO ()
waitForEvents events =
withForeignPtrs events $ \event_ptrs ->
withArrayLen event_ptrs $ \n event_array -> do
checkClError_ "clWaitForEvents" =<<
clWaitForEvents (fromIntegral n) event_array
clGetEventInfo_ =
checkClError5 "clGetEventInfo" clGetEventInfo
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clCreateUserEvent"
clCreateUserEvent :: ((Ptr (CContext)) -> ((Ptr CInt) -> (IO (Ptr (CEvent)))))
foreign import ccall safe "Foreign/OpenCL/Bindings/Event.chs.h clSetEventCallback"
clSetEventCallback :: ((Ptr (CEvent)) -> (CInt -> ((FunPtr ((Ptr (CEvent)) -> (CInt -> ((Ptr ()) -> (IO ()))))) -> ((Ptr ()) -> (IO CInt)))))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clSetUserEventStatus"
clSetUserEventStatus :: ((Ptr (CEvent)) -> (CInt -> (IO CInt)))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clWaitForEvents"
clWaitForEvents :: (CUInt -> ((Ptr (Ptr (CEvent))) -> (IO CInt)))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Event.chs.h clGetEventInfo"
clGetEventInfo :: ((Ptr (CEvent)) -> (CUInt -> (CULong -> ((Ptr ()) -> ((Ptr CULong) -> (IO CInt))))))