diff --git a/OpenCL.cabal b/OpenCL.cabal --- a/OpenCL.cabal +++ b/OpenCL.cabal @@ -1,5 +1,5 @@ Name: OpenCL -Version: 1.0.3.0 +Version: 1.0.3.1 License: BSD3 License-File: LICENSE Author: Luis Cabellos @@ -49,6 +49,8 @@ if os(linux) cpp-options: -DCALLCONV=ccall -Iinclude Frameworks: OpenCL + -- this is needed for linking executables, but not for ghci -lOpenCL: + extra-libraries: OpenCL if os(darwin) cpp-options: -DCALLCONV=ccall diff --git a/src/Control/Parallel/OpenCL/Context.chs b/src/Control/Parallel/OpenCL/Context.chs --- a/src/Control/Parallel/OpenCL/Context.chs +++ b/src/Control/Parallel/OpenCL/Context.chs @@ -54,6 +54,7 @@ #include #else #include +#include #endif -- ----------------------------------------------------------------------------- @@ -77,6 +78,17 @@ #c enum CLContextProperties { cL_CONTEXT_PLATFORM_=CL_CONTEXT_PLATFORM, +#ifdef CL_VERSION_1_1 +#ifdef __APPLE__ + cL_CGL_SHAREGROUP_KHR_=CL_CONTEXT_PROPERTY_USE_CGL_SHAREGROUP_APPLE +#else + cL_GL_CONTEXT_KHR_=CL_GL_CONTEXT_KHR, + cL_EGL_DISPLAY_KHR_=CL_EGL_DISPLAY_KHR, + cL_GLX_DISPLAY_KHR_=CL_GLX_DISPLAY_KHR, + cL_WGL_HDC_KHR_=CL_WGL_HDC_KHR, + cL_CGL_SHAREGROUP_KHR_=CL_CGL_SHAREGROUP_KHR +#endif +#endif }; #endc {#enum CLContextProperties {upcaseFirstLetter} #} @@ -84,13 +96,39 @@ -- | Specifies a context property name and its corresponding value. data CLContextProperty = CL_CONTEXT_PLATFORM CLPlatformID -- ^ Specifies the platform to use. +#ifdef CL_VERSION_1_1 + | CL_CGL_SHAREGROUP_KHR (Ptr ()) + -- ^ Specifies the CGL share group to use. +#ifndef __APPLE__ + | CL_GL_CONTEXT_KHR (Ptr ()) + | CL_EGL_DISPLAY_KHR (Ptr ()) + | CL_GLX_DISPLAY_KHR (Ptr ()) + | CL_WGL_HDC_KHR (Ptr ()) +#endif +#endif deriving( Show ) +packProperty :: CLContextProperty -> [CLContextProperty_] +packProperty (CL_CONTEXT_PLATFORM pid) = [ getCLValue CL_CONTEXT_PLATFORM_ + , fromIntegral . ptrToIntPtr $ pid ] +#ifdef CL_VERSION_1_1 +packProperty (CL_CGL_SHAREGROUP_KHR ptr) = [ getCLValue CL_CGL_SHAREGROUP_KHR_ + , fromIntegral . ptrToIntPtr $ ptr ] +#ifndef __APPLE__ +packProperty (CL_GL_CONTEXT_KHR ptr) = [ getCLValue CL_GL_CONTEXT_KHR_ + , fromIntegral . ptrToIntPtr $ ptr ] +packProperty (CL_EGL_DISPLAY_KHR ptr) = [ getCLValue CL_EGL_DISPLAY_KHR_ + , fromIntegral . ptrToIntPtr $ ptr ] +packProperty (CL_GLX_DISPLAY_KHR ptr) = [ getCLValue CL_GLX_DISPLAY_KHR_ + , fromIntegral . ptrToIntPtr $ ptr ] +packProperty (CL_WGL_HDC_KHR ptr) = [ getCLValue CL_WGL_HDC_KHR_ + , fromIntegral . ptrToIntPtr $ ptr ] +#endif +#endif + packContextProperties :: [CLContextProperty] -> [CLContextProperty_] packContextProperties [] = [0] -packContextProperties (CL_CONTEXT_PLATFORM pid : xs) = getCLValue CL_CONTEXT_PLATFORM_ - : (fromIntegral . ptrToIntPtr $ pid) - : packContextProperties xs +packContextProperties (x:xs) = packProperty x ++ packContextProperties xs unpackContextProperties :: [CLContextProperty_] -> [CLContextProperty] unpackContextProperties [] = error "non-exhaustive Context Property list" @@ -102,6 +140,11 @@ CL_CONTEXT_PLATFORM_ -> CL_CONTEXT_PLATFORM (intPtrToPtr . fromIntegral $ y) : ys +#ifdef CL_VERSION_1_1 + CL_CGL_SHAREGROUP_KHR_ + -> CL_CGL_SHAREGROUP_KHR + (intPtrToPtr . fromIntegral $ y) : ys +#endif -- ----------------------------------------------------------------------------- mkContextCallback :: (String -> IO ()) -> ContextCallback diff --git a/src/Control/Parallel/OpenCL/Memory.chs b/src/Control/Parallel/OpenCL/Memory.chs --- a/src/Control/Parallel/OpenCL/Memory.chs +++ b/src/Control/Parallel/OpenCL/Memory.chs @@ -33,15 +33,16 @@ module Control.Parallel.OpenCL.Memory( -- * Types CLMem, CLSampler, CLMemFlag(..), CLMemObjectType(..), CLAddressingMode(..), - CLFilterMode(..), CLImageFormat(..), + CLFilterMode(..), CLImageFormat(..), CLChannelOrder(..), CLChannelType(..), -- * Memory Functions clCreateBuffer, clRetainMemObject, clReleaseMemObject, clGetMemType, clGetMemFlags, clGetMemSize, clGetMemHostPtr, clGetMemMapCount, - clGetMemReferenceCount, clGetMemContext, + clGetMemReferenceCount, clGetMemContext, clCreateFromGLBuffer, -- * Image Functions - clCreateImage2D, clCreateImage3D, clGetSupportedImageFormats, - clGetImageFormat, clGetImageElementSize, clGetImageRowPitch, - clGetImageSlicePitch, clGetImageWidth, clGetImageHeight, clGetImageDepth, + clCreateImage2D, clCreateImage3D, clCreateFromGLTexture2D, + clGetSupportedImageFormats, clGetImageFormat, clGetImageElementSize, + clGetImageRowPitch, clGetImageSlicePitch, clGetImageWidth, clGetImageHeight, + clGetImageDepth, -- * Sampler Functions clCreateSampler, clRetainSampler, clReleaseSampler, clGetSamplerReferenceCount, clGetSamplerContext, clGetSamplerAddressingMode, clGetSamplerFilterMode, @@ -75,6 +76,10 @@ foreign import CALLCONV "clCreateImage3D" raw_clCreateImage3D :: CLContext -> CLMemFlags_-> CLImageFormat_p -> CSize -> CSize -> CSize -> CSize -> CSize -> Ptr () -> Ptr CLint -> IO CLMem +foreign import CALLCONV "clCreateFromGLTexture2D" raw_clCreateFromGLTexture2D :: + CLContext -> CLMemFlags_ -> CLuint -> CLint -> CLuint -> Ptr CLint -> IO CLMem +foreign import CALLCONV "clCreateFromGLBuffer" raw_clCreateFromGLBuffer :: + CLContext -> CLMemFlags_ -> CLuint -> Ptr CLint -> IO CLMem foreign import CALLCONV "clRetainMemObject" raw_clRetainMemObject :: CLMem -> IO CLint foreign import CALLCONV "clReleaseMemObject" raw_clReleaseMemObject :: @@ -121,6 +126,23 @@ raw_clCreateBuffer ctx flags (fromIntegral sbuff) buff perr where flags = bitmaskFromFlags xs + +{-| Creates an OpenCL buffer object from an OpenGL buffer object. Returns a valid non-zero OpenCL buffer object if the buffer object is created successfully. Otherwise it throws the 'CLError': + * 'CL_INVALID_CONTEXT' if context is not a valid context or was not created from a GL context. + + * 'CL_INVALID_VALUE' if values specified in flags are not valid. + + * 'CL_INVALID_GL_OBJECT' if bufobj is not a GL buffer object or is a GL buffer object but does not have an existing data store. + + * 'CL_OUT_OF_RESOURCES' if there is a failure to allocate resources required by the OpenCL implementation on the device. + + * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. +-} +clCreateFromGLBuffer :: Integral a => CLContext -> [CLMemFlag] -> a -> IO CLMem +clCreateFromGLBuffer ctx xs glObj = wrapPError $ \perr -> do + raw_clCreateFromGLBuffer ctx flags cglObj perr + where flags = bitmaskFromFlags xs + cglObj = fromIntegral glObj -- | Increments the memory object reference count. returns 'True' if the -- function is executed successfully. After the memobj reference count becomes @@ -427,6 +449,62 @@ cid = fromIntegral idepth cirp = fromIntegral irp cisp = fromIntegral isp + +{-| Creates a 2D OpenCL image object from an existing OpenGL texture. + +'clCreateFromGLTexture2D' returns a non-zero image object if the image +object is created successfully. Otherwise, it throws one of the +following 'CLError' exceptions: + + * 'CL_INVALID_CONTEXT' if context is not a valid context or was not +created from a GL context. + + * 'CL_INVALID_VALUE' if values specified in flags are not valid or if +value specified in texture_target is not one of the values specified +in the description of texture_target. + + * 'CL_INVALID_MIPLEVEL' if miplevel is less than the value of +levelbase (for OpenGL implementations) or zero (for OpenGL ES +implementations); or greater than the value of q (for both OpenGL and +OpenGL ES). levelbase and q are defined for the texture in section +3.8.10 (Texture Completeness) of the OpenGL 2.1 specification and +section 3.7.10 of the OpenGL ES 2.0 specification. + + * 'CL_INVALID_MIPLEVEL' if miplevel is greater than zero and the +OpenGL implementation does not support creating from non-zero mipmap +levels. + + * 'CL_INVALID_GL_OBJECT' if texture is not a GL texture object whose +type matches texture_target, if the specified miplevel of texture is +not defined, or if the width or height of the specified miplevel is +zero. + + * 'CL_INVALID_IMAGE_FORMAT_DESCRIPTOR' if the OpenGL texture internal +format does not map to a supported OpenCL image format. + + * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources +required by the OpenCL implementation on the host. + +-} +clCreateFromGLTexture2D :: (Integral a, Integral b, Integral c) => + CLContext -- ^ A valid OpenCL context in + -- which the image object is to + -- be created. + -> [CLMemFlag] -- ^ A list of flags that is + -- used to specify usage + -- information about the image + -- memory object being created. + -> a -- ^ The OpenGL image type of the texture + -- (e.g. GL_TEXTURE_2D) + -> b -- ^ The mipmap level to be used. + -> c -- ^ The GL texture object name. + -> IO CLMem +clCreateFromGLTexture2D ctx xs texType mipLevel tex = + wrapPError $ raw_clCreateFromGLTexture2D ctx flags cTexType cMip cTex + where flags = bitmaskFromFlags xs + cTexType = fromIntegral texType + cMip = fromIntegral mipLevel + cTex = fromIntegral tex getNumSupportedImageFormats :: CLContext -> [CLMemFlag] -> CLMemObjectType -> IO CLuint getNumSupportedImageFormats ctx xs mtype = alloca $ \(value_size :: Ptr CLuint) -> do diff --git a/src/Control/Parallel/OpenCL/Types.chs b/src/Control/Parallel/OpenCL/Types.chs --- a/src/Control/Parallel/OpenCL/Types.chs +++ b/src/Control/Parallel/OpenCL/Types.chs @@ -65,6 +65,7 @@ #include #else #include +#include #endif -- ----------------------------------------------------------------------------- @@ -115,6 +116,7 @@ -- ----------------------------------------------------------------------------- #c enum CLError { + cL_PLATFORM_NOT_FOUND_KHR=CL_PLATFORM_NOT_FOUND_KHR, cL_BUILD_PROGRAM_FAILURE=CL_BUILD_PROGRAM_FAILURE, cL_COMPILER_NOT_AVAILABLE=CL_COMPILER_NOT_AVAILABLE, cL_DEVICE_NOT_AVAILABLE=CL_DEVICE_NOT_AVAILABLE, @@ -176,6 +178,9 @@ * 'CL_DEVICE_NOT_FOUND', Returned if no OpenCL devices that match the specified devices were found. + + * 'CL_PLATFORM_NOT_FOUND_khr', Returned when no .icd (platform drivers) + can be properly loaded. * 'CL_IMAGE_FORMAT_MISMATCH', Returned if the specified source and destination images are not valid image objects.