Permalink
Browse files

Merge pull request #5 from dagit/exceptions

Exception Improvements and other changes
  • Loading branch information...
2 parents 801388f + 363cbc2 commit 107f02ad98170b23b34e40f82416f3ef26648772 @jeffersonheard committed Sep 8, 2011
View
@@ -0,0 +1 @@
+*.swp
View
@@ -6,7 +6,6 @@ license: BSD3
license-file: LICENSE
copyright: Renaissance Computing Institute
maintainer: J.R. Heard
-build-depends: base < 5, bytestring -any, mtl -any
stability: Experimental
homepage: http://vis.renci.org/jeff/opencl
package-url:
@@ -31,41 +30,43 @@ data-files:
data-dir: ""
extra-source-files:
extra-tmp-files:
-exposed-modules: System.OpenCL.Raw.V10.CommandQueue
- System.OpenCL.Raw.V10.Context
- System.OpenCL.Raw.V10.DeviceInfo
- System.OpenCL.Raw.V10.Errors
- System.OpenCL.Raw.V10.Etc
- System.OpenCL.Raw.V10.EventObject
- System.OpenCL.Raw.V10.FlushFinish
- System.OpenCL.Raw.V10.Kernel
- System.OpenCL.Raw.V10.MemoryObject
- System.OpenCL.Raw.V10.OutOfOrder
- System.OpenCL.Raw.V10.PlatformInfo
- System.OpenCL.Raw.V10.ProgramObject
- System.OpenCL.Raw.V10.Sampler
- System.OpenCL.Raw.V10.Types
- System.OpenCL.Raw.V10
-exposed: True
-buildable: True
-build-tools:
-cpp-options:
-cc-options:
-ld-options:
-pkgconfig-depends:
-frameworks:
-c-sources:
-extensions:
-extra-libraries:
-extra-lib-dirs:
-includes:
-install-includes:
-include-dirs:
-hs-source-dirs: .
-other-modules: System.OpenCL.Raw.V10.Utils
-ghc-prof-options:
-ghc-shared-options:
-ghc-options:
-hugs-options:
-nhc98-options:
-jhc-options:
+library
+ build-depends: base < 5, bytestring -any, mtl -any
+ exposed-modules: System.OpenCL.Raw.V10.CommandQueue
+ System.OpenCL.Raw.V10.Context
+ System.OpenCL.Raw.V10.DeviceInfo
+ System.OpenCL.Raw.V10.Errors
+ System.OpenCL.Raw.V10.Etc
+ System.OpenCL.Raw.V10.EventObject
+ System.OpenCL.Raw.V10.FlushFinish
+ System.OpenCL.Raw.V10.Kernel
+ System.OpenCL.Raw.V10.MemoryObject
+ System.OpenCL.Raw.V10.OutOfOrder
+ System.OpenCL.Raw.V10.PlatformInfo
+ System.OpenCL.Raw.V10.ProgramObject
+ System.OpenCL.Raw.V10.Sampler
+ System.OpenCL.Raw.V10.Types
+ System.OpenCL.Raw.V10
+ exposed: True
+ buildable: True
+ build-tools:
+ cpp-options:
+ cc-options:
+ ld-options:
+ pkgconfig-depends:
+ frameworks:
+ c-sources:
+ extensions:
+ extra-libraries:
+ extra-lib-dirs:
+ includes:
+ install-includes:
+ include-dirs:
+ hs-source-dirs: .
+ other-modules: System.OpenCL.Raw.V10.Utils
+ ghc-prof-options:
+ ghc-shared-options:
+ ghc-options: -Wall
+ hugs-options:
+ nhc98-options:
+ jhc-options:
@@ -5,6 +5,7 @@
module System.OpenCL.Raw.V10.CommandQueue
(clCreateCommandQueue
,clRetainCommandQueue
+ ,clReleaseCommandQueue
,clGetCommandQueueInfo
,clSetCommandQueueProperty)
where
@@ -14,33 +15,30 @@ import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Control.Applicative
-import Data.Bits
-import Data.Maybe
+import Control.Exception ( throw )
foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue :: Context -> DeviceID -> CLbitfield -> Ptr CLint -> IO CommandQueue
-clCreateCommandQueue :: Context -> DeviceID -> CommandQueueProperties -> IO (Either ErrorCode CommandQueue)
+clCreateCommandQueue :: Context -> DeviceID -> CommandQueueProperties -> IO CommandQueue
clCreateCommandQueue ctx devid (CommandQueueProperties properties) =
- wrapErrorEither $ raw_clCreateCommandQueue ctx devid properties
+ wrapErrorPtr $ raw_clCreateCommandQueue ctx devid properties
foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue :: CommandQueue -> IO CLint
-clRetainCommandQueue :: CommandQueue -> IO (Maybe ErrorCode)
+clRetainCommandQueue :: CommandQueue -> IO ()
clRetainCommandQueue queue = wrapError (raw_clRetainCommandQueue queue)
foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue :: CommandQueue -> IO CLint
-clReleaseCommandQueue :: CommandQueue -> IO (Maybe ErrorCode)
+clReleaseCommandQueue :: CommandQueue -> IO ()
clReleaseCommandQueue queue = wrapError (raw_clReleaseCommandQueue queue)
foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: CommandQueue -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetCommandQueueInfo :: CommandQueue -> CommandQueueInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetCommandQueueInfo :: CommandQueue -> CommandQueueInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetCommandQueueInfo ctx (CommandQueueInfo param_name) param_size = wrapGetInfo (raw_clGetCommandQueueInfo ctx param_name) param_size
foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: CommandQueue -> CLbitfield -> CLbool -> Ptr CLbitfield -> IO CLint
-clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO (Either ErrorCode CommandQueueProperties)
+clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO CommandQueueProperties
clSetCommandQueueProperty queue (CommandQueueProperties properties) enable = alloca $ \old_properties -> do
err <- ErrorCode <$> raw_clSetCommandQueueProperty queue properties (if enable then clTrue else clFalse) old_properties
if err == clSuccess
- then Right . CommandQueueProperties <$> peek old_properties
- else return . Left $ err
-
-
+ then CommandQueueProperties <$> peek old_properties
+ else throw err
@@ -13,49 +13,45 @@ module System.OpenCL.Raw.V10.Context
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Foreign.C
-import Control.Applicative
-import Data.Bits
-import Data.Maybe
type ContextCallback = (CString -> Ptr () -> CLsizei -> Ptr () -> IO ())
foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr (Ptr CLint) -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context
foreign import ccall "wrapper" wrapCreateContextCallback :: ContextCallback -> IO (FunPtr ContextCallback)
-clCreateContext :: [ContextProperties] -> [DeviceID] -> ContextCallback -> Ptr () -> IO (Either ErrorCode Context)
+clCreateContext :: [ContextProperties] -> [DeviceID] -> ContextCallback -> Ptr () -> IO Context
clCreateContext properties devices pfn_notify user_dat =
allocaArray (propertiesN+1) $ \propertiesP -> allocaArray devicesN $ \devicesP -> do
pokeArray0 nullPtr propertiesP properties
pokeArray devicesP devices
fptr <- wrapCreateContextCallback pfn_notify
- wrapErrorEither $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat
+ wrapErrorPtr $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat
where propertiesN = length properties
devicesN = length devices
foreign import ccall "clCreateContextFromType" raw_clCreateContextFromType :: Ptr ContextProperties -> CLbitfield -> FunPtr ContextCallback -> Ptr a -> Ptr CLint -> IO Context
-clCreateContextFromType :: [ContextProperties] -> DeviceType -> ContextCallback -> Ptr () -> IO (Either ErrorCode Context)
+clCreateContextFromType :: [ContextProperties] -> DeviceType -> ContextCallback -> Ptr () -> IO Context
clCreateContextFromType properties (DeviceType device_type) pfn_notify user_data = allocaArray (propertiesN+1) $ \propertiesP -> do
pokeArray0 nullPtr propertiesP properties
fptr <- wrapCreateContextCallback pfn_notify
- wrapErrorEither $ raw_clCreateContextFromType propertiesP device_type fptr user_data
+ wrapErrorPtr $ raw_clCreateContextFromType propertiesP device_type fptr user_data
where propertiesN = length properties
foreign import ccall "clRetainContext" raw_clRetainContext :: Context -> IO CLint
-clRetainContext :: Context -> IO (Maybe ErrorCode)
+clRetainContext :: Context -> IO ()
clRetainContext ctx = wrapError (raw_clRetainContext ctx)
foreign import ccall "clReleaseContext" raw_clReleaseContext :: Context -> IO CLint
-clReleaseContext :: Context -> IO (Maybe ErrorCode)
+clReleaseContext :: Context -> IO ()
clReleaseContext ctx = wrapError (raw_clReleaseContext ctx)
foreign import ccall "clGetContextInfo" raw_clGetContextInfo :: Context -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetContextInfo :: Context -> ContextInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetContextInfo :: Context -> ContextInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetContextInfo ctx (ContextInfo param_name) param_size = wrapGetInfo (raw_clGetContextInfo ctx param_name) param_size
@@ -10,19 +10,17 @@ import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Control.Applicative
-import Data.Bits
+import Control.Exception ( throw )
foreign import ccall "clGetDeviceIDs" raw_clGetDeviceIDs :: PlatformID -> CLbitfield -> CLuint -> Ptr DeviceID -> Ptr CLuint -> IO CLint
-clGetDeviceIDs :: PlatformID -> DeviceType -> CLuint -> IO (Either ErrorCode [DeviceID])
-clGetDeviceIDs platform (DeviceType device_type) num_entries = alloca $ \(devices::Ptr DeviceID) -> alloca $ \(num_devices::Ptr CLuint) -> do
+clGetDeviceIDs :: PlatformID -> DeviceType -> CLuint -> IO [DeviceID]
+clGetDeviceIDs platform (DeviceType device_type) num_entries = alloca $ \devices -> alloca $ \num_devices -> do
errcode <- ErrorCode <$> raw_clGetDeviceIDs platform device_type num_entries devices num_devices
if errcode == clSuccess
- then Right <$> (peek num_devices >>= \num_devicesN -> peekArray (fromIntegral num_devicesN) devices)
- else return $ Left errcode
-
+ then peek num_devices >>= \num_devicesN -> peekArray (fromIntegral num_devicesN) devices
+ else throw errcode
+
foreign import ccall "clGetDeviceInfo" raw_clGetDeviceInfo :: DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetDeviceInfo :: DeviceID -> DeviceInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetDeviceInfo :: DeviceID -> DeviceInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetDeviceInfo obj (DeviceInfo param_name) param_size = wrapGetInfo (raw_clGetDeviceInfo obj param_name) param_size
-
-
@@ -116,26 +116,26 @@ clInvalidWorkDimension = ErrorCode (-53)
clInvalidWorkGroupSize :: ErrorCode
clInvalidWorkGroupSize = ErrorCode (-54)
-clInvalidWorkItemSize :: ErrorCode
+clInvalidWorkItemSize :: ErrorCode
clInvalidWorkItemSize = ErrorCode (-55)
-clInvalidGlobalOffset :: ErrorCode
+clInvalidGlobalOffset :: ErrorCode
clInvalidGlobalOffset = ErrorCode (-56)
-clInvalidEventWaitList :: ErrorCode
+clInvalidEventWaitList :: ErrorCode
clInvalidEventWaitList = ErrorCode (-57)
-clInvalidEvent :: ErrorCode
+clInvalidEvent :: ErrorCode
clInvalidEvent = ErrorCode (-58)
-clInvalidOperation :: ErrorCode
+clInvalidOperation :: ErrorCode
clInvalidOperation = ErrorCode (-59)
-clInvalidGLObject :: ErrorCode
+clInvalidGLObject :: ErrorCode
clInvalidGLObject = ErrorCode (-60)
-clInvalidBufferSize :: ErrorCode
+clInvalidBufferSize, clInvalidMipLevel :: ErrorCode
clInvalidBufferSize = ErrorCode (-61)
clInvalidMipLevel = ErrorCode (-62)
@@ -4,12 +4,8 @@ module System.OpenCL.Raw.V10.Etc
(clGetExtensionFunctionAddress)
where
-import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
-import System.OpenCL.Raw.V10.Utils
import Foreign
import Foreign.C
-import Control.Applicative
foreign import ccall "clGetExtensionFunctionAddress" raw_clGetExtensionFunctionAddress :: CString -> IO (Ptr ())
clGetExtensionFunctionAddress :: String -> IO (Ptr ())
@@ -9,30 +9,27 @@ module System.OpenCL.Raw.V10.EventObject
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
-import System.OpenCL.Raw.V10.Utils
import System.OpenCL.Raw.V10.Utils
import Foreign
-import Control.Applicative
foreign import ccall "clWaitForEvents" raw_clWaitForEvents :: CLuint -> Ptr Event -> IO CLint
-clWaitForEvents :: [Event] -> IO (Maybe ErrorCode)
+clWaitForEvents :: [Event] -> IO ()
clWaitForEvents evts = allocaArray nEvents $ \eventP -> pokeArray eventP evts >> (wrapError $ raw_clWaitForEvents (fromIntegral nEvents) eventP)
where nEvents = length evts
foreign import ccall "clGetEventInfo" raw_clGetEventInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetEventInfo :: Event -> EventInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetEventInfo :: Event -> EventInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetEventInfo obj (EventInfo param_name) param_size = wrapGetInfo (raw_clGetEventInfo obj param_name) param_size
foreign import ccall "clRetainEvent" raw_clRetainEvent :: Event -> IO CLint
-clRetainEvent :: Event -> IO (Maybe ErrorCode)
+clRetainEvent :: Event -> IO ()
clRetainEvent evt = wrapError $ raw_clRetainEvent evt
foreign import ccall "clReleaseEvent" raw_clReleaseEvent :: Event -> IO CLint
-clReleaseEvent :: Event -> IO (Maybe ErrorCode)
+clReleaseEvent :: Event -> IO ()
clReleaseEvent evt = wrapError $ raw_clReleaseEvent evt
foreign import ccall "clGetEventProfilingInfo" raw_clGetEventProfilingInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetEventProfilingInfo :: Event -> ProfilingInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetEventProfilingInfo :: Event -> ProfilingInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetEventProfilingInfo obj (ProfilingInfo param_name) param_size = wrapGetInfo (raw_clGetEventProfilingInfo obj param_name) param_size
@@ -6,16 +6,13 @@ module System.OpenCL.Raw.V10.FlushFinish
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
-import Foreign
-import Control.Applicative
foreign import ccall "clFlush" raw_clFlush :: CommandQueue -> IO CLint
-clFlush :: CommandQueue -> IO (Maybe ErrorCode)
+clFlush :: CommandQueue -> IO ()
clFlush queue = wrapError $ raw_clFlush queue
foreign import ccall "clFinish" raw_clFinish :: CommandQueue -> IO CLint
-clFinish :: CommandQueue -> IO (Maybe ErrorCode)
+clFinish :: CommandQueue -> IO ()
clFinish queue = wrapError $ raw_clFinish queue
Oops, something went wrong.

0 comments on commit 107f02a

Please sign in to comment.