diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,49 @@ +RENCI Open Source Software License +The University of North Carolina at Chapel Hill + +The University of North Carolina at Chapel Hill (the "Licensor") through +its Renaissance Computing Institute (RENCI) is making an original work of +authorship (the "Software") available through RENCI upon the terms set +forth in this Open Source Software License (this "License"). This License +applies to any Software that has placed the following notice immediately +following the copyright notice for the Software: Licensed under the RENCI +Open Source Software License v. 1.0. + +Licensor grants You, free of charge, a world-wide, royalty-free, +non-exclusive, perpetual, sublicenseable license to do the following to +deal in the Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following conditions: + +. Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimers. + +. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimers in the +documentation and/or other materials provided with the distribution. + +. Neither You nor any sublicensor of the Software may use the names of +Licensor (or any derivative thereof), of RENCI, or of contributors to the +Software without explicit prior written permission. Nothing in this +License shall be deemed to grant any rights to trademarks, copyrights, +patents, trade secrets or any other intellectual property of Licensor +except as expressly stated herein. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE CONTIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. + +You may use the Software in all ways not otherwise restricted or +conditioned by this License or by law, and Licensor promises not to +interfere with or be responsible for such uses by You. This Software may +be subject to U.S. law dealing with export controls. If you are in the +U.S., please do not mirror this Software unless you fully understand the +U.S. export regulations. Licensees in other countries may face similar +restrictions. In all cases, it is licensee's responsibility to comply +with any export regulations applicable in licensee's jurisdiction. + diff --git a/OpenCLWrappers.cabal b/OpenCLWrappers.cabal new file mode 100644 --- /dev/null +++ b/OpenCLWrappers.cabal @@ -0,0 +1,43 @@ +name: OpenCLWrappers +version: 0.0.0 +cabal-version: >=1.2 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Renaissance Computing Institute, Emil Karlson +maintainer: Emil Karlson +stability: Experimental +homepage: https://github.com/jkarlson/OpenCLWrappers +package-url: +bug-reports: https://github.com/jkarlson/OpenCLWrappers/issues +synopsis: The OpenCL Standard for heterogenous data-parallel computing +description: Light opencl wrappers, a fork of the OpenCLRaw package. +category: FFI +author: J.R. Heard, Emil Karlson + +Library + exposed-modules: System.OpenCL.Wrappers.CommandQueue + System.OpenCL.Wrappers.Context + System.OpenCL.Wrappers.DeviceInfo + System.OpenCL.Wrappers.Errors + System.OpenCL.Wrappers.Etc + System.OpenCL.Wrappers.EventObject + System.OpenCL.Wrappers.FlushFinish + System.OpenCL.Wrappers.Kernel + System.OpenCL.Wrappers.MemoryObject + System.OpenCL.Wrappers.OutOfOrder + System.OpenCL.Wrappers.PlatformInfo + System.OpenCL.Wrappers.ProgramObject + System.OpenCL.Wrappers.Sampler + System.OpenCL.Wrappers.Types + System.OpenCL.Wrappers.Helpers + System.OpenCL.Wrappers.Raw + System.OpenCL.Wrappers + build-depends: base <= 4.4, + bytestring -any, + mtl >= 2 && < 2.1 + exposed: True + buildable: True + hs-source-dirs: . + other-modules: System.OpenCL.Wrappers.Utils + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,6 @@ +#!/usr/bin/runhaskell +> module Main where +> import Distribution.Simple +> main :: IO () +> main = defaultMain + diff --git a/System/OpenCL/Wrappers.hs b/System/OpenCL/Wrappers.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers.hs @@ -0,0 +1,77 @@ +{-| + The OpenCL system for open heterogenous data parallel supercomputing. + + A fork of the FFI wrapper OpenCLRaw by Jeff Heard of the Renaissance Computing Institute. + + From the introduction: + + OpenCL (Open Computing Language) is an open royalty-free standard for general purpose + parallel programming across CPUs, GPUs and other processors, giving software developers + portable and efficient access to the power of these heterogeneous processing platforms. + + OpenCL supports a wide range of applications, ranging from embedded and consumer software + to HPC solutions, through a low-level, high-performance, portable abstraction. By creating an + efficient, close-to-the-metal programming interface, OpenCL will form the foundation layer of a + parallel computing ecosystem of platform-independent tools, middleware and applications. + OpenCL is particularly suited to play an increasingly significant role in emerging interactive + graphics applications that combine general parallel compute algorithms with graphics rendering + pipelines. + + OpenCL consists of an API for coordinating parallel computation across + heterogeneous processors; and a cross-platform programming language with a well- + specified computation environment. The OpenCL standard: + + * Supports both data- and task-based parallel programming models + + * Utilizes a subset of ISO C99 with extensions for parallelism + + * Defines consistent numerical requirements based on IEEE 754 + + * Defines a configuration profile for handheld and embedded devices + + * Efficiently interoperates with OpenGL, OpenGL ES and other graphics APIs + + _General Notes on the differences between Haskell and the OpenCL-C implementation_ + + * Side-effectful procedures capable of returning an error code only return a Maybe ErrorCode, with Nothing returned upon success + + * Procedures which follow the pattern of returning a pointer to an object and taking a final parameter as an error code instead + return Either ErrorCode @ObjectType@ + + * Enumerations and constants are replaced by newtypes for the sake of type-safety. +-} +module System.OpenCL.Wrappers + (module System.OpenCL.Wrappers.CommandQueue + ,module System.OpenCL.Wrappers.Context + ,module System.OpenCL.Wrappers.DeviceInfo + ,module System.OpenCL.Wrappers.Errors + ,module System.OpenCL.Wrappers.Etc + ,module System.OpenCL.Wrappers.EventObject + ,module System.OpenCL.Wrappers.FlushFinish + ,module System.OpenCL.Wrappers.Kernel + ,module System.OpenCL.Wrappers.MemoryObject + ,module System.OpenCL.Wrappers.OutOfOrder + ,module System.OpenCL.Wrappers.PlatformInfo + ,module System.OpenCL.Wrappers.ProgramObject + ,module System.OpenCL.Wrappers.Sampler + ,module System.OpenCL.Wrappers.Types + ,module System.OpenCL.Wrappers.Helpers + ,module System.OpenCL.Wrappers.Raw) +where + +import System.OpenCL.Wrappers.CommandQueue +import System.OpenCL.Wrappers.Context +import System.OpenCL.Wrappers.DeviceInfo +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Etc +import System.OpenCL.Wrappers.EventObject +import System.OpenCL.Wrappers.FlushFinish +import System.OpenCL.Wrappers.Kernel +import System.OpenCL.Wrappers.MemoryObject +import System.OpenCL.Wrappers.OutOfOrder +import System.OpenCL.Wrappers.PlatformInfo +import System.OpenCL.Wrappers.ProgramObject +import System.OpenCL.Wrappers.Sampler +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Helpers +import System.OpenCL.Wrappers.Raw diff --git a/System/OpenCL/Wrappers/CommandQueue.hs b/System/OpenCL/Wrappers/CommandQueue.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/CommandQueue.hs @@ -0,0 +1,41 @@ +module System.OpenCL.Wrappers.CommandQueue + (clCreateCommandQueue + ,clRetainCommandQueue + ,clReleaseCommandQueue + ,clGetCommandQueueInfo + ,clSetCommandQueueProperty) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign.Marshal.Alloc(alloca) +import Foreign.Storable(peek) + + +clCreateCommandQueue :: Context -> DeviceID -> [CommandQueueProperties] -> IO (Either ErrorCode CommandQueue) +clCreateCommandQueue ctx devid props = let + CommandQueueProperties properties = combineOr props + in wrapErrorEither $ raw_clCreateCommandQueue ctx devid properties + +clRetainCommandQueue :: CommandQueue -> IO (Maybe ErrorCode) +clRetainCommandQueue queue = wrapError (raw_clRetainCommandQueue queue) + +clReleaseCommandQueue :: CommandQueue -> IO (Maybe ErrorCode) +clReleaseCommandQueue queue = wrapError (raw_clReleaseCommandQueue queue) + +clGetCommandQueueInfo :: CommandQueue -> CommandQueueInfo -> IO (Either ErrorCode CLCommandQueueInfoRetval) +clGetCommandQueueInfo ctx (CommandQueueInfo param_name) = wrapGetInfo (raw_clGetCommandQueueInfo ctx param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (CommandQueueInfo param_name) in case () of + () + | c == clQueueContext -> peekOneInfo CommandQueueInfoRetvalContext x + | c == clQueueDevice -> peekOneInfo CommandQueueInfoRetvalDeviceID x + | c == clQueueReferenceCount -> peekOneInfo CommandQueueInfoRetvalCLuint x + | c == clQueueProperties -> peekOneInfo CommandQueueInfoRetvalCommandQueueProperties x) + +{-# DEPRECATED clSetCommandQueueProperty "Deprecated in C api" #-} +clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO (Either ErrorCode CommandQueueProperties) +clSetCommandQueueProperty queue (CommandQueueProperties properties) enable = alloca $ \old_properties -> + wrapError (raw_clSetCommandQueueProperty queue properties (if enable then clTrue else clFalse) old_properties) >>= + maybe (fmap (Right . CommandQueueProperties) $ peek old_properties) (return . Left) diff --git a/System/OpenCL/Wrappers/Context.hs b/System/OpenCL/Wrappers/Context.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Context.hs @@ -0,0 +1,41 @@ +module System.OpenCL.Wrappers.Context + (clCreateContext + ,clCreateContextFromType + ,clRetainContext + ,clReleaseContext + ,clGetContextInfo + ) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign.Ptr(Ptr, nullPtr, nullFunPtr) +import Foreign.Marshal.Array(withArray) + + +clCreateContext :: [ContextProperties] -> [DeviceID] -> (Maybe ContextCallback) -> Ptr () -> IO (Either ErrorCode Context) +clCreateContext properties devices pfn_notify user_dat = + withArrayNull0 nullPtr properties $ \propertiesP -> withArray devices $ \devicesP -> do + fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify + wrapErrorEither $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat + where devicesN = length devices + +clCreateContextFromType :: [ContextProperties] -> DeviceType -> (Maybe ContextCallback) -> Ptr () -> IO (Either ErrorCode Context) +clCreateContextFromType properties (DeviceType device_type) pfn_notify user_data = withArrayNull0 nullPtr properties $ \propertiesP -> do + fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify + wrapErrorEither $ raw_clCreateContextFromType propertiesP device_type fptr user_data + +clRetainContext :: Context -> IO (Maybe ErrorCode) +clRetainContext ctx = wrapError (raw_clRetainContext ctx) + +clReleaseContext :: Context -> IO (Maybe ErrorCode) +clReleaseContext ctx = wrapError (raw_clReleaseContext ctx) + +clGetContextInfo :: Context -> ContextInfo -> IO (Either ErrorCode CLContextInfoRetval) +clGetContextInfo ctx (ContextInfo param_name) = wrapGetInfo (raw_clGetContextInfo ctx param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (ContextInfo param_name) in case () of + () + | c == clContextReferenceCount -> peekOneInfo ContextInfoRetvalCLuint x + | c == clContextDevices -> peekManyInfo ContextInfoRetvalDeviceIDList x size + | c == clContextProperties -> peekManyInfo ContextInfoRetvalContextPropertiesList x size ) diff --git a/System/OpenCL/Wrappers/DeviceInfo.hs b/System/OpenCL/Wrappers/DeviceInfo.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/DeviceInfo.hs @@ -0,0 +1,70 @@ +module System.OpenCL.Wrappers.DeviceInfo + (clGetDeviceIDs + ,clGetDeviceInfo) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw + + +clGetDeviceIDs :: PlatformID -> DeviceType -> IO (Either ErrorCode [DeviceID]) +clGetDeviceIDs platform (DeviceType device_type) = wrapGetNumElements $ raw_clGetDeviceIDs platform device_type + +clGetDeviceInfo :: DeviceID -> DeviceInfo -> IO (Either ErrorCode CLDeviceInfoRetval) +clGetDeviceInfo obj (DeviceInfo param_name) = wrapGetInfo (raw_clGetDeviceInfo obj param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (DeviceInfo param_name) in case () of + () + | c == clDeviceAddressBits -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceAvailable -> peekOneInfo DeviceInfoRetvalCLbool x + | c == clDeviceCompilerAvailable -> peekOneInfo DeviceInfoRetvalCLbool x + | c == clDeviceDoubleFPConfig -> peekOneInfo DeviceInfoRetvalDeviceFPConfig x + | c == clDeviceEndianLittle -> peekOneInfo DeviceInfoRetvalCLbool x + | c == clDeviceErrorCorrectionSupport -> peekOneInfo DeviceInfoRetvalCLbool x + | c == clDeviceExecutionCapabilities -> peekOneInfo DeviceInfoRetvalDeviceExecCapabilities x + | c == clDeviceExtensions -> peekStringInfo DeviceInfoRetvalString x + | c == clDeviceGlobalMemCacheSize -> peekOneInfo DeviceInfoRetvalCLulong x + | c == clDeviceGlobalMemCacheType -> peekOneInfo DeviceInfoRetvalDeviceMemCacheType x + | c == clDeviceGlobalMemCacheLineSize -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceGlobalMemSize -> peekOneInfo DeviceInfoRetvalCLulong x + | c == clDeviceHalfFPConfig -> peekOneInfo DeviceInfoRetvalDeviceFPConfig x + | c == clDeviceImageSupport -> peekOneInfo DeviceInfoRetvalCLbool x + | c == clDeviceImage2DMaxHeight -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceImage2DMaxWidth -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceImage3DMaxDepth -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceImage3DMaxHeight -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceImage3DMaxWidth -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceLocalMemSize -> peekOneInfo DeviceInfoRetvalCLulong x + | c == clDeviceLocalMemType -> peekOneInfo DeviceInfoRetvalDeviceLocalMemType x + | c == clDeviceMaxClockFrequency -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMaxComputeUnits -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMaxConstantArgs -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMaxConstantBufferSize -> peekOneInfo DeviceInfoRetvalCLulong x + | c == clDeviceMaxMemAllocSize -> peekOneInfo DeviceInfoRetvalCLulong x + | c == clDeviceMaxParameterSize -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceMaxReadImageArgs -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMaxSamplers -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMaxWorkGroupSize -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceMaxWorkItemDimensions -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMaxWorkItemSizes -> peekManyInfo DeviceInfoRetvalCLsizeiList x size + | c == clDeviceMaxWriteImageArgs -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMemBaseAddrAlign -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceMinDataTypeAlignSize -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceName -> peekStringInfo DeviceInfoRetvalString x + | c == clDevicePlatform -> peekOneInfo DeviceInfoRetvalPlatformID x + | c == clDevicePreferredVectorWidthChar -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDevicePreferredVectorWidthShort -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDevicePreferredVectorWidthInt -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDevicePreferredVectorWidthLong -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDevicePreferredVectorWidthFloat -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDevicePreferredVectorWidthDouble -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceProfile -> peekStringInfo DeviceInfoRetvalString x + | c == clDeviceProfilingTimerResolution -> peekOneInfo DeviceInfoRetvalCLsizei x + | c == clDeviceQueueProperties -> peekOneInfo DeviceInfoRetvalCommandQueueProperties x + | c == clDeviceSingleFPConfig -> peekOneInfo DeviceInfoRetvalDeviceFPConfig x + | c == clDeviceType -> peekOneInfo DeviceInfoRetvalDeviceType x + | c == clDeviceVendor -> peekStringInfo DeviceInfoRetvalString x + | c == clDeviceVendorID -> peekOneInfo DeviceInfoRetvalCLuint x + | c == clDeviceVersion -> peekStringInfo DeviceInfoRetvalString x + | c == clDriverVersion -> peekStringInfo DeviceInfoRetvalString x) diff --git a/System/OpenCL/Wrappers/Errors.hs b/System/OpenCL/Wrappers/Errors.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Errors.hs @@ -0,0 +1,142 @@ +{-| A collection of all the error codes that OpenCL functions return -} +module System.OpenCL.Wrappers.Errors where + +import System.OpenCL.Wrappers.Types + +clSuccess :: ErrorCode +clSuccess = ErrorCode (0) + +clDeviceNotFound :: ErrorCode +clDeviceNotFound = ErrorCode (-1) + +clDeviceNotAvailable :: ErrorCode +clDeviceNotAvailable = ErrorCode (-2) + +clCompilerNotAvailable :: ErrorCode +clCompilerNotAvailable = ErrorCode (-3) + +clMemObjectAllocationFailure :: ErrorCode +clMemObjectAllocationFailure = ErrorCode (-4) + +clOutOfResources :: ErrorCode +clOutOfResources = ErrorCode (-5) + +clOutOfHostMemory :: ErrorCode +clOutOfHostMemory = ErrorCode (-6) + +clProfilingInfoNotAvailable :: ErrorCode +clProfilingInfoNotAvailable = ErrorCode (-7) + +clMemCopyOverlap :: ErrorCode +clMemCopyOverlap = ErrorCode (-8) + +clImageFormatMismatch :: ErrorCode +clImageFormatMismatch = ErrorCode (-9) + +clImageFormatNotSupported :: ErrorCode +clImageFormatNotSupported = ErrorCode (-10) + +clBuildProgramFailure :: ErrorCode +clBuildProgramFailure = ErrorCode (-11) + +clMapFailure :: ErrorCode +clMapFailure = ErrorCode (-12) + +clInvalidValue :: ErrorCode +clInvalidValue = ErrorCode (-30) + +clInvalidDeviceType :: ErrorCode +clInvalidDeviceType = ErrorCode (-31) + +clInvalidPlatform :: ErrorCode +clInvalidPlatform = ErrorCode (-32) + +clInvalidDevice :: ErrorCode +clInvalidDevice = ErrorCode (-33) + +clInvalidContext :: ErrorCode +clInvalidContext = ErrorCode (-34) + +clInvalidQueueProperties :: ErrorCode +clInvalidQueueProperties = ErrorCode (-35) + +clInvalidCommandQueue :: ErrorCode +clInvalidCommandQueue = ErrorCode (-36) + +clInvalidHostPtr :: ErrorCode +clInvalidHostPtr = ErrorCode (-37) + +clInvalidMemObject :: ErrorCode +clInvalidMemObject = ErrorCode (-38) + +clInvalidImageFormatDescriptor :: ErrorCode +clInvalidImageFormatDescriptor = ErrorCode (-39) + +clInvalidImageSize :: ErrorCode +clInvalidImageSize = ErrorCode (-40) + +clInvalidSampler :: ErrorCode +clInvalidSampler = ErrorCode (-41) + +clInvalidBinary :: ErrorCode +clInvalidBinary = ErrorCode (-42) + +clInvalidBuildOptions :: ErrorCode +clInvalidBuildOptions = ErrorCode (-43) + +clInvalidProgram :: ErrorCode +clInvalidProgram = ErrorCode (-44) + +clInvalidProgramExecutable :: ErrorCode +clInvalidProgramExecutable = ErrorCode (-45) + +clInvalidKernelName :: ErrorCode +clInvalidKernelName = ErrorCode (-46) + +clInvalidKernelDefinition :: ErrorCode +clInvalidKernelDefinition = ErrorCode (-47) + +clInvalidKernel :: ErrorCode +clInvalidKernel = ErrorCode (-48) + +clInvalidArgIndex :: ErrorCode +clInvalidArgIndex = ErrorCode (-49) + +clInvalidArgValue :: ErrorCode +clInvalidArgValue = ErrorCode (-50) + +clInvalidArgSize :: ErrorCode +clInvalidArgSize = ErrorCode (-51) + +clInvalidKernelArgs :: ErrorCode +clInvalidKernelArgs = ErrorCode (-52) + +clInvalidWorkDimension :: ErrorCode +clInvalidWorkDimension = ErrorCode (-53) + +clInvalidWorkGroupSize :: ErrorCode +clInvalidWorkGroupSize = ErrorCode (-54) +clInvalidWorkItemSize :: ErrorCode + +clInvalidWorkItemSize = ErrorCode (-55) +clInvalidGlobalOffset :: ErrorCode + +clInvalidGlobalOffset = ErrorCode (-56) +clInvalidEventWaitList :: ErrorCode + +clInvalidEventWaitList = ErrorCode (-57) +clInvalidEvent :: ErrorCode + +clInvalidEvent = ErrorCode (-58) +clInvalidOperation :: ErrorCode + +clInvalidOperation = ErrorCode (-59) +clInvalidGLObject :: ErrorCode + +clInvalidGLObject = ErrorCode (-60) +clInvalidBufferSize :: ErrorCode + +clInvalidBufferSize = ErrorCode (-61) +clInvalidMipLevel = ErrorCode (-62) + + diff --git a/System/OpenCL/Wrappers/Etc.hs b/System/OpenCL/Wrappers/Etc.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Etc.hs @@ -0,0 +1,12 @@ +{-| Module for querying extensions -} +module System.OpenCL.Wrappers.Etc + (clGetExtensionFunctionAddress) +where + +import System.OpenCL.Wrappers.Raw +import Foreign.Ptr(Ptr) +import Foreign.C.String(withCString) + + +clGetExtensionFunctionAddress :: String -> IO (Ptr ()) +clGetExtensionFunctionAddress str = withCString str raw_clGetExtensionFunctionAddress diff --git a/System/OpenCL/Wrappers/EventObject.hs b/System/OpenCL/Wrappers/EventObject.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/EventObject.hs @@ -0,0 +1,41 @@ +module System.OpenCL.Wrappers.EventObject + (clWaitForEvents + ,clGetEventInfo + ,clRetainEvent + ,clReleaseEvent + ,clGetEventProfilingInfo) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign.Marshal.Array(withArray) + + +clWaitForEvents :: [Event] -> IO (Maybe ErrorCode) +clWaitForEvents evts = withArray evts (\eventP -> wrapError $ raw_clWaitForEvents (fromIntegral nEvents) eventP) + where nEvents = length evts + +clGetEventInfo :: Event -> EventInfo -> IO (Either ErrorCode CLEventInfoRetval) +clGetEventInfo obj (EventInfo param_name) = wrapGetInfo (raw_clGetEventInfo obj param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (EventInfo param_name) in case () of + () + | c == clEventCommandQueue -> peekOneInfo EventInfoRetvalCommandQueue x + | c == clEventCommandType -> peekOneInfo EventInfoRetvalCommandType x + | c == clEventCommandExecutionStatus -> peekOneInfo EventInfoRetvalCLint x + | c == clEventReferenceCount -> peekOneInfo EventInfoRetvalCLuint x ) + +clRetainEvent :: Event -> IO (Maybe ErrorCode) +clRetainEvent evt = wrapError $ raw_clRetainEvent evt + +clReleaseEvent :: Event -> IO (Maybe ErrorCode) +clReleaseEvent evt = wrapError $ raw_clReleaseEvent evt + +clGetEventProfilingInfo :: Event -> ProfilingInfo -> IO (Either ErrorCode CLEventProfilingInfoRetval) +clGetEventProfilingInfo obj (ProfilingInfo param_name) = wrapGetInfo (raw_clGetEventProfilingInfo obj param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (ProfilingInfo param_name) in case () of + () + | c == clProfilingCommandQueued -> peekOneInfo EventProfilingInfoRetvalCLulong x + | c == clProfilingCommandSubmit -> peekOneInfo EventProfilingInfoRetvalCLulong x + | c == clProfilingCommandStart -> peekOneInfo EventProfilingInfoRetvalCLulong x + | c == clProfilingCommandEnd -> peekOneInfo EventProfilingInfoRetvalCLulong x ) diff --git a/System/OpenCL/Wrappers/FlushFinish.hs b/System/OpenCL/Wrappers/FlushFinish.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/FlushFinish.hs @@ -0,0 +1,15 @@ +module System.OpenCL.Wrappers.FlushFinish + (clFlush + ,clFinish) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw + + +clFlush :: CommandQueue -> IO (Maybe ErrorCode) +clFlush queue = wrapError $ raw_clFlush queue + +clFinish :: CommandQueue -> IO (Maybe ErrorCode) +clFinish queue = wrapError $ raw_clFinish queue diff --git a/System/OpenCL/Wrappers/Helpers.hs b/System/OpenCL/Wrappers/Helpers.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Helpers.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-| Some helper functions that may or may not be useful to anyone. -} +module System.OpenCL.Wrappers.Helpers + (createSyncKernel + ,createAsyncKernelWithParams + ,buildProgram + ,pushKernelParams) +where + +import System.OpenCL.Wrappers.Kernel +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.ProgramObject +import System.OpenCL.Wrappers.FlushFinish +import Foreign.Marshal +import Foreign.Storable +import Foreign.Ptr + +pushKernelParams :: forall b. Storable b => Kernel -> CLuint -> [b] -> IO (Maybe ErrorCode) +pushKernelParams kernel argNum (x:xs) = + withArray [x] (\y -> clSetKernelArg kernel argNum (fromIntegral.sizeOf $ x) (castPtr y)) >>= + maybe (pushKernelParams kernel (argNum + 1) xs) (return.Just) +pushKernelParams _ _ _ = return Nothing + +syncKernelFun :: forall b. Storable b => CLuint -> Kernel -> CommandQueue -> [CLsizei] -> [CLsizei] -> [b] -> IO (Maybe ErrorCode) +syncKernelFun _ kernel queue a b [] = + clEnqueueNDRangeKernel queue kernel a b [] >>= + either (return.Just) (\_ -> clFinish queue >>= maybe (return Nothing) (return.Just)) +syncKernelFun argNum kernel queue a b (x:xs) = + withArray [x] (\y -> clSetKernelArg kernel argNum (fromIntegral.sizeOf $ x) (castPtr y)) >>= + maybe (syncKernelFun (argNum + 1) kernel queue a b xs) (return.Just) + +createSyncKernel :: forall b. Storable b => Program -> CommandQueue -> String -> [Int] -> [Int] -> IO (Either ErrorCode ([b] -> IO (Maybe ErrorCode))) +createSyncKernel program queue initFun globalWorkRange localWorkRange = + clCreateKernel program initFun >>= + either (return.Left) (\k -> return.Right $ syncKernelFun 0 k queue (map fromIntegral globalWorkRange) (map fromIntegral localWorkRange)) + +createAsyncKernelWithParams :: forall b. Storable b => Program -> CommandQueue -> String -> [Int] -> [Int] -> [b] -> IO (Either ErrorCode ([Event] -> IO (Either ErrorCode Event))) +createAsyncKernelWithParams program queue initFun globalWorkRange localWorkRange params = + clCreateKernel program initFun >>= + either (return.Left) (\k -> pushKernelParams k 0 params >>= + maybe (return.Right $ clEnqueueNDRangeKernel queue k (map fromIntegral globalWorkRange) (map fromIntegral localWorkRange)) (return.Left)) + +buildProgram :: String -> String -> Context -> DeviceID -> IO (Either (ErrorCode, String) Program) +buildProgram source opts context dID = + clCreateProgramWithSource context source >>= + either (\x -> return $ Left (x, "")) (\program -> clBuildProgram program [dID] opts Nothing nullPtr >>= + maybe (return $ Right program) (\x -> do + y <- fmap Left $ reportBuildFailure program dID x + _ <- clReleaseProgram program + return y)) + +reportBuildFailure :: Program -> DeviceID -> ErrorCode -> IO (ErrorCode,String) +reportBuildFailure program dID eCode = clGetProgramBuildInfo program dID clProgramBuildLog >>= + either (\x -> return (x,"")) (\x -> case x of + (ProgramBuildInfoRetvalString s) -> return (eCode,s) + _ -> undefined) + diff --git a/System/OpenCL/Wrappers/Kernel.hs b/System/OpenCL/Wrappers/Kernel.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Kernel.hs @@ -0,0 +1,103 @@ +module System.OpenCL.Wrappers.Kernel + (clCreateKernel + ,clCreateKernelsInProgram + ,clRetainKernel + ,clReleaseKernel + ,clGetKernelInfo + ,clSetKernelArg + ,clGetKernelWorkGroupInfo + ,clEnqueueNDRangeKernel + ,clEnqueueTask + ,clEnqueueNativeKernel) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign +import Foreign.C +import Control.Applicative +import Data.Maybe + + +clCreateKernel program init_name = withCString init_name (\x -> wrapErrorEither $ raw_clCreateKernel program x) + +clCreateKernelsInProgram :: Program -> CLuint -> IO (Either ErrorCode [Kernel]) +clCreateKernelsInProgram program num_kernels = allocaArray (fromIntegral num_kernels) $ \kernels -> alloca $ \num_kernels_ret -> do + err <- wrapError $ raw_clCreateKernelsInProgram program num_kernels kernels num_kernels_ret + if err== Nothing + then do + nkr <- peek num_kernels_ret + Right <$> peekArray (fromIntegral nkr) kernels + else + return $ Left . fromJust $ err + +clRetainKernel :: Kernel -> IO (Maybe ErrorCode) +clRetainKernel kernel = wrapError $ raw_clRetainKernel kernel + +clReleaseKernel :: Kernel -> IO (Maybe ErrorCode) +clReleaseKernel kernel = wrapError $ raw_clRetainKernel kernel + +clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO (Maybe ErrorCode) +clSetKernelArg kernel arg_index arg_size arg_value = + wrapError $ raw_clSetKernelArg kernel arg_index arg_size arg_value + +clGetKernelInfo :: Kernel -> KernelInfo -> IO (Either ErrorCode CLKernelInfoRetval) +clGetKernelInfo kernel (KernelInfo param_name) = (wrapGetInfo $ raw_clGetKernelInfo kernel param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (KernelInfo param_name) in case () of + () + | c == clKernelFunctionName -> peekStringInfo KernelInfoRetvalString x + | c == clKernelNumArgs -> peekOneInfo KernelInfoRetvalCLuint x + | c == clKernelReferenceCount -> peekOneInfo KernelInfoRetvalCLuint x + | c == clKernelContext -> peekOneInfo KernelInfoRetvalContext x + | c == clKernelProgram -> peekOneInfo KernelInfoRetvalProgram x) + +clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> KernelWorkGroupInfo -> IO (Either ErrorCode CLKernelWorkGroupInfoRetval) +clGetKernelWorkGroupInfo kernel device (KernelWorkGroupInfo param_name) = (wrapGetInfo $ raw_clGetKernelWorkGroupInfo kernel device param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (KernelWorkGroupInfo param_name) in case () of + () + | c == clKernelWorkGroupSize -> peekOneInfo KernelWorkGroupInfoRetvalCLsizei x + | c == clKernelCompileWorkGroupSize -> peekManyInfo KernelWorkGroupInfoRetvalCLsizeiList x size + | c == clKernelLocalMemSize -> peekOneInfo KernelWorkGroupInfoRetvalCLulong x) + +clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> [CLsizei] -> [CLsizei] -> [Event] -> IO (Either ErrorCode Event) +clEnqueueNDRangeKernel queue kernel global_work_sizeL local_work_sizeL event_wait_listL = + withArray global_work_sizeL $ \global_work_size -> + withArrayNull local_work_sizeL $ \local_work_size -> + withArrayNull event_wait_listL $ \event_wait_list -> + alloca $ \event -> do + err <- wrapError $ raw_clEnqueueNDRangeKernel queue kernel (fromIntegral work_dim) nullPtr global_work_size local_work_size (fromIntegral num_events_in_wait_list) event_wait_list event + if err == Nothing + then Right <$> peek event + else return $ Left . fromJust $ err + where work_dim = length global_work_sizeL + num_events_in_wait_list = length event_wait_listL + +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 + +clEnqueueNativeKernel :: NativeKernelCallback -> Ptr () -> CLsizei -> [Mem] -> [Ptr ()] -> [Event] -> IO (Either ErrorCode Event) +clEnqueueNativeKernel user_funcF args cb_args mem_listL args_mem_locL event_wait_listL = + allocaArray num_events_in_wait_list $ \event_wait_list -> + allocaArray num_mem_objects $ \mem_list -> + allocaArray (length args_mem_locL) $ \args_mem_loc -> + alloca $ \event -> do + user_func <- wrapNativeKernelCallback user_funcF + pokeArray event_wait_list event_wait_listL + pokeArray mem_list mem_listL + pokeArray args_mem_loc args_mem_locL + err <- wrapError $ raw_clEnqueueNativeKernel user_func args cb_args (fromIntegral num_mem_objects) mem_list args_mem_loc (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 + num_mem_objects = length mem_listL diff --git a/System/OpenCL/Wrappers/MemoryObject.hs b/System/OpenCL/Wrappers/MemoryObject.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/MemoryObject.hs @@ -0,0 +1,226 @@ +module System.OpenCL.Wrappers.MemoryObject + (clCreateBuffer + ,clCreateImage2D + ,clCreateImage3D + ,clRetainMemObject + ,clReleaseMemObject + ,clGetSupportedImageFormats + ,clGetMemObjectInfo + ,clGetImageInfo + ,clEnqueueReadBuffer + ,clEnqueueWriteBuffer + ,clEnqueueCopyBuffer + ,clEnqueueReadImage + ,clEnqueueWriteImage + ,clEnqueueCopyImage + ,clEnqueueCopyImageToBuffer + ,clEnqueueCopyBufferToImage + ,clEnqueueMapBuffer + ,clEnqueueMapImage + ,clEnqueueUnmapMemObject) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign +import Control.Applicative +import Data.Maybe +import Data.Bits + + +clCreateBuffer :: Context -> MemFlags -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem) +clCreateBuffer ctx (MemFlags flags) size host_ptr = wrapErrorEither $ raw_clCreateBuffer ctx flags size host_ptr + +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 + +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 + +clRetainMemObject :: Mem -> IO (Maybe ErrorCode) +clRetainMemObject mem = wrapError $ raw_clRetainMemObject mem + +clReleaseMemObject :: Mem -> IO (Maybe ErrorCode) +clReleaseMemObject mem = wrapError $ raw_clReleaseMemObject mem + +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 + +clGetMemObjectInfo :: Mem -> MemInfo -> IO (Either ErrorCode CLMemObjectInfoRetval) +clGetMemObjectInfo mem (MemInfo param_name) = (wrapGetInfo $ raw_clGetMemObjectInfo mem param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (MemInfo param_name) in case () of + () + | c == clMemType -> peekOneInfo MemObjectInfoRetvalMemObjectType x + | c == clMemFlags -> peekOneInfo MemObjectInfoRetvalMemFlags x + | c == clMemSize -> peekOneInfo MemObjectInfoRetvalCLsizei x + | c == clMemHostPtr -> peekOneInfo MemObjectInfoRetvalPtr x + | c == clMemMapCount -> peekOneInfo MemObjectInfoRetvalCLuint x + | c == clMemReferenceCount -> peekOneInfo MemObjectInfoRetvalCLuint x + | c == clMemContext -> peekOneInfo MemObjectInfoRetvalContext x) + +clGetImageInfo :: Mem -> MemInfo -> IO (Either ErrorCode CLImageInfoRetval) +clGetImageInfo mem (MemInfo param_name) = (wrapGetInfo $ raw_clGetImageInfo mem param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (MemInfo param_name) in case () of + () + | c == clImageElementSize -> peekOneInfo ImageInfoRetvalCLsizei x + | c == clImageRowPitch -> peekOneInfo ImageInfoRetvalCLsizei x + | c == clImageSlicePitch -> peekOneInfo ImageInfoRetvalCLsizei x + | c == clImageWidth -> peekOneInfo ImageInfoRetvalCLsizei x + | c == clImageHeight -> peekOneInfo ImageInfoRetvalCLsizei x + | c == clImageDepth -> peekOneInfo ImageInfoRetvalCLsizei x) + +enqueue :: (CommandQueue -> CLuint -> Ptr Event -> Ptr Event -> IO CLint) -> CommandQueue -> [Event] -> IO (Either ErrorCode Event) +enqueue fn queue events = alloca $ \event -> withArrayNull events $ \event_wait_list -> do + 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 + + +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) + + +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) + + +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) + +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) + +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) + +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) + + +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) + + +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) + + +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 + +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 + + +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) + diff --git a/System/OpenCL/Wrappers/OutOfOrder.hs b/System/OpenCL/Wrappers/OutOfOrder.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/OutOfOrder.hs @@ -0,0 +1,24 @@ +module System.OpenCL.Wrappers.OutOfOrder + (clEnqueueMarker + ,clEnqueueWaitForEvents + ,clEnqueueBarrier) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign(withArray,peek,alloca) + +clEnqueueMarker :: CommandQueue -> IO (Either ErrorCode Event) +clEnqueueMarker queue = alloca (\eventP -> + wrapError (raw_clEnqueueMarker queue eventP) >>= + maybe (fmap Right $ peek eventP) (return.Left)) + +clEnqueueWaitForEvents :: CommandQueue -> [Event] -> IO (Maybe ErrorCode) +clEnqueueWaitForEvents queue events = + withArray events (\eventsP -> + wrapError $ raw_clEnqueueWaitForEvents queue (fromIntegral num_events) eventsP) + where num_events = length events + +clEnqueueBarrier :: CommandQueue -> IO (Maybe ErrorCode) +clEnqueueBarrier queue = wrapError $ raw_clEnqueueBarrier queue diff --git a/System/OpenCL/Wrappers/PlatformInfo.hs b/System/OpenCL/Wrappers/PlatformInfo.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/PlatformInfo.hs @@ -0,0 +1,17 @@ +module System.OpenCL.Wrappers.PlatformInfo ( + clGetPlatformIDs + , clGetPlatformInfo + ) where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw + + +clGetPlatformIDs :: IO (Either ErrorCode [PlatformID]) +clGetPlatformIDs = wrapGetNumElements raw_clGetPlatformIDs + +clGetPlatformInfo :: PlatformID -> PlatformInfo -> IO (Either ErrorCode CLPlatformInfoRetval) +clGetPlatformInfo mem (PlatformInfo param_name) = wrapGetInfo (raw_clGetPlatformInfo mem param_name) >>= + either (return.Left) (\(x,_) -> fmap Right $ peekStringInfo PlatformInfoRetvalString x) diff --git a/System/OpenCL/Wrappers/ProgramObject.hs b/System/OpenCL/Wrappers/ProgramObject.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/ProgramObject.hs @@ -0,0 +1,87 @@ +module System.OpenCL.Wrappers.ProgramObject + (clCreateProgramWithSource + ,clCreateProgramWithBinary + ,clRetainProgram + ,clReleaseProgram + ,clBuildProgram + ,clUnloadCompiler + ,clGetProgramInfo + ,clGetProgramBuildInfo) +where + +import Control.Monad.Cont +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign +import Foreign.C +import Control.Applicative +import qualified Data.ByteString as SBS +import qualified Data.ByteString.Internal as SBS + +clCreateProgramWithSource :: Context -> String -> IO (Either ErrorCode Program) +clCreateProgramWithSource ctx source_code = do + let count = length strings + strings = lines source_code + lengths = (fromIntegral . length) <$> strings + withArray lengths $ (\lengthsP -> + withCStringArray0 strings $ (\stringsP -> + wrapErrorEither $ raw_clCreateProgramWithSource ctx (fromIntegral count) stringsP lengthsP)) + +clCreateProgramWithBinary :: Context -> [(DeviceID,SBS.ByteString)] -> IO (Either ErrorCode Program) +clCreateProgramWithBinary context devbin_pair = + allocaArray num_devices $ \lengths -> + allocaArray num_devices $ \binaries -> + allocaArray num_devices $ \devices -> + alloca $ \binary_status -> + alloca $ \errcode_ret -> do + pokeArray lengths (map (fromIntegral . SBS.length) bins) + pokeArray devices device_list + pokeArray binaries ((unsafeForeignPtrToPtr . bsPtr) `map` bins) + program <- raw_clCreateProgramWithBinary context (fromIntegral num_devices) devices lengths binaries binary_status errcode_ret + errcode <- ErrorCode <$> peek errcode_ret + binstatus <- ErrorCode <$> peek binary_status + if errcode == clSuccess && binstatus == clSuccess + then return $ Right program + else return $ Left (if errcode == clSuccess then binstatus else errcode) + where bsPtr (SBS.PS p _ _) = p + num_devices = length device_list + (device_list,bins) = unzip devbin_pair + +clRetainProgram :: Program -> IO (Maybe ErrorCode) +clRetainProgram prog = wrapError $ raw_clRetainProgram prog + +clReleaseProgram :: Program -> IO (Maybe ErrorCode) +clReleaseProgram prog = wrapError $ raw_clReleaseProgram prog + +clBuildProgram :: Program -> [DeviceID] -> String -> (Maybe BuildProgramCallback) -> Ptr () -> IO (Maybe ErrorCode) +clBuildProgram program devices ops pfn_notifyF user_data = + allocaArray num_devices $ \device_list -> + withCString ops $ \options -> do + pokeArray device_list devices + pfn_notify <- maybe (return nullFunPtr) wrapBuildProgramCallback pfn_notifyF + wrapError $ raw_clBuildProgram program (fromIntegral num_devices) device_list options pfn_notify user_data + where num_devices = length devices + +clUnloadCompiler :: IO (Maybe ErrorCode) +clUnloadCompiler = wrapError $ raw_clUnloadCompiler + +clGetProgramInfo :: Program -> ProgramInfo -> IO (Either ErrorCode CLProgramInfoRetval) +clGetProgramInfo program (ProgramInfo param_name) = (wrapGetInfo $ raw_clGetProgramInfo program param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (ProgramInfo param_name) in case () of + () + | c == clProgramReferenceCount -> peekOneInfo ProgramInfoRetvalCLUint x + | c == clProgramContext -> peekOneInfo ProgramInfoRetvalContext x + | c == clProgramNumDevices -> peekOneInfo ProgramInfoRetvalCLUint x + | c == clProgramDevices -> peekManyInfo ProgramInfoRetvalDeviceIDList x size + | c == clProgramSource -> peekStringInfo ProgramInfoRetvalString x + | c == clProgramBinarySizes -> peekManyInfo ProgramInfoRetvalCLsizeiList x size + | c == clProgramBinaries -> peekManyInfo ProgramInfoRetvalPtrList x size ) + +clGetProgramBuildInfo :: Program -> DeviceID -> ProgramBuildInfo -> IO (Either ErrorCode CLProgramBuildInfoRetval) +clGetProgramBuildInfo program devID (ProgramBuildInfo param_name) = (wrapGetInfo $ raw_clGetProgramBuildInfo program devID param_name) >>= + either (return.Left) (\(x,_) -> fmap Right $ let c = (ProgramBuildInfo param_name) in case () of + () + | c == clProgramBuildStatus -> peekOneInfo (ProgramBuildInfoRetvalBuildStatus . BuildStatus) x + | True -> peekStringInfo (ProgramBuildInfoRetvalString) x ) diff --git a/System/OpenCL/Wrappers/Raw.hs b/System/OpenCL/Wrappers/Raw.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Raw.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module System.OpenCL.Wrappers.Raw + (raw_clCreateCommandQueue + ,raw_clRetainCommandQueue + ,raw_clReleaseCommandQueue + ,raw_clGetCommandQueueInfo + ,raw_clSetCommandQueueProperty + ,raw_clCreateContext + ,raw_clCreateContextFromType + ,raw_clRetainContext + ,raw_clReleaseContext + ,raw_clGetContextInfo + ,raw_clGetDeviceIDs + ,raw_clGetDeviceInfo + ,raw_clGetExtensionFunctionAddress + ,raw_clWaitForEvents + ,raw_clGetEventInfo + ,raw_clRetainEvent + ,raw_clReleaseEvent + ,raw_clGetEventProfilingInfo + ,raw_clFlush + ,raw_clFinish + ,raw_clCreateKernel + ,raw_clCreateKernelsInProgram + ,raw_clRetainKernel + ,raw_clReleaseKernel + ,raw_clSetKernelArg + ,raw_clGetKernelInfo + ,raw_clGetKernelWorkGroupInfo + ,raw_clEnqueueNDRangeKernel + ,raw_clEnqueueTask + ,raw_clEnqueueNativeKernel + ,raw_clCreateBuffer + ,raw_clCreateImage2D + ,raw_clCreateImage3D + ,raw_clRetainMemObject + ,raw_clReleaseMemObject + ,raw_clGetSupportedImageFormats + ,raw_clGetMemObjectInfo + ,raw_clGetImageInfo + ,raw_clEnqueueReadBuffer + ,raw_clEnqueueWriteBuffer + ,raw_clEnqueueCopyBuffer + ,raw_clEnqueueReadImage + ,raw_clEnqueueWriteImage + ,raw_clEnqueueCopyImage + ,raw_clEnqueueCopyImageToBuffer + ,raw_clEnqueueCopyBufferToImage + ,raw_clEnqueueMapBuffer + ,raw_clEnqueueMapImage + ,raw_clEnqueueUnmapMemObject + ,raw_clEnqueueMarker + ,raw_clEnqueueWaitForEvents + ,raw_clEnqueueBarrier + ,raw_clGetPlatformIDs + ,raw_clGetPlatformInfo + ,raw_clCreateProgramWithSource + ,raw_clCreateProgramWithBinary + ,raw_clRetainProgram + ,raw_clReleaseProgram + ,raw_clBuildProgram + ,raw_clUnloadCompiler + ,raw_clGetProgramInfo + ,raw_clGetProgramBuildInfo + ,raw_clCreateSampler + ,raw_clRetainSampler + ,raw_clReleaseSampler + ,raw_clGetSamplerInfo + --Callback functions + ,wrapContextCallback + ,wrapNativeKernelCallback + ,wrapBuildProgramCallback + ) +where + +import System.OpenCL.Wrappers.Types +--import System.OpenCL.Wrappers.Errors +import Foreign +import Foreign.C + +foreign import ccall "wrapper" wrapContextCallback :: ContextCallback -> IO (FunPtr ContextCallback) +foreign import ccall "wrapper" wrapNativeKernelCallback :: NativeKernelCallback -> IO (FunPtr NativeKernelCallback) +foreign import ccall "wrapper" wrapBuildProgramCallback :: BuildProgramCallback -> IO (FunPtr BuildProgramCallback) + + +foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue :: Context -> DeviceID -> CLbitfield -> Ptr CLint -> IO CommandQueue +foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue :: CommandQueue -> IO CLint +foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue :: CommandQueue -> IO CLint +foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: CommandQueue -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: CommandQueue -> CLbitfield -> CLbool -> Ptr CLbitfield -> IO CLint +foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr (Ptr CLint) -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context +foreign import ccall "clCreateContextFromType" raw_clCreateContextFromType :: Ptr ContextProperties -> CLbitfield -> FunPtr ContextCallback -> Ptr a -> Ptr CLint -> IO Context +foreign import ccall "clRetainContext" raw_clRetainContext :: Context -> IO CLint +foreign import ccall "clReleaseContext" raw_clReleaseContext :: Context -> IO CLint +foreign import ccall "clGetContextInfo" raw_clGetContextInfo :: Context -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clGetDeviceIDs" raw_clGetDeviceIDs :: PlatformID -> CLbitfield -> CLuint -> Ptr DeviceID -> Ptr CLuint -> IO CLint +foreign import ccall "clGetDeviceInfo" raw_clGetDeviceInfo :: DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clGetExtensionFunctionAddress" raw_clGetExtensionFunctionAddress :: CString -> IO (Ptr ()) +foreign import ccall "clWaitForEvents" raw_clWaitForEvents :: CLuint -> Ptr Event -> IO CLint +foreign import ccall "clGetEventInfo" raw_clGetEventInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clRetainEvent" raw_clRetainEvent :: Event -> IO CLint +foreign import ccall "clReleaseEvent" raw_clReleaseEvent :: Event -> IO CLint +foreign import ccall "clGetEventProfilingInfo" raw_clGetEventProfilingInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clFlush" raw_clFlush :: CommandQueue -> IO CLint +foreign import ccall "clFinish" raw_clFinish :: CommandQueue -> IO CLint +foreign import ccall "clCreateKernel" raw_clCreateKernel :: Program -> CString -> Ptr CLint -> IO Kernel +foreign import ccall "clCreateKernelsInProgram" raw_clCreateKernelsInProgram :: Program -> CLuint -> Ptr Kernel -> Ptr CLuint -> IO CLint +foreign import ccall "clRetainKernel" raw_clRetainKernel :: Kernel -> IO CLint +foreign import ccall "clReleaseKernel" raw_clReleaseKernel :: Kernel -> IO CLint +foreign import ccall "clSetKernelArg" raw_clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO CLint +foreign import ccall "clGetKernelInfo" raw_clGetKernelInfo :: Kernel -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clGetKernelWorkGroupInfo" raw_clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clEnqueueNDRangeKernel" raw_clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> CLuint -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueTask" raw_clEnqueueTask :: CommandQueue -> Kernel -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueNativeKernel" raw_clEnqueueNativeKernel :: FunPtr NativeKernelCallback -> Ptr () -> CLsizei -> CLuint -> Ptr Mem -> Ptr (Ptr ()) -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clCreateBuffer" raw_clCreateBuffer :: Context -> CLbitfield -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem +foreign import ccall "clCreateImage2D" raw_clCreateImage2D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem +foreign import ccall "clCreateImage3D" raw_clCreateImage3D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem +foreign import ccall "clRetainMemObject" raw_clRetainMemObject :: Mem -> IO CLint +foreign import ccall "clReleaseMemObject" raw_clReleaseMemObject :: Mem -> IO CLint +foreign import ccall "clGetSupportedImageFormats" raw_clGetSupportedImageFormats :: Context -> CLbitfield -> CLuint -> CLuint -> Ptr CLuint -> Ptr CLuint -> IO CLint +foreign import ccall "clGetMemObjectInfo" raw_clGetMemObjectInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clGetImageInfo" raw_clGetImageInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clEnqueueReadBuffer" raw_clEnqueueReadBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueCopyBuffer" raw_clEnqueueCopyBuffer :: CommandQueue -> Mem -> Mem -> CLsizei -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueReadImage" raw_clEnqueueReadImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueWriteImage" raw_clEnqueueWriteImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueCopyImage" raw_clEnqueueCopyImage :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueCopyImageToBuffer" raw_clEnqueueCopyImageToBuffer :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueCopyBufferToImage" raw_clEnqueueCopyBufferToImage :: CommandQueue -> Mem -> Mem -> CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueMapBuffer" raw_clEnqueueMapBuffer :: CommandQueue -> Mem -> CLbool -> CLbitfield -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> Ptr CLint -> IO (Ptr ()) +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 ()) +foreign import ccall "clEnqueueUnmapMemObject" raw_clEnqueueUnmapMemObject :: CommandQueue -> Mem -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueMarker" raw_clEnqueueMarker :: CommandQueue -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueWaitForEvents" raw_clEnqueueWaitForEvents :: CommandQueue -> CLuint -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueBarrier" raw_clEnqueueBarrier :: CommandQueue -> IO CLint +foreign import ccall "clGetPlatformIDs" raw_clGetPlatformIDs :: CLuint -> Ptr PlatformID -> Ptr CLuint -> IO CLint +foreign import ccall "clGetPlatformInfo" raw_clGetPlatformInfo :: PlatformID -> CLuint -> CSize -> Ptr () -> Ptr CSize -> IO CLint +foreign import ccall "clCreateProgramWithSource" raw_clCreateProgramWithSource :: Context -> CLuint -> Ptr CString -> Ptr CLsizei -> Ptr CLint -> IO Program +foreign import ccall "clCreateProgramWithBinary" raw_clCreateProgramWithBinary :: Context -> CLuint -> Ptr DeviceID -> Ptr CLsizei -> Ptr (Ptr Word8) -> Ptr CLint -> Ptr CLint -> IO Program +foreign import ccall "clRetainProgram" raw_clRetainProgram :: Program -> IO CLint +foreign import ccall "clReleaseProgram" raw_clReleaseProgram :: Program -> IO CLint +foreign import ccall "clBuildProgram" raw_clBuildProgram :: Program -> CLuint -> Ptr DeviceID -> CString -> FunPtr BuildProgramCallback -> Ptr () -> IO CLint +foreign import ccall "clUnloadCompiler" raw_clUnloadCompiler :: IO CLint +foreign import ccall "clGetProgramInfo" raw_clGetProgramInfo :: Program -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clGetProgramBuildInfo" raw_clGetProgramBuildInfo :: Program -> DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint +foreign import ccall "clCreateSampler" raw_clCreateSampler :: Context -> CLbool -> CLuint -> CLuint -> Ptr CLint -> IO Sampler +foreign import ccall "clRetainSampler" raw_clRetainSampler :: Sampler -> IO CLint +foreign import ccall "clReleaseSampler" raw_clReleaseSampler :: Sampler -> IO CLint +foreign import ccall "clGetSamplerInfo" raw_clGetSamplerInfo :: Sampler -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint diff --git a/System/OpenCL/Wrappers/Sampler.hs b/System/OpenCL/Wrappers/Sampler.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Sampler.hs @@ -0,0 +1,37 @@ +module System.OpenCL.Wrappers.Sampler + (clCreateSampler + ,clRetainSampler + ,clReleaseSampler + ,clGetSamplerInfo) +where + +import System.OpenCL.Wrappers.Types +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Utils +import System.OpenCL.Wrappers.Raw +import Foreign +import Foreign.C +import Control.Applicative +import Data.Maybe + + +clCreateSampler :: Context -> Bool -> AddressingMode -> FilterMode -> IO (Either ErrorCode Sampler) +clCreateSampler ctx normalized_coords (AddressingMode addressing_mode) (FilterMode filter_mode) = + wrapErrorEither $ raw_clCreateSampler ctx (if normalized_coords then clTrue else clFalse) addressing_mode filter_mode + +clRetainSampler :: Sampler -> IO (Maybe ErrorCode) +clRetainSampler sampler = wrapError $ raw_clRetainSampler sampler + +clReleaseSampler :: Sampler -> IO (Maybe ErrorCode) +clReleaseSampler sampler = wrapError $ raw_clReleaseSampler sampler + +clGetSamplerInfo :: Sampler -> SamplerInfo -> IO (Either ErrorCode CLSamplerInfoRetval) +clGetSamplerInfo sampler (SamplerInfo param_name) = (wrapGetInfo $ raw_clGetSamplerInfo sampler param_name) >>= + either (return.Left) (\(x,size) -> fmap Right $ let c = (SamplerInfo param_name) in case () of + () + | c == clSamplerReferenceCount -> peekOneInfo SamplerInfoRetvalCLuint x + | c == clSamplerContext -> peekOneInfo SamplerInfoRetvalContext x + | c == clSamplerAddressingMode -> peekOneInfo SamplerInfoRetvalAddressingMode x + | c == clSamplerFilterMode -> peekOneInfo SamplerInfoRetvalFilterMode x + | c == clSamplerNormalizedCoords -> peekOneInfo SamplerInfoRetvalCLbool x) + diff --git a/System/OpenCL/Wrappers/Types.hs b/System/OpenCL/Wrappers/Types.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Types.hs @@ -0,0 +1,658 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-| Declaration of types, bounds and constants -} +module System.OpenCL.Wrappers.Types where + +import Foreign.C.Types +import Foreign.C.String(CString) +import Foreign + +data PlatformIDc = PlatformIDc +data DeviceIDc = DeviceIDc +data Contextc = Contextc +data CommandQueuec = CommandQueuec +data Memc = Memc +data Programc = Programc +data Kernelc = Kernelc +data Eventc = Eventc +data Samplerc = Samplerc +data ImageFormatc = ImageFormatc + +type ContextProperties = Ptr CLint +type PlatformID = Ptr PlatformIDc +type DeviceID = Ptr DeviceIDc +type Context = Ptr Contextc +type CommandQueue = Ptr CommandQueuec +type Mem = Ptr Memc +type Program = Ptr Programc +type Event = Ptr Eventc +type Sampler = Ptr Samplerc +type Kernel = Ptr Kernelc + +type CLsizei = CSize +type CLint = CInt +type CLuint = CUInt +type CLbool = CLuint +type CLulong = CULong +type CLbitfield = CLulong +type ImageFormatp = Ptr ImageFormat + +type ImageFormat = (ChannelOrder,ChannelType) +type ImageDims = (CLsizei,CLsizei,CLsizei) + +newtype ChannelOrder = ChannelOrder CLuint + deriving (Eq) +newtype ChannelType = ChannelType CLuint + deriving (Eq) +newtype DeviceType = DeviceType CLbitfield + deriving (Eq,Storable) +newtype ContextInfo = ContextInfo CLuint + deriving (Eq) +newtype CommandQueueProperties = CommandQueueProperties CLbitfield + deriving (Eq,Storable) +newtype CommandQueueInfo = CommandQueueInfo CLuint + deriving (Eq) +newtype ErrorCode = ErrorCode CLint deriving (Eq,Ord,Show,Read) +newtype EventInfo = EventInfo CLuint + deriving (Eq) +newtype ProfilingInfo = ProfilingInfo CLuint + deriving (Eq) +newtype KernelInfo = KernelInfo CLuint + deriving (Eq) +newtype KernelWorkGroupInfo = KernelWorkGroupInfo CLuint + deriving (Eq) +newtype MapFlags = MapFlags CLbitfield +newtype MemFlags = MemFlags CLbitfield + deriving (Eq,Storable) +newtype MemObjectType = MemObjectType CLuint + deriving (Eq,Storable) +newtype MemInfo = MemInfo CLuint + deriving (Eq) +newtype PlatformInfo = PlatformInfo CLuint + deriving (Eq) +newtype SamplerInfo = SamplerInfo CLuint + deriving (Eq) +newtype AddressingMode = AddressingMode CLuint + deriving (Eq,Storable) +newtype FilterMode = FilterMode CLuint + deriving (Eq,Storable) +newtype ProgramInfo = ProgramInfo CLuint + deriving (Eq) +newtype ProgramBuildInfo = ProgramBuildInfo CLuint + deriving (Eq) +newtype BuildStatus = BuildStatus CLint + deriving (Eq) +newtype DeviceInfo = DeviceInfo CLuint + deriving (Eq) +newtype DeviceFPConfig = DeviceFPConfig CLbitfield + deriving (Eq,Storable) +newtype CommandType = CommandType CLuint + deriving (Eq,Storable) +newtype DeviceExecCapabilities = DeviceExecCapabilities CLbitfield + deriving (Eq,Storable) +newtype DeviceMemCacheType = DeviceMemCacheType CLuint + deriving (Eq,Storable) +newtype DeviceLocalMemType = DeviceLocalMemType CLuint + deriving (Eq,Storable) + +data CLKernelInfoRetval = KernelInfoRetvalString String | KernelInfoRetvalCLuint CLuint | KernelInfoRetvalContext Context | KernelInfoRetvalProgram Program + deriving(Eq) +data CLKernelWorkGroupInfoRetval = KernelWorkGroupInfoRetvalCLsizei CLsizei | KernelWorkGroupInfoRetvalCLsizeiList [CLsizei] | KernelWorkGroupInfoRetvalCLulong CLulong + deriving(Eq) +data CLImageInfoRetval = ImageInfoRetvalCLsizei CLsizei | ImageInfoRetvalImageFormat ImageFormat | ImageInfoRetvalPtr (Ptr ()) + deriving(Eq) +data CLMemObjectInfoRetval = MemObjectInfoRetvalMemObjectType MemObjectType | MemObjectInfoRetvalMemFlags MemFlags | MemObjectInfoRetvalCLsizei CLsizei | MemObjectInfoRetvalPtr (Ptr ()) | MemObjectInfoRetvalCLuint CLuint | MemObjectInfoRetvalContext Context | MemObjectInfoRetvalMem Mem + deriving(Eq) +data CLEventInfoRetval = EventInfoRetvalCommandQueue CommandQueue | EventInfoRetvalContext Context| EventInfoRetvalCommandType CommandType | EventInfoRetvalCLint CLint | EventInfoRetvalCLuint CLuint + deriving(Eq) +data CLEventProfilingInfoRetval = EventProfilingInfoRetvalCLulong CLulong + deriving(Eq) +data CLContextInfoRetval = ContextInfoRetvalCLuint CLuint | ContextInfoRetvalDeviceIDList [DeviceID] | ContextInfoRetvalContextPropertiesList [ContextProperties] + deriving(Eq) +data CLCommandQueueInfoRetval = CommandQueueInfoRetvalContext Context | CommandQueueInfoRetvalDeviceID DeviceID | CommandQueueInfoRetvalCLuint CLuint | CommandQueueInfoRetvalCommandQueueProperties CommandQueueProperties + deriving(Eq) +data CLDeviceInfoRetval = DeviceInfoRetvalString String | DeviceInfoRetvalCLuint CLuint | DeviceInfoRetvalCLbool CLbool | DeviceInfoRetvalDeviceFPConfig DeviceFPConfig | DeviceInfoRetvalDeviceExecCapabilities DeviceExecCapabilities | DeviceInfoRetvalCLulong CLulong | DeviceInfoRetvalDeviceMemCacheType DeviceMemCacheType | DeviceInfoRetvalCLsizei CLsizei | DeviceInfoRetvalDeviceLocalMemType DeviceLocalMemType | DeviceInfoRetvalCLsizeiList [CLsizei] | DeviceInfoRetvalPlatformID PlatformID | DeviceInfoRetvalCommandQueueProperties CommandQueueProperties | DeviceInfoRetvalDeviceType DeviceType + deriving(Eq) +data CLProgramInfoRetval = ProgramInfoRetvalCLUint CLuint | ProgramInfoRetvalContext Context | ProgramInfoRetvalDeviceIDList [DeviceID] | ProgramInfoRetvalString String | ProgramInfoRetvalPtrList [Ptr ()] | ProgramInfoRetvalCLsizeiList [CLsizei] + deriving(Eq) +data CLProgramBuildInfoRetval = ProgramBuildInfoRetvalBuildStatus BuildStatus | ProgramBuildInfoRetvalString String + deriving(Eq) +data CLPlatformInfoRetval = PlatformInfoRetvalString String + deriving(Eq) +data CLSamplerInfoRetval = SamplerInfoRetvalCLuint CLuint | SamplerInfoRetvalContext Context | SamplerInfoRetvalAddressingMode AddressingMode | SamplerInfoRetvalFilterMode FilterMode | SamplerInfoRetvalCLbool CLbool + deriving(Eq) + +type ContextCallback = (CString -> Ptr () -> CLsizei -> Ptr () -> IO ()) +type NativeKernelCallback = Ptr () -> IO () +type BuildProgramCallback = Program -> Ptr () -> IO () + +clQueueOutOfOrderExecModeEnable :: CommandQueueProperties +clQueueOutOfOrderExecModeEnable = CommandQueueProperties (1`shiftL`0) + +clQueueProfilingEnable :: CommandQueueProperties +clQueueProfilingEnable = CommandQueueProperties (1`shiftL`1) + +clQueueContext :: CommandQueueInfo +clQueueContext = CommandQueueInfo 0x1090 + +clQueueDevice :: CommandQueueInfo +clQueueDevice = CommandQueueInfo 0x1091 + +clQueueReferenceCount :: CommandQueueInfo +clQueueReferenceCount = CommandQueueInfo 0x1092 + +clQueueProperties :: CommandQueueInfo +clQueueProperties = CommandQueueInfo 0x1093 + +clDeviceType :: DeviceInfo +clDeviceType = DeviceInfo 0x1000 + +clDeviceVendorID :: DeviceInfo +clDeviceVendorID = DeviceInfo 0x1001 + +clDeviceMaxComputeUnits :: DeviceInfo +clDeviceMaxComputeUnits = DeviceInfo 0x1002 + +clDeviceMaxWorkItemDimensions :: DeviceInfo +clDeviceMaxWorkItemDimensions = DeviceInfo 0x1003 + +clDeviceMaxWorkGroupSize :: DeviceInfo +clDeviceMaxWorkGroupSize = DeviceInfo 0x1004 + +clDeviceMaxWorkItemSizes :: DeviceInfo +clDeviceMaxWorkItemSizes = DeviceInfo 0x1005 + +clDevicePreferredVectorWidthChar :: DeviceInfo +clDevicePreferredVectorWidthChar = DeviceInfo 0x1006 + +clDevicePreferredVectorWidthShort :: DeviceInfo +clDevicePreferredVectorWidthShort = DeviceInfo 0x1007 + +clDevicePreferredVectorWidthInt :: DeviceInfo +clDevicePreferredVectorWidthInt = DeviceInfo 0x1008 + +clDevicePreferredVectorWidthLong :: DeviceInfo +clDevicePreferredVectorWidthLong = DeviceInfo 0x1009 + +clDevicePreferredVectorWidthFloat :: DeviceInfo +clDevicePreferredVectorWidthFloat = DeviceInfo 0x100A + +clDevicePreferredVectorWidthDouble :: DeviceInfo +clDevicePreferredVectorWidthDouble = DeviceInfo 0x100B + +clDeviceMaxClockFrequency :: DeviceInfo +clDeviceMaxClockFrequency = DeviceInfo 0x100C + +clDeviceAddressBits :: DeviceInfo +clDeviceAddressBits = DeviceInfo 0x100D + +clDeviceMaxReadImageArgs :: DeviceInfo +clDeviceMaxReadImageArgs = DeviceInfo 0x100E + +clDeviceMaxWriteImageArgs :: DeviceInfo +clDeviceMaxWriteImageArgs = DeviceInfo 0x100F + +clDeviceMaxMemAllocSize :: DeviceInfo +clDeviceMaxMemAllocSize = DeviceInfo 0x1010 + +clDeviceImage2DMaxWidth :: DeviceInfo +clDeviceImage2DMaxWidth = DeviceInfo 0x1011 + +clDeviceImage2DMaxHeight :: DeviceInfo +clDeviceImage2DMaxHeight = DeviceInfo 0x1012 + +clDeviceImage3DMaxWidth :: DeviceInfo +clDeviceImage3DMaxWidth = DeviceInfo 0x1013 + +clDeviceImage3DMaxHeight :: DeviceInfo +clDeviceImage3DMaxHeight = DeviceInfo 0x1014 + +clDeviceImage3DMaxDepth :: DeviceInfo +clDeviceImage3DMaxDepth = DeviceInfo 0x1015 + +clDeviceImageSupport :: DeviceInfo +clDeviceImageSupport = DeviceInfo 0x1016 + +clDeviceMaxParameterSize :: DeviceInfo +clDeviceMaxParameterSize = DeviceInfo 0x1017 + +clDeviceMaxSamplers :: DeviceInfo +clDeviceMaxSamplers = DeviceInfo 0x1018 + +clDeviceMemBaseAddrAlign :: DeviceInfo +clDeviceMemBaseAddrAlign = DeviceInfo 0x1019 + +clDeviceMinDataTypeAlignSize :: DeviceInfo +clDeviceMinDataTypeAlignSize = DeviceInfo 0x101A + +clDeviceSingleFPConfig :: DeviceInfo +clDeviceSingleFPConfig = DeviceInfo 0x101B + +clDeviceGlobalMemCacheType :: DeviceInfo +clDeviceGlobalMemCacheType = DeviceInfo 0x101C + +clDeviceGlobalMemCacheLineSize :: DeviceInfo +clDeviceGlobalMemCacheLineSize = DeviceInfo 0x101D + +clDeviceGlobalMemCacheSize :: DeviceInfo +clDeviceGlobalMemCacheSize = DeviceInfo 0x101E + +clDeviceGlobalMemSize :: DeviceInfo +clDeviceGlobalMemSize = DeviceInfo 0x101F + +clDeviceMaxConstantBufferSize :: DeviceInfo +clDeviceMaxConstantBufferSize = DeviceInfo 0x1020 + +clDeviceMaxConstantArgs :: DeviceInfo +clDeviceMaxConstantArgs = DeviceInfo 0x1021 + +clDeviceLocalMemType :: DeviceInfo +clDeviceLocalMemType = DeviceInfo 0x1022 + +clDeviceLocalMemSize :: DeviceInfo +clDeviceLocalMemSize = DeviceInfo 0x1023 + +clDeviceErrorCorrectionSupport :: DeviceInfo +clDeviceErrorCorrectionSupport = DeviceInfo 0x1024 + +clDeviceProfilingTimerResolution :: DeviceInfo +clDeviceProfilingTimerResolution = DeviceInfo 0x1025 + +clDeviceEndianLittle :: DeviceInfo +clDeviceEndianLittle = DeviceInfo 0x1026 + +clDeviceAvailable :: DeviceInfo +clDeviceAvailable = DeviceInfo 0x1027 + +clDeviceCompilerAvailable :: DeviceInfo +clDeviceCompilerAvailable = DeviceInfo 0x1028 + +clDeviceExecutionCapabilities :: DeviceInfo +clDeviceExecutionCapabilities = DeviceInfo 0x1029 + +clDeviceQueueProperties :: DeviceInfo +clDeviceQueueProperties = DeviceInfo 0x102A + +clDeviceName :: DeviceInfo +clDeviceName = DeviceInfo 0x102B + +clDeviceVendor :: DeviceInfo +clDeviceVendor = DeviceInfo 0x102C + +clDriverVersion :: DeviceInfo +clDriverVersion = DeviceInfo 0x102D + +clDeviceProfile :: DeviceInfo +clDeviceProfile = DeviceInfo 0x102E + +clDeviceVersion :: DeviceInfo +clDeviceVersion = DeviceInfo 0x102F + +clDeviceExtensions :: DeviceInfo +clDeviceExtensions = DeviceInfo 0x1030 + +clDevicePlatform :: DeviceInfo +clDevicePlatform = DeviceInfo 0x1031 + +clDeviceDoubleFPConfig :: DeviceInfo +clDeviceDoubleFPConfig = DeviceInfo 0x1032 + +clDeviceHalfFPConfig :: DeviceInfo +clDeviceHalfFPConfig = DeviceInfo 0x1033 + + +clFPDenorm :: DeviceFPConfig +clFPDenorm = DeviceFPConfig (1`shiftL`0) + +clFPInfNan :: DeviceFPConfig +clFPInfNan = DeviceFPConfig (1`shiftL`1) + +clFPRoundToNearest :: DeviceFPConfig +clFPRoundToNearest = DeviceFPConfig (1`shiftL`2) + +clFPRoundToZero :: DeviceFPConfig +clFPRoundToZero = DeviceFPConfig (1`shiftL`3) + +clFPRoundToInf :: DeviceFPConfig +clFPRoundToInf = DeviceFPConfig (1`shiftL`4) + +clFPFMA :: DeviceFPConfig +clFPFMA = DeviceFPConfig (1`shiftL`5) + + + +clEventCommandQueue :: EventInfo +clEventCommandQueue = EventInfo 0x11D0 + +clEventCommandType :: EventInfo +clEventCommandType = EventInfo 0x11D1 + +clEventReferenceCount :: EventInfo +clEventReferenceCount = EventInfo 0x11D2 + +clEventCommandExecutionStatus :: EventInfo +clEventCommandExecutionStatus = EventInfo 0x11D3 + + +clProfilingCommandQueued :: ProfilingInfo +clProfilingCommandQueued = ProfilingInfo 0x1280 + +clProfilingCommandSubmit :: ProfilingInfo +clProfilingCommandSubmit = ProfilingInfo 0x1281 + +clProfilingCommandStart :: ProfilingInfo +clProfilingCommandStart = ProfilingInfo 0x1282 + +clProfilingCommandEnd :: ProfilingInfo +clProfilingCommandEnd = ProfilingInfo 0x1283 + + +clFalse = 0 :: CLbool +clTrue = 1 :: CLbool + + +clDeviceTypeDefault :: DeviceType +clDeviceTypeDefault = DeviceType (1`shiftL`0) + +clDeviceTypeCPU :: DeviceType +clDeviceTypeCPU = DeviceType (1`shiftL`1) + +clDeviceTypeGPU :: DeviceType +clDeviceTypeGPU = DeviceType (1`shiftL`2) + +clDeviceTypeAccelerator :: DeviceType +clDeviceTypeAccelerator = DeviceType (1`shiftL`3) + +clDeviceTypeAll :: DeviceType +clDeviceTypeAll = DeviceType 0xFFFFFFFF + + +clContextReferenceCount :: ContextInfo +clContextReferenceCount = ContextInfo 0x1080 + +clContextDevices :: ContextInfo +clContextDevices = ContextInfo 0x1081 + +clContextProperties :: ContextInfo +clContextProperties = ContextInfo 0x1082 + +clContextPlatform = 0x1084 + + + +clKernelFunctionName :: KernelInfo +clKernelFunctionName = KernelInfo 0x1190 + +clKernelNumArgs :: KernelInfo +clKernelNumArgs = KernelInfo 0x1191 + +clKernelReferenceCount :: KernelInfo +clKernelReferenceCount = KernelInfo 0x1192 + +clKernelContext :: KernelInfo +clKernelContext = KernelInfo 0x1193 + +clKernelProgram :: KernelInfo +clKernelProgram = KernelInfo 0x1194 + + +clKernelWorkGroupSize :: KernelWorkGroupInfo +clKernelWorkGroupSize = KernelWorkGroupInfo 0x11B0 + +clKernelCompileWorkGroupSize :: KernelWorkGroupInfo +clKernelCompileWorkGroupSize = KernelWorkGroupInfo 0x11B1 + +clKernelLocalMemSize :: KernelWorkGroupInfo +clKernelLocalMemSize = KernelWorkGroupInfo 0x11B2 + + + +clMemReadWrite :: MemFlags +clMemReadWrite = MemFlags (1 `shiftL` 0) + +clMemWriteOnly :: MemFlags +clMemWriteOnly = MemFlags (1 `shiftL` 1) + +clMemReadOnly :: MemFlags +clMemReadOnly = MemFlags (1 `shiftL` 2) + +clMemUseHostPtr :: MemFlags +clMemUseHostPtr = MemFlags (1 `shiftL` 3) + +clMemAllocHostPtr :: MemFlags +clMemAllocHostPtr = MemFlags (1 `shiftL` 4) + +clMemCopyHostPtr :: MemFlags +clMemCopyHostPtr = MemFlags (1 `shiftL` 5) + + +clR :: ChannelOrder +clR = ChannelOrder 0x10B0 + +clA :: ChannelOrder +clA = ChannelOrder 0x10B1 + +clRG :: ChannelOrder +clRG = ChannelOrder 0x10B2 + +clRA :: ChannelOrder +clRA = ChannelOrder 0x10B3 + +clRGB :: ChannelOrder +clRGB = ChannelOrder 0x10B4 + +clRGBA :: ChannelOrder +clRGBA = ChannelOrder 0x10B5 + +clBGRA :: ChannelOrder +clBGRA = ChannelOrder 0x10B6 + +clARGB :: ChannelOrder +clARGB = ChannelOrder 0x10B7 + +clIntensity :: ChannelOrder +clIntensity = ChannelOrder 0x10B8 + +clLuminance :: ChannelOrder +clLuminance = ChannelOrder 0x10B9 + + +clSNormInt8 :: ChannelType +clSNormInt8 = ChannelType 0x10D0 + +clSNormInt16 :: ChannelType +clSNormInt16 = ChannelType 0x10D1 + +clUNormInt8 :: ChannelType +clUNormInt8 = ChannelType 0x10D2 + +clUNormInt16 :: ChannelType +clUNormInt16 = ChannelType 0x10D3 + +clUNormShort565 :: ChannelType +clUNormShort565 = ChannelType 0x10D4 + +clUNormShort555 :: ChannelType +clUNormShort555 = ChannelType 0x10D5 + +clUNormInt101010 :: ChannelType +clUNormInt101010 = ChannelType 0x10D6 + +clSignedInt8 :: ChannelType +clSignedInt8 = ChannelType 0x10D7 + +clSignedInt16 :: ChannelType +clSignedInt16 = ChannelType 0x10D8 + +clSignedInt32 :: ChannelType +clSignedInt32 = ChannelType 0x10D9 + +clUnsignedInt8 :: ChannelType +clUnsignedInt8 = ChannelType 0x10DA + +clUnsignedInt16 :: ChannelType +clUnsignedInt16 = ChannelType 0x10DB + +clUnsignedInt32 :: ChannelType +clUnsignedInt32 = ChannelType 0x10DC + +clHalfFloat :: ChannelType +clHalfFloat = ChannelType 0x10DD + +clFloat :: ChannelType +clFloat = ChannelType 0x10DE + + +clMemObjectBuffer :: MemObjectType +clMemObjectBuffer = MemObjectType 0x10F0 + +clMemObjectImage2D :: MemObjectType +clMemObjectImage2D = MemObjectType 0x10F1 + +clMemObjectImage3D :: MemObjectType +clMemObjectImage3D = MemObjectType 0x10F2 + + +clMemType :: MemInfo +clMemType = MemInfo 0x1100 + +clMemFlags :: MemInfo +clMemFlags = MemInfo 0x1101 + +clMemSize :: MemInfo +clMemSize = MemInfo 0x1102 + +clMemHostPtr :: MemInfo +clMemHostPtr = MemInfo 0x1103 + +clMemMapCount :: MemInfo +clMemMapCount = MemInfo 0x1104 + +clMemReferenceCount :: MemInfo +clMemReferenceCount = MemInfo 0x1105 + +clMemContext :: MemInfo +clMemContext = MemInfo 0x1106 + + +clImageFormat :: MemInfo +clImageFormat = MemInfo 0x1110 + +clImageElementSize :: MemInfo +clImageElementSize = MemInfo 0x1111 + +clImageRowPitch :: MemInfo +clImageRowPitch = MemInfo 0x1112 + +clImageSlicePitch :: MemInfo +clImageSlicePitch = MemInfo 0x1113 + +clImageWidth :: MemInfo +clImageWidth = MemInfo 0x1114 + +clImageHeight :: MemInfo +clImageHeight = MemInfo 0x1115 + +clImageDepth :: MemInfo +clImageDepth = MemInfo 0x1116 + + +clMapRead :: MapFlags +clMapRead = MapFlags (1 `shiftL` 0) + +clMapWrite :: MapFlags +clMapWrite = MapFlags (1 `shiftL` 1) + + +clPlatformProfile :: PlatformInfo +clPlatformProfile = PlatformInfo 0x0900 + +clPlatformVersion :: PlatformInfo +clPlatformVersion = PlatformInfo 0x0901 + +clPlatformName :: PlatformInfo +clPlatformName = PlatformInfo 0x0902 + +clPlatformVendor :: PlatformInfo +clPlatformVendor = PlatformInfo 0x0903 + + +clPlatformExtensions :: PlatformInfo +clPlatformExtensions = PlatformInfo 0x0904 + +clProgramReferenceCount :: ProgramInfo +clProgramReferenceCount = ProgramInfo 0x1160 + +clProgramContext :: ProgramInfo +clProgramContext = ProgramInfo 0x1161 + +clProgramNumDevices :: ProgramInfo +clProgramNumDevices = ProgramInfo 0x1162 + +clProgramDevices :: ProgramInfo +clProgramDevices = ProgramInfo 0x1163 + +clProgramSource :: ProgramInfo +clProgramSource = ProgramInfo 0x1164 + +clProgramBinarySizes :: ProgramInfo +clProgramBinarySizes = ProgramInfo 0x1165 + +clProgramBinaries :: ProgramInfo +clProgramBinaries = ProgramInfo 0x1166 + + +clProgramBuildStatus :: ProgramBuildInfo +clProgramBuildStatus = ProgramBuildInfo 0x1181 + +clProgramBuildOptions :: ProgramBuildInfo +clProgramBuildOptions = ProgramBuildInfo 0x1182 + +clProgramBuildLog :: ProgramBuildInfo +clProgramBuildLog = ProgramBuildInfo 0x1183 + + +clBuildSuccess :: BuildStatus +clBuildSuccess = BuildStatus 0 + +clBuildNone :: BuildStatus +clBuildNone = BuildStatus (-1) + +clBuildError :: BuildStatus +clBuildError = BuildStatus (-2) + +clBuildInProgress :: BuildStatus +clBuildInProgress = BuildStatus (-3) + + + +clAddressNone :: AddressingMode +clAddressNone = AddressingMode 0x1130 + +clAddressClampToEdge :: AddressingMode +clAddressClampToEdge = AddressingMode 0x1131 + +clAddressClamp :: AddressingMode +clAddressClamp = AddressingMode 0x1132 + +clAddressRepeat :: AddressingMode +clAddressRepeat = AddressingMode 0x1133 + +clFilterNearest = FilterMode 0x1140 +clFilterLinear = FilterMode 0x1141 + + +clSamplerReferenceCount :: SamplerInfo +clSamplerReferenceCount = SamplerInfo 0x1150 + +clSamplerContext :: SamplerInfo +clSamplerContext = SamplerInfo 0x1151 + +clSamplerNormalizedCoords :: SamplerInfo +clSamplerNormalizedCoords = SamplerInfo 0x1152 + +clSamplerAddressingMode :: SamplerInfo +clSamplerAddressingMode = SamplerInfo 0x1153 + +clSamplerFilterMode :: SamplerInfo +clSamplerFilterMode = SamplerInfo 0x1154 + diff --git a/System/OpenCL/Wrappers/Utils.hs b/System/OpenCL/Wrappers/Utils.hs new file mode 100644 --- /dev/null +++ b/System/OpenCL/Wrappers/Utils.hs @@ -0,0 +1,72 @@ +{-| OpenCL utility functions for improving FFI wrapper code. -} +module System.OpenCL.Wrappers.Utils where + +import Foreign +import Foreign.C +import System.OpenCL.Wrappers.Errors +import System.OpenCL.Wrappers.Types +import Control.Applicative +import Data.Maybe +import Control.Monad.Cont +import Data.Bits((.|.)) +import Unsafe.Coerce(unsafeCoerce) + +wrapError :: IO CLint -> IO (Maybe ErrorCode) +wrapError thunk = thunk >>= \errcode -> if ErrorCode errcode == clSuccess then return Nothing else return . Just . ErrorCode $ errcode + +wrapErrorEither :: (Ptr CLint -> IO a) -> IO (Either ErrorCode a) +wrapErrorEither thunk = alloca $ \errorP -> do + ret <- thunk errorP + err <- ErrorCode <$> peek errorP + if err == clSuccess + then return . Right $ ret + else return . Left $ err + +wrapGetInfo :: (CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint) -> IO (Either ErrorCode (ForeignPtr (), CLsizei)) +wrapGetInfo raw_infoFn = alloca $ \value_size_ret -> + wrapError (raw_infoFn 0 nullPtr value_size_ret) >>= + maybe (do retsize <- peek value_size_ret + param_data <- (mallocForeignPtrBytes . fromIntegral $ retsize) :: IO (ForeignPtr ()) + wrapError (withForeignPtr param_data $ \param_dataP -> raw_infoFn retsize param_dataP nullPtr) >>= + maybe (return (Right (param_data,retsize))) (return.Left)) + (return.Left) + +wrapGetNumElements :: Storable a => (CLuint -> Ptr a -> Ptr CLuint -> IO CLint) -> IO (Either ErrorCode [a]) +wrapGetNumElements raw_Fn = alloca (\value_size_ret -> + wrapError (raw_Fn 0 nullPtr value_size_ret) >>= + maybe (do + retsize <- peek value_size_ret + allocaArray (fromIntegral retsize) + (\param_dataP -> wrapError (raw_Fn retsize param_dataP nullPtr) >>= + maybe (fmap Right $ peekArray (fromIntegral retsize) param_dataP) (return.Left))) + (return.Left)) + +withArrayNull0 a as = withArrayNull $ as ++ [a] + +withArrayNull :: Storable a => [a] -> (Ptr a -> IO b) -> IO b +withArrayNull as f = if null as + then f nullPtr + else withArray as f + +nest :: [(r -> a) -> a] -> ([r] -> a) -> a +nest xs = runCont (sequence (map cont xs)) + +withCStringArray0 :: [String] -> (Ptr CString -> IO a) -> IO a +withCStringArray0 strings act = nest (map withCString strings) + (\rs -> withArray0 nullPtr rs act) + +peekOneInfo :: Storable a => (a -> b) -> ForeignPtr () -> IO b +peekOneInfo f x = withForeignPtr x (\y -> fmap f (peek $ castPtr y)) + +peekManyInfo :: Storable a => ([a] -> b) -> ForeignPtr () -> CLsizei -> IO b +peekManyInfo f x size = do + c <- return undefined + a <- withForeignPtr x (\y -> (peekArray ( div (fromIntegral size) $ sizeOf c) $ castPtr y)) + return (c:a) + return $ f a + +peekStringInfo :: (String -> b) -> ForeignPtr () -> IO b +peekStringInfo f x = withForeignPtr x (\y -> fmap f (peekCString $ castPtr y)) + +combineOr :: [a] -> a +combineOr x = unsafeCoerce $ foldl (\x y -> x .|. unsafeCoerce y) (0 :: CLuint) x