module System.OpenCL.Raw.V10.MemoryObject
(clCreateBuffer
,clCreateImage2D
,clCreateImage3D
,clRetainMemObject
,clReleaseMemObject
,clGetSupportedImageFormats
,clGetMemObjectInfo
,clGetImageInfo
,clEnqueueReadBuffer
,clEnqueueWriteBuffer
,clEnqueueCopyBuffer
,clEnqueueReadImage
,clEnqueueWriteImage
,clEnqueueCopyImage
,clEnqueueCopyImageToBuffer
,clEnqueueCopyBufferToImage
,clEnqueueMapBuffer
,clEnqueueMapImage
,clEnqueueUnmapMemObject)
where
import System.OpenCL.Raw.V10.Types
import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Control.Applicative
import Data.Maybe
import Data.Bits
foreign import ccall "clCreateBuffer" raw_clCreateBuffer :: Context -> CLbitfield -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem
clCreateBuffer :: Context -> MemFlags -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)
clCreateBuffer ctx (MemFlags flags) size host_ptr = wrapErrorEither $ raw_clCreateBuffer ctx flags size host_ptr
foreign import ccall "clCreateImage2D" raw_clCreateImage2D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem
clCreateImage2D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)
clCreateImage2D ctx (MemFlags memflags) (ChannelOrder corder, ChannelType ctype) image_width image_height image_row_pitch host_ptr = allocaArray 2 $ \image_format -> do
pokeArray image_format [corder,ctype]
wrapErrorEither $ raw_clCreateImage2D ctx memflags image_format image_width image_height image_row_pitch host_ptr
foreign import ccall "clCreateImage3D" raw_clCreateImage3D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem
clCreateImage3D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)
clCreateImage3D ctx (MemFlags memflags) (ChannelOrder corder, ChannelType ctype) image_width image_height image_depth image_row_pitch image_slice_pitch host_ptr = allocaArray 2 $ \image_format -> do
pokeArray image_format [corder,ctype]
wrapErrorEither $ raw_clCreateImage3D ctx memflags image_format image_width image_height image_depth image_row_pitch image_slice_pitch host_ptr
foreign import ccall "clRetainMemObject" raw_clRetainMemObject :: Mem -> IO CLint
clRetainMemObject :: Mem -> IO (Maybe ErrorCode)
clRetainMemObject mem = wrapError $ raw_clRetainMemObject mem
foreign import ccall "clReleaseMemObject" raw_clReleaseMemObject :: Mem -> IO CLint
clReleaseMemObject :: Mem -> IO (Maybe ErrorCode)
clReleaseMemObject mem = wrapError $ raw_clReleaseMemObject mem
foreign import ccall "clGetSupportedImageFormats" raw_clGetSupportedImageFormats :: Context -> CLbitfield -> CLuint -> CLuint -> Ptr CLuint -> Ptr CLuint -> IO CLint
clGetSupportedImageFormats :: Context -> MemFlags -> MemObjectType -> IO (Either ErrorCode [ImageFormat])
clGetSupportedImageFormats ctx (MemFlags flags) (MemObjectType image_type) = allocaArray 512 $ \image_formats -> alloca $ \num_image_formats -> do
err <- wrapError $ raw_clGetSupportedImageFormats ctx flags image_type 512 image_formats num_image_formats
maybe (do num_image_formatsN <- peek num_image_formats
image_formatsN <- peekArray (fromIntegral num_image_formatsN*2) image_formats
let sift (a:b:cs) = (ChannelOrder a,ChannelType b) : sift cs
sift [] = []
return . Right $ sift image_formatsN )
(return . Left)
err
foreign import ccall "clGetMemObjectInfo" raw_clGetMemObjectInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
clGetMemObjectInfo :: Mem -> MemInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
clGetMemObjectInfo mem (MemInfo param_name) param_value_size = wrapGetInfo (raw_clGetMemObjectInfo mem param_name) param_value_size
foreign import ccall "clGetImageInfo" raw_clGetImageInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
clGetImageInfo :: Mem -> MemInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
clGetImageInfo mem (MemInfo param_name) param_value_size = wrapGetInfo (raw_clGetImageInfo mem param_name) param_value_size
enqueue :: (CommandQueue -> CLuint -> Ptr Event -> Ptr Event -> IO CLint) -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
enqueue fn queue events = alloca $ \event -> allocaArray events_in_wait_list $ \event_wait_list -> do
pokeArray event_wait_list events
err <- wrapError $ fn queue (fromIntegral events_in_wait_list) event_wait_list event
if err == Nothing
then Right <$> peek event
else return (Left . fromJust $ err)
where events_in_wait_list = length events
foreign import ccall "clEnqueueReadBuffer" raw_clEnqueueReadBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueReadBuffer buffer blocking_read offset cb ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueReadBuffer
command_queue
buffer
(if blocking_read then clTrue else clFalse)
offset
cb
ptr
num_events_in_wait_list
event_wait_list
event)
foreign import ccall "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueWriteBuffer buffer blocking_write offset cb ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueWriteBuffer command_queue buffer (if blocking_write then clTrue else clFalse) offset cb ptr num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueCopyBuffer" raw_clEnqueueCopyBuffer :: CommandQueue -> Mem -> Mem -> CLsizei -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueCopyBuffer src_buffer dst_buffer src_offset dst_offset cb =
enqueue (\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueCopyBuffer command_queue src_buffer dst_buffer src_offset dst_offset cb num_events_in_wait_list event_wait_list event)
type ImageDims = (CLsizei,CLsizei,CLsizei)
foreign import ccall "clEnqueueReadImage" raw_clEnqueueReadImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueReadImage image blocking_read (oa,ob,oc) (ra,rb,rc) row_pitch slice_pitch ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
pokeArray origin [oa,ob,oc]
raw_clEnqueueReadImage command_queue image (if blocking_read then clTrue else clFalse) origin region row_pitch slice_pitch ptr num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueWriteImage" raw_clEnqueueWriteImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueWriteImage image blocking_read (oa,ob,oc) (ra,rb,rc) row_pitch slice_pitch ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
pokeArray origin [oa,ob,oc]
raw_clEnqueueWriteImage command_queue image (if blocking_read then clTrue else clFalse) origin region row_pitch slice_pitch ptr num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueCopyImage" raw_clEnqueueCopyImage :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueCopyImage :: Mem -> Mem -> ImageDims -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
clEnqueueCopyImage src_image dst_image (soa,sob,soc) (doa,dob,doc) (ra,rb,rc) =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \src_origin -> allocaArray 3 $ \dst_origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
pokeArray src_origin [soa,sob,soc]
pokeArray dst_origin [doa,dob,doc]
raw_clEnqueueCopyImage command_queue src_image dst_image src_origin dst_origin region num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueCopyImageToBuffer" raw_clEnqueueCopyImageToBuffer :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueCopyImageToBuffer :: Mem -> Mem -> ImageDims -> ImageDims -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
clEnqueueCopyImageToBuffer src_image dst_buffer (soa,sob,soc) (ra,rb,rc) dst_offset =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \src_origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
pokeArray src_origin [soa,sob,soc]
raw_clEnqueueCopyImageToBuffer
command_queue
src_image
dst_buffer
src_origin
region
dst_offset
num_events_in_wait_list
event_wait_list
event)
foreign import ccall "clEnqueueCopyBufferToImage" raw_clEnqueueCopyBufferToImage :: CommandQueue -> Mem -> Mem -> CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueCopyBufferToImage :: Mem -> Mem -> CLsizei -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
clEnqueueCopyBufferToImage src_buffer dst_image src_offset (soa,sob,soc) (ra,rb,rc) =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \dst_origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
pokeArray dst_origin [soa,sob,soc]
raw_clEnqueueCopyBufferToImage
command_queue
src_buffer
dst_image
src_offset
dst_origin
region
num_events_in_wait_list
event_wait_list
event)
foreign import ccall "clEnqueueMapBuffer" raw_clEnqueueMapBuffer :: CommandQueue -> Mem -> CLbool -> CLbitfield -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> Ptr CLint -> IO (Ptr ())
clEnqueueMapBuffer :: Mem -> Bool -> MapFlags -> CLsizei -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode (Ptr (),Event))
clEnqueueMapBuffer buffer blocking_map (MapFlags map_flags) offset cb command_queue events =
allocaArray num_events_in_wait_list $ \event_wait_list -> alloca $ \event -> do
ret <- wrapErrorEither $ raw_clEnqueueMapBuffer
command_queue
buffer
(if blocking_map then clTrue else clFalse)
map_flags
offset
cb
(fromIntegral num_events_in_wait_list)
event_wait_list
event
case ret of
Left err -> return (Left err)
Right ptr -> peek event >>= \event -> return $ Right (ptr,event)
where num_events_in_wait_list = length events
foreign import ccall "clEnqueueMapImage" raw_clEnqueueMapImage :: CommandQueue -> Mem -> CLbool -> CLbitfield -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> Ptr CLint -> IO (Ptr ())
clEnqueueMapImage :: Mem -> Bool -> MapFlags -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode (Ptr (),CLsizei,CLsizei,Event))
clEnqueueMapImage buffer blocking_map (MapFlags map_flags) (oa,ob,oc) (ra,rb,rc) command_queue events =
allocaArray num_events_in_wait_list $ \event_wait_list ->
alloca $ \event ->
allocaArray 3 $ \region ->
allocaArray 3 $ \origin ->
alloca $ \image_row_pitch ->
alloca $ \image_slice_pitch -> do
pokeArray origin [oa,ob,oc]
pokeArray region [ra,rb,rc]
ret <- wrapErrorEither $ raw_clEnqueueMapImage
command_queue
buffer
(if blocking_map then clTrue else clFalse)
map_flags
origin
region
image_row_pitch
image_slice_pitch
(fromIntegral num_events_in_wait_list)
event_wait_list
event
case ret of
Left err -> return (Left err)
Right ptr -> do
event' <- peek event
image_row_pitch' <- peek image_row_pitch
image_slice_pitch' <- peek image_slice_pitch
return $ Right (ptr,image_row_pitch',image_slice_pitch', event')
where num_events_in_wait_list = length events
foreign import ccall "clEnqueueUnmapMemObject" raw_clEnqueueUnmapMemObject :: CommandQueue -> Mem -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
clEnqueueUnmapMemObject mem mapped_ptr = enqueue
(\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueUnmapMemObject command_queue mem mapped_ptr num_events_in_wait_list event_wait_list event)