Source

cl-patches / fixes

Full commit
# HG changeset patch
# Parent 15813df45d4bfbfda27e676fe410239f3bda4b37

diff -r 15813df45d4b System/OpenCL/Raw/V10/Context.hs
--- a/System/OpenCL/Raw/V10/Context.hs	Sun Jan 02 23:46:31 2011 +0300
+++ b/System/OpenCL/Raw/V10/Context.hs	Mon Jan 03 14:56:35 2011 +0300
@@ -32,7 +32,8 @@
         pokeArray0 nullPtr propertiesP properties
         pokeArray devicesP devices
         fptr <- wrapCreateContextCallback pfn_notify
-        wrapErrorEither $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat             
+        -- FIX
+        wrapErrorEither $ raw_clCreateContext nullPtr {- propertiesP -} (fromIntegral devicesN) devicesP fptr user_dat             
     where propertiesN = length properties
           devicesN = length devices
           
diff -r 15813df45d4b System/OpenCL/Raw/V10/Kernel.hs
--- a/System/OpenCL/Raw/V10/Kernel.hs	Sun Jan 02 23:46:31 2011 +0300
+++ b/System/OpenCL/Raw/V10/Kernel.hs	Mon Jan 03 14:56:35 2011 +0300
@@ -3,6 +3,7 @@
 module System.OpenCL.Raw.V10.Kernel 
     (clCreateKernel
     ,clCreateKernelsInProgram
+    ,clSetKernelArg
     ,clRetainKernel
     ,clReleaseKernel
     ,clGetKernelInfo
@@ -22,7 +23,8 @@
 
 
 foreign import ccall "clCreateKernel" raw_clCreateKernel :: Program -> CString -> Ptr CLint -> IO Kernel 
-clCreateKernel program kernel_name = wrapErrorEither $ raw_clCreateKernel program kernel_name 
+clCreateKernel :: Program -> String -> IO (Either ErrorCode Kernel)
+clCreateKernel program kernel_name = withCString kernel_name $ \kname -> wrapErrorEither $ raw_clCreateKernel program kname 
 
 foreign import ccall "clCreateKernelsInProgram" raw_clCreateKernelsInProgram :: Program -> CLuint -> Ptr Kernel -> Ptr CLuint -> IO CLint 
 clCreateKernelsInProgram :: Program -> CLuint -> IO (Either ErrorCode [Kernel])
@@ -76,14 +78,19 @@
 foreign import ccall "clEnqueueTask" raw_clEnqueueTask :: CommandQueue -> Kernel -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
 clEnqueueTask :: CommandQueue -> Kernel -> [Event] -> IO (Either ErrorCode Event)
 clEnqueueTask queue kernel event_wait_listL = 
-    allocaArray num_events_in_wait_list $ \event_wait_list ->
-    alloca $ \event -> do
-        pokeArray event_wait_list event_wait_listL
-        err <- wrapError $ raw_clEnqueueTask queue kernel (fromIntegral num_events_in_wait_list) event_wait_list event 
-        if err == Nothing
-            then Right <$> peek event
-            else return $ Left . fromJust $ err
-    where num_events_in_wait_list = length event_wait_listL
+    if num_events_in_wait_list /= 0 then
+        allocaArray num_events_in_wait_list $ \p -> pokeArray p event_wait_listL >> f p
+      else
+        f nullPtr
+ where
+    f = \event_wait_list ->
+        alloca $ \event -> do
+            pokeArray event_wait_list event_wait_listL
+            err <- wrapError $ raw_clEnqueueTask queue kernel (fromIntegral num_events_in_wait_list) event_wait_list event 
+            if err == Nothing
+                then Right <$> peek event
+                else return $ Left . fromJust $ err
+    num_events_in_wait_list = length event_wait_listL
 
 type NKCallbackFunction = Ptr () -> IO ()
 foreign import ccall "wrapper" wrapNativeKernelCallback :: NKCallbackFunction -> IO (FunPtr NKCallbackFunction)