OpenCL 1.0.3.1 → 1.0.3.2
raw patch · 5 files changed
+84/−54 lines, 5 filesdep ~mtlPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: mtl
API changes (from Hackage documentation)
Files
- OpenCL.cabal +11/−3
- README.org +2/−2
- src/Control/Parallel/OpenCL/Context.chs +63/−48
- src/Control/Parallel/OpenCL/Query.chs +2/−1
- src/Control/Parallel/OpenCL/Types.chs +6/−0
OpenCL.cabal view
@@ -1,5 +1,5 @@ Name: OpenCL-Version: 1.0.3.1+Version: 1.0.3.2 License: BSD3 License-File: LICENSE Author: Luis Cabellos@@ -34,7 +34,7 @@ Build-tools: c2hs hs-Source-Dirs: src ghc-options: -Wall- Build-Depends: base >=4.0 && < 5, bytestring -any, mtl==2.0.*+ Build-Depends: base >=4.0 && < 5, bytestring -any, mtl==2.* Exposed-Modules: Control.Parallel.OpenCL Control.Parallel.OpenCL.Query@@ -58,7 +58,15 @@ Frameworks: OpenCL if os(windows)- cpp-options: -DCALLCONV=stdcall+ cpp-options: -DCALLCONV=stdcall -Iinclude+ include-dirs: include+ -- this is needed for linking executables, but not for ghci -lOpenCL:+ extra-libraries: OpenCL+ -- NOTE: if extra-libraries fails without finding library! Yo can use:+ --ghc-options: -lOpenCL+ --ld-options: -lOpenCL+ -- NOTE: include-dirs without -Iinclude seems to fail too with GHC 7.4.1!+ Test-suite tests type: exitcode-stdio-1.0
README.org view
@@ -36,10 +36,10 @@ There is an simple working example in the examples folder. You can create an executable using: - : ghc --make -lOpenCL examples/example01.hs+ : ghc --make examples/example01.hs ** Using ghci It's possible to use GHCi with OpenCL, e.g.: - : ghci -lOpenCL examples/example01.hs+ : ghci examples/example01.hs
src/Control/Parallel/OpenCL/Context.chs view
@@ -39,14 +39,15 @@ where -- ------------------------------------------------------------------------------import Foreign( - Ptr, FunPtr, nullPtr, castPtr, alloca, allocaArray, peek, peekArray, +import Foreign(+ Ptr, FunPtr, nullPtr, castPtr, alloca, allocaArray, peek, peekArray, ptrToIntPtr, intPtrToPtr, withArray )-import Foreign.C.Types( CSize )+import Foreign.C.Types -- expose FFI type constructors, the final imported list+ -- depends on final architecture import Foreign.C.String( CString, peekCString ) import Foreign.Storable( sizeOf )-import Control.Parallel.OpenCL.Types( - CLuint, CLint, CLDeviceType_, CLContextInfo_, CLContextProperty_, CLDeviceID, +import Control.Parallel.OpenCL.Types(+ CLuint, CLint, CLDeviceType_, CLContextInfo_, CLContextProperty_, CLDeviceID, CLContext, CLDeviceType, CLPlatformID, bitmaskFromFlags, getCLValue, getEnumCL, whenSuccess, wrapCheckSuccess, wrapPError, wrapGetInfo ) @@ -59,19 +60,19 @@ -- ----------------------------------------------------------------------------- type ContextCallback = CString -> Ptr () -> CSize -> Ptr () -> IO ()-foreign import CALLCONV "wrapper" wrapContextCallback :: +foreign import CALLCONV "wrapper" wrapContextCallback :: ContextCallback -> IO (FunPtr ContextCallback) foreign import CALLCONV "clCreateContext" raw_clCreateContext ::- Ptr CLContextProperty_ -> CLuint -> Ptr CLDeviceID -> FunPtr ContextCallback -> + Ptr CLContextProperty_ -> CLuint -> Ptr CLDeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO CLContext-foreign import CALLCONV "clCreateContextFromType" raw_clCreateContextFromType :: - Ptr CLContextProperty_ -> CLDeviceType_ -> FunPtr ContextCallback -> +foreign import CALLCONV "clCreateContextFromType" raw_clCreateContextFromType ::+ Ptr CLContextProperty_ -> CLDeviceType_ -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO CLContext-foreign import CALLCONV "clRetainContext" raw_clRetainContext :: +foreign import CALLCONV "clRetainContext" raw_clRetainContext :: CLContext -> IO CLint-foreign import CALLCONV "clReleaseContext" raw_clReleaseContext :: +foreign import CALLCONV "clReleaseContext" raw_clReleaseContext :: CLContext -> IO CLint-foreign import CALLCONV "clGetContextInfo" raw_clGetContextInfo :: +foreign import CALLCONV "clGetContextInfo" raw_clGetContextInfo :: CLContext -> CLContextInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint -- -----------------------------------------------------------------------------@@ -94,7 +95,7 @@ {#enum CLContextProperties {upcaseFirstLetter} #} -- | Specifies a context property name and its corresponding value.-data CLContextProperty = CL_CONTEXT_PLATFORM CLPlatformID +data CLContextProperty = CL_CONTEXT_PLATFORM CLPlatformID -- ^ Specifies the platform to use. #ifdef CL_VERSION_1_1 | CL_CGL_SHAREGROUP_KHR (Ptr ())@@ -132,30 +133,44 @@ unpackContextProperties :: [CLContextProperty_] -> [CLContextProperty] unpackContextProperties [] = error "non-exhaustive Context Property list"-unpackContextProperties [x] +unpackContextProperties [x] | x == 0 = [] | otherwise = error "non-exhaustive Context Property list"-unpackContextProperties (x:y:xs) = let ys = unpackContextProperties xs +unpackContextProperties (x:y:xs) = let ys = unpackContextProperties xs in case getEnumCL x of- CL_CONTEXT_PLATFORM_ - -> CL_CONTEXT_PLATFORM + CL_CONTEXT_PLATFORM_+ -> CL_CONTEXT_PLATFORM (intPtrToPtr . fromIntegral $ y) : ys #ifdef CL_VERSION_1_1- CL_CGL_SHAREGROUP_KHR_ - -> CL_CGL_SHAREGROUP_KHR + CL_CGL_SHAREGROUP_KHR_+ -> CL_CGL_SHAREGROUP_KHR (intPtrToPtr . fromIntegral $ y) : ys+#ifndef __APPLE__+ CL_GL_CONTEXT_KHR_+ -> CL_GL_CONTEXT_KHR+ (intPtrToPtr . fromIntegral $ y) : ys+ CL_EGL_DISPLAY_KHR_+ -> CL_EGL_DISPLAY_KHR+ (intPtrToPtr . fromIntegral $ y) : ys+ CL_GLX_DISPLAY_KHR_+ -> CL_GLX_DISPLAY_KHR+ (intPtrToPtr . fromIntegral $ y) : ys+ CL_WGL_HDC_KHR_+ -> CL_WGL_HDC_KHR+ (intPtrToPtr . fromIntegral $ y) : ys #endif- +#endif+ -- ----------------------------------------------------------------------------- mkContextCallback :: (String -> IO ()) -> ContextCallback mkContextCallback f msg _ _ _ = peekCString msg >>= f -- | Creates an OpenCL context.--- An OpenCL context is created with one or more devices. Contexts are used by --- the OpenCL runtime for managing objects such as command-queues, memory, --- program and kernel objects and for executing kernels on one or more devices +-- An OpenCL context is created with one or more devices. Contexts are used by+-- the OpenCL runtime for managing objects such as command-queues, memory,+-- program and kernel objects and for executing kernels on one or more devices -- specified in the context.-clCreateContext :: [CLContextProperty] -> [CLDeviceID] -> (String -> IO ()) +clCreateContext :: [CLContextProperty] -> [CLDeviceID] -> (String -> IO ()) -> IO CLContext clCreateContext [] devs f = withArray devs $ \pdevs -> wrapPError $ \perr -> do@@ -167,13 +182,13 @@ wrapPError $ \perr -> do fptr <- wrapContextCallback $ mkContextCallback f withArray (packContextProperties props) $ \pprops ->- raw_clCreateContext pprops cndevs pdevs fptr nullPtr perr + raw_clCreateContext pprops cndevs pdevs fptr nullPtr perr where cndevs = fromIntegral . length $ devs --- | Create an OpenCL context from a device type that identifies the specific +-- | Create an OpenCL context from a device type that identifies the specific -- device(s) to use.-clCreateContextFromType :: [CLContextProperty] -> [CLDeviceType] +clCreateContextFromType :: [CLContextProperty] -> [CLDeviceType] -> (String -> IO ()) -> IO CLContext clCreateContextFromType [] xs f = wrapPError $ \perr -> do fptr <- wrapContextCallback $ mkContextCallback f@@ -182,31 +197,31 @@ types = bitmaskFromFlags xs clCreateContextFromType props xs f = wrapPError $ \perr -> do fptr <- wrapContextCallback $ mkContextCallback f- withArray (packContextProperties props) $ \pprops -> + withArray (packContextProperties props) $ \pprops -> raw_clCreateContextFromType pprops types fptr nullPtr perr where types = bitmaskFromFlags xs -- | Increment the context reference count.--- 'clCreateContext' and 'clCreateContextFromType' perform an implicit retain. --- This is very helpful for 3rd party libraries, which typically get a context --- passed to them by the application. However, it is possible that the --- application may delete the context without informing the library. Allowing --- functions to attach to (i.e. retain) and release a context solves the +-- 'clCreateContext' and 'clCreateContextFromType' perform an implicit retain.+-- This is very helpful for 3rd party libraries, which typically get a context+-- passed to them by the application. However, it is possible that the+-- application may delete the context without informing the library. Allowing+-- functions to attach to (i.e. retain) and release a context solves the -- problem of a context being used by a library no longer being valid.--- Returns 'True' if the function is executed successfully, or 'False' if +-- Returns 'True' if the function is executed successfully, or 'False' if -- context is not a valid OpenCL context. clRetainContext :: CLContext -> IO Bool-clRetainContext ctx = wrapCheckSuccess $ raw_clRetainContext ctx +clRetainContext ctx = wrapCheckSuccess $ raw_clRetainContext ctx -- | Decrement the context reference count.--- After the context reference count becomes zero and all the objects attached --- to context (such as memory objects, command-queues) are released, the +-- After the context reference count becomes zero and all the objects attached+-- to context (such as memory objects, command-queues) are released, the -- context is deleted.--- Returns 'True' if the function is executed successfully, or 'False' if +-- Returns 'True' if the function is executed successfully, or 'False' if -- context is not a valid OpenCL context. clReleaseContext :: CLContext -> IO Bool-clReleaseContext ctx = wrapCheckSuccess $ raw_clReleaseContext ctx +clReleaseContext ctx = wrapCheckSuccess $ raw_clReleaseContext ctx getContextInfoSize :: CLContext -> CLContextInfo_ -> IO CSize getContextInfoSize ctx infoid = alloca $ \(value_size :: Ptr CSize) -> do@@ -222,8 +237,8 @@ #endc {#enum CLContextInfo {upcaseFirstLetter} #} --- | Return the context reference count. The reference count returned should be --- considered immediately stale. It is unsuitable for general use in +-- | Return the context reference count. The reference count returned should be+-- considered immediately stale. It is unsuitable for general use in -- applications. This feature is provided for identifying memory leaks. -- -- This function execute OpenCL clGetContextInfo with 'CL_CONTEXT_REFERENCE_COUNT'.@@ -231,7 +246,7 @@ clGetContextReferenceCount ctx = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetContextInfo ctx infoid size (castPtr dat)) id- where + where infoid = getCLValue CL_CONTEXT_REFERENCE_COUNT size = fromIntegral $ sizeOf (0::CLuint) @@ -241,8 +256,8 @@ clGetContextDevices :: CLContext -> IO [CLDeviceID] clGetContextDevices ctx = do size <- getContextInfoSize ctx infoid- let n = (fromIntegral size) `div` elemSize - + let n = (fromIntegral size) `div` elemSize+ allocaArray n $ \(buff :: Ptr CLDeviceID) -> do whenSuccess (raw_clGetContextInfo ctx infoid size (castPtr buff) nullPtr) $ peekArray n buff@@ -253,9 +268,9 @@ clGetContextProperties :: CLContext -> IO [CLContextProperty] clGetContextProperties ctx = do size <- getContextInfoSize ctx infoid- let n = (fromIntegral size) `div` elemSize - - if n == 0 + let n = (fromIntegral size) `div` elemSize++ if n == 0 then return [] else allocaArray n $ \(buff :: Ptr CLContextProperty_) -> whenSuccess (raw_clGetContextInfo ctx infoid size (castPtr buff) nullPtr)@@ -263,5 +278,5 @@ where infoid = getCLValue CL_CONTEXT_PROPERTIES elemSize = sizeOf (nullPtr :: CLDeviceID)- + -- -----------------------------------------------------------------------------
src/Control/Parallel/OpenCL/Query.chs view
@@ -67,7 +67,8 @@ -- ----------------------------------------------------------------------------- import Foreign( Ptr, nullPtr, castPtr, alloca, allocaArray, peek, peekArray ) import Foreign.C.String( CString, peekCString )-import Foreign.C.Types( CSize )+import Foreign.C.Types -- expose FFI type constructors, the final imported list+ -- depends on final architecture import Foreign.Storable( sizeOf ) import Control.Parallel.OpenCL.Types( CLbool, CLint, CLuint, CLulong, CLPlatformInfo_, CLDeviceType_,
src/Control/Parallel/OpenCL/Types.chs view
@@ -114,9 +114,15 @@ type CLAddressingMode_ = {#type cl_addressing_mode#} -- -----------------------------------------------------------------------------++-- * NOTE: Apple lags behind official Khronos header files #c enum CLError {+#ifdef __APPLE__+ cL_PLATFORM_NOT_FOUND_KHR=-1001,+#else cL_PLATFORM_NOT_FOUND_KHR=CL_PLATFORM_NOT_FOUND_KHR,+#endif cL_BUILD_PROGRAM_FAILURE=CL_BUILD_PROGRAM_FAILURE, cL_COMPILER_NOT_AVAILABLE=CL_COMPILER_NOT_AVAILABLE, cL_DEVICE_NOT_AVAILABLE=CL_DEVICE_NOT_AVAILABLE,