Skip to content
Snippets Groups Projects
Commit c1341076 authored by Luis Cabellos's avatar Luis Cabellos
Browse files

Merge branch 'develop'

parents 62ff3600 50398c84
No related branches found
Tags 1.0.3.0
No related merge requests found
Showing
with 2502 additions and 93 deletions
Name: OpenCL
Version: 1.0.2.6
Version: 1.0.3.0
License: BSD3
License-File: LICENSE
Author: Luis Cabellos
......@@ -36,39 +36,41 @@ Library
ghc-options: -Wall
Build-Depends: base >=4.0 && < 5, bytestring -any, mtl==2.0.*
Exposed-Modules:
System.GPU.OpenCL
System.GPU.OpenCL.Query
System.GPU.OpenCL.Context
System.GPU.OpenCL.CommandQueue
System.GPU.OpenCL.Memory
System.GPU.OpenCL.Event
System.GPU.OpenCL.Program
Control.Parallel.OpenCL
Control.Parallel.OpenCL.Query
Control.Parallel.OpenCL.Context
Control.Parallel.OpenCL.CommandQueue
Control.Parallel.OpenCL.Memory
Control.Parallel.OpenCL.Event
Control.Parallel.OpenCL.Program
Other-Modules:
System.GPU.OpenCL.Types
Control.Parallel.OpenCL.Types
if os(linux)
cpp-options: -DCALLCONV=ccall -Iinclude
Frameworks: OpenCL
if os(darwin)
cpp-options: "-U__BLOCKS__"
if os(windows)
cpp-options: "-DCALLCONV=stdcall"
else
cpp-options: "-DCALLCONV=ccall"
cpp-options: -DCALLCONV=ccall
cc-options: "-U__BLOCKS__"
Frameworks: OpenCL
cpp-options: -Iinclude
if os(windows)
cpp-options: -DCALLCONV=stdcall
Test-suite tests
type: exitcode-stdio-1.0
main-is: test-opencl.hs
hs-Source-Dirs: src/test
ghc-options: -Wall
extra-libraries: OpenCL
build-depends: base >=4.0 && < 5, QuickCheck==2.4.0.*, OpenCL
-- Uncomment the following line to build tests on Linux or Windows:
-- extra-libraries: OpenCL
build-depends: base >=4.0 && < 5, QuickCheck==2.4.*, OpenCL
source-repository this
type: git
location: https://zhensydow@github.com/zhensydow/opencl.git
tag: 1.0.2.6
tag: 1.0.3.0
branch: master
source-repository head
......
......@@ -4,6 +4,8 @@
Based on the [[http://hackage.haskell.org/package/OpenCLRaw][OpenCLRaw]] package by J.R. Heard.
By Luis Cabellos at [[http://www.ifca.es/en/home2][IFCA]]
** Installation
*Requirements:* [[http://hackage.haskell.org/package/c2hs][c2hs]] must be installed. (Try ~cabal install c2hs~.)
......@@ -14,6 +16,16 @@
Programs using the library must link against OpenCL; for example, by
passing ~-lOpenCL~ to GHC.
*** About versioning
OpenCL module uses Package Version Policy:
http://www.haskell.org/haskellwiki/Package_versioning_policy
But It differs in the A version number. It use OpenCL API version as A
number, so 1.0.3.0 correspond to A=1.0=OpenCL API version 1.0, B=3 and
C=0. The major version number is 1.0.3
** Optional Requisites
Some OpenCL libraries require additional NUMA libraries. For instance,
on Ubuntu 11.04:
......
......@@ -29,7 +29,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import System.GPU.OpenCL
import Control.Parallel.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( newArray, peekArray )
......@@ -42,7 +42,7 @@ main = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
context <- clCreateContext [CL_CONTEXT_PLATFORM platform] [dev] print
q <- clCreateCommandQueue context dev []
-- Initialize Kernel
......@@ -60,8 +60,8 @@ main = do
mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArg kernel 0 mem_in
clSetKernelArg kernel 1 mem_out
clSetKernelArgSto kernel 0 mem_in
clSetKernelArgSto kernel 1 mem_out
-- Execute Kernel
eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []
......
......@@ -29,7 +29,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import System.GPU.OpenCL
import Control.Parallel.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( peekArray, withArray )
......@@ -47,7 +47,7 @@ main = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
context <- clCreateContext [] [dev] print
q <- clCreateCommandQueue context dev [CL_QUEUE_PROFILING_ENABLE]
-- Initialize Kernel
......@@ -74,8 +74,8 @@ executeArray original ctx q krn = withArray original $ \input -> do
mem_in <- clCreateBuffer ctx [CL_MEM_READ_ONLY] (vecSize, nullPtr)
mem_out <- clCreateBuffer ctx [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArg krn 0 mem_in
clSetKernelArg krn 1 mem_out
clSetKernelArgSto krn 0 mem_in
clSetKernelArgSto krn 1 mem_out
-- Put Input
eventWrite <- clEnqueueWriteBuffer q mem_in True 0 vecSize (castPtr input) []
......
......@@ -29,7 +29,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import System.GPU.OpenCL
import Control.Parallel.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( newArray, peekArray )
......@@ -45,7 +45,7 @@ main = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
context <- clCreateContext [] [dev] print
q <- clCreateCommandQueue context dev []
-- Initialize Kernels
......@@ -70,14 +70,14 @@ main = do
mem_out1 <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
mem_out2 <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArg kernel1 0 mem_in
clSetKernelArg kernel1 1 mem_mid
clSetKernelArgSto kernel1 0 mem_in
clSetKernelArgSto kernel1 1 mem_mid
clSetKernelArg kernel2 0 mem_mid
clSetKernelArg kernel2 1 mem_out1
clSetKernelArgSto kernel2 0 mem_mid
clSetKernelArgSto kernel2 1 mem_out1
clSetKernelArg kernel3 0 mem_mid
clSetKernelArg kernel3 1 mem_out2
clSetKernelArgSto kernel3 0 mem_mid
clSetKernelArgSto kernel3 1 mem_out2
-- Execute Kernels
eventExec1 <- clEnqueueNDRangeKernel q kernel1 [length original] [1] []
......
......@@ -29,7 +29,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import System.GPU.OpenCL
import Control.Parallel.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( newArray, peekArray )
......@@ -42,7 +42,7 @@ main = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
context <- clCreateContext [] [dev] print
q <- clCreateCommandQueue context dev []
-- Compile and get binaries
......@@ -65,8 +65,8 @@ main = do
mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArg kernel 0 mem_in
clSetKernelArg kernel 1 mem_out
clSetKernelArgSto kernel 0 mem_in
clSetKernelArgSto kernel 1 mem_out
-- Execute Kernel
eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []
......
......@@ -30,7 +30,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import qualified Control.Exception as Ex( catch )
import System.GPU.OpenCL
import Control.Parallel.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CDouble )
import Foreign.Marshal.Array( newArray, peekArray )
......@@ -44,7 +44,7 @@ main = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
context <- clCreateContext [] [dev] print
q <- clCreateCommandQueue context dev []
-- Initialize Kernel
......@@ -69,8 +69,8 @@ main = do
mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArg kernel 0 mem_in
clSetKernelArg kernel 1 mem_out
clSetKernelArgSto kernel 0 mem_in
clSetKernelArgSto kernel 1 mem_out
-- Execute Kernel
eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []
......
{- Copyright (c) 2011 Luis Cabellos,
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import Control.Parallel.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( newArray, peekArray )
programSource :: String
programSource = "__kernel void duparray(__global float *in, __global float *out, __local float *tmp ){\n int id = get_global_id(0);\n out[id] = 2*in[id];\n}"
main :: IO ()
main = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [] [dev] print
q <- clCreateCommandQueue context dev []
-- Initialize Kernel
program <- clCreateProgramWithSource context programSource
clBuildProgram program [dev] ""
kernel <- clCreateKernel program "duparray"
-- Initialize parameters
let original = [0 .. 20] :: [CFloat]
elemSize = sizeOf (0 :: CFloat)
vecSize = elemSize * length original
putStrLn $ "Original array = " ++ show original
input <- newArray original
mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArgSto kernel 0 mem_in
clSetKernelArgSto kernel 1 mem_out
clSetKernelArg kernel 2 4 nullPtr
-- Execute Kernel
eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []
-- Get Result
eventRead <- clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]
result <- peekArray (length original) input
putStrLn $ "Result array = " ++ show result
return ()
......@@ -29,27 +29,27 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
module System.GPU.OpenCL(
module Control.Parallel.OpenCL(
-- * Basic Types
CLError(..), CLint, CLuint, CLulong,
-- * Modules
module System.GPU.OpenCL.Query,
module System.GPU.OpenCL.Context,
module System.GPU.OpenCL.CommandQueue,
module System.GPU.OpenCL.Memory,
module System.GPU.OpenCL.Event,
module System.GPU.OpenCL.Program
module Control.Parallel.OpenCL.Query,
module Control.Parallel.OpenCL.Context,
module Control.Parallel.OpenCL.CommandQueue,
module Control.Parallel.OpenCL.Memory,
module Control.Parallel.OpenCL.Event,
module Control.Parallel.OpenCL.Program
)
where
-- -----------------------------------------------------------------------------
import System.GPU.OpenCL.Query
import System.GPU.OpenCL.Context
import System.GPU.OpenCL.CommandQueue
import System.GPU.OpenCL.Memory
import System.GPU.OpenCL.Event
import System.GPU.OpenCL.Program
import System.GPU.OpenCL.Types(
import Control.Parallel.OpenCL.Query
import Control.Parallel.OpenCL.Context
import Control.Parallel.OpenCL.CommandQueue
import Control.Parallel.OpenCL.Memory
import Control.Parallel.OpenCL.Event
import Control.Parallel.OpenCL.Program
import Control.Parallel.OpenCL.Types(
CLError(..), CLint, CLuint, CLulong )
-- -----------------------------------------------------------------------------
......@@ -30,27 +30,31 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module System.GPU.OpenCL.Context(
module Control.Parallel.OpenCL.Context(
-- * Types
CLContext,
CLContext, CLContextProperty(..),
-- * Context Functions
clCreateContext, clCreateContextFromType, clRetainContext, clReleaseContext,
clGetContextReferenceCount, clGetContextDevices )
clGetContextReferenceCount, clGetContextDevices, clGetContextProperties )
where
-- -----------------------------------------------------------------------------
import Foreign(
Ptr, FunPtr, nullPtr, castPtr, alloca, allocaArray, peek, peekArray,
pokeArray )
ptrToIntPtr, intPtrToPtr, withArray )
import Foreign.C.Types( CSize )
import Foreign.C.String( CString, peekCString )
import Foreign.Storable( sizeOf )
import System.GPU.OpenCL.Types(
import Control.Parallel.OpenCL.Types(
CLuint, CLint, CLDeviceType_, CLContextInfo_, CLContextProperty_, CLDeviceID,
CLContext, CLDeviceType, bitmaskFromFlags, getCLValue,
CLContext, CLDeviceType, CLPlatformID, bitmaskFromFlags, getCLValue, getEnumCL,
whenSuccess, wrapCheckSuccess, wrapPError, wrapGetInfo )
#ifdef __APPLE__
#include <OpenCL/opencl.h>
#else
#include <CL/cl.h>
#endif
-- -----------------------------------------------------------------------------
type ContextCallback = CString -> Ptr () -> CSize -> Ptr () -> IO ()
......@@ -69,6 +73,36 @@ foreign import CALLCONV "clReleaseContext" raw_clReleaseContext ::
foreign import CALLCONV "clGetContextInfo" raw_clGetContextInfo ::
CLContext -> CLContextInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
-- -----------------------------------------------------------------------------
#c
enum CLContextProperties {
cL_CONTEXT_PLATFORM_=CL_CONTEXT_PLATFORM,
};
#endc
{#enum CLContextProperties {upcaseFirstLetter} #}
-- | Specifies a context property name and its corresponding value.
data CLContextProperty = CL_CONTEXT_PLATFORM CLPlatformID
-- ^ Specifies the platform to use.
deriving( Show )
packContextProperties :: [CLContextProperty] -> [CLContextProperty_]
packContextProperties [] = [0]
packContextProperties (CL_CONTEXT_PLATFORM pid : xs) = getCLValue CL_CONTEXT_PLATFORM_
: (fromIntegral . ptrToIntPtr $ pid)
: packContextProperties xs
unpackContextProperties :: [CLContextProperty_] -> [CLContextProperty]
unpackContextProperties [] = error "non-exhaustive Context Property list"
unpackContextProperties [x]
| x == 0 = []
| otherwise = error "non-exhaustive Context Property list"
unpackContextProperties (x:y:xs) = let ys = unpackContextProperties xs
in case getEnumCL x of
CL_CONTEXT_PLATFORM_
-> CL_CONTEXT_PLATFORM
(intPtrToPtr . fromIntegral $ y) : ys
-- -----------------------------------------------------------------------------
mkContextCallback :: (String -> IO ()) -> ContextCallback
mkContextCallback f msg _ _ _ = peekCString msg >>= f
......@@ -78,25 +112,37 @@ mkContextCallback f msg _ _ _ = peekCString msg >>= f
-- the OpenCL runtime for managing objects such as command-queues, memory,
-- program and kernel objects and for executing kernels on one or more devices
-- specified in the context.
clCreateContext :: [CLDeviceID] -> (String -> IO ()) -> IO CLContext
clCreateContext devs f = allocaArray ndevs $ \pdevs -> do
pokeArray pdevs devs
clCreateContext :: [CLContextProperty] -> [CLDeviceID] -> (String -> IO ())
-> IO CLContext
clCreateContext [] devs f = withArray devs $ \pdevs ->
wrapPError $ \perr -> do
fptr <- wrapContextCallback $ mkContextCallback f
raw_clCreateContext nullPtr cndevs pdevs fptr nullPtr perr
where
ndevs = length devs
cndevs = fromIntegral ndevs
cndevs = fromIntegral . length $ devs
clCreateContext props devs f = withArray devs $ \pdevs ->
wrapPError $ \perr -> do
fptr <- wrapContextCallback $ mkContextCallback f
withArray (packContextProperties props) $ \pprops ->
raw_clCreateContext pprops cndevs pdevs fptr nullPtr perr
where
cndevs = fromIntegral . length $ devs
-- | Create an OpenCL context from a device type that identifies the specific
-- device(s) to use.
clCreateContextFromType :: [CLDeviceType] -> (String -> IO ())
-> IO CLContext
clCreateContextFromType xs f = wrapPError $ \perr -> do
clCreateContextFromType :: [CLContextProperty] -> [CLDeviceType]
-> (String -> IO ()) -> IO CLContext
clCreateContextFromType [] xs f = wrapPError $ \perr -> do
fptr <- wrapContextCallback $ mkContextCallback f
raw_clCreateContextFromType nullPtr types fptr nullPtr perr
where
types = bitmaskFromFlags xs
clCreateContextFromType props xs f = wrapPError $ \perr -> do
fptr <- wrapContextCallback $ mkContextCallback f
withArray (packContextProperties props) $ \pprops ->
raw_clCreateContextFromType pprops types fptr nullPtr perr
where
types = bitmaskFromFlags xs
-- | Increment the context reference count.
-- 'clCreateContext' and 'clCreateContextFromType' perform an implicit retain.
......@@ -161,4 +207,18 @@ clGetContextDevices ctx = do
infoid = getCLValue CL_CONTEXT_DEVICES
elemSize = sizeOf (nullPtr :: CLDeviceID)
clGetContextProperties :: CLContext -> IO [CLContextProperty]
clGetContextProperties ctx = do
size <- getContextInfoSize ctx infoid
let n = (fromIntegral size) `div` elemSize
if n == 0
then return []
else allocaArray n $ \(buff :: Ptr CLContextProperty_) ->
whenSuccess (raw_clGetContextInfo ctx infoid size (castPtr buff) nullPtr)
$ fmap unpackContextProperties $ peekArray n buff
where
infoid = getCLValue CL_CONTEXT_PROPERTIES
elemSize = sizeOf (nullPtr :: CLDeviceID)
-- -----------------------------------------------------------------------------
......@@ -30,7 +30,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module System.GPU.OpenCL.Event(
module Control.Parallel.OpenCL.Event(
-- * Types
CLEvent, CLCommandType(..), CLProfilingInfo(..), CLCommandExecutionStatus(..),
-- * Functions
......@@ -42,13 +42,17 @@ module System.GPU.OpenCL.Event(
-- -----------------------------------------------------------------------------
import Foreign
import Foreign.C.Types
import System.GPU.OpenCL.Types(
import Control.Parallel.OpenCL.Types(
CLEvent, CLint, CLuint, CLulong, CLEventInfo_, CLProfilingInfo_,
CLCommandQueue, CLCommandType(..), CLCommandType_,
CLCommandExecutionStatus(..), CLProfilingInfo(..), getCommandExecutionStatus,
getCLValue, getEnumCL, wrapCheckSuccess, wrapGetInfo )
#ifdef __APPLE__
#include <OpenCL/opencl.h>
#else
#include <CL/cl.h>
#endif
-- -----------------------------------------------------------------------------
foreign import CALLCONV "clWaitForEvents" raw_clWaitForEvents ::
......
......@@ -30,7 +30,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module System.GPU.OpenCL.Program(
module Control.Parallel.OpenCL.Program(
-- * Types
CLProgram, CLBuildStatus(..), CLKernel,
-- * Program Functions
......@@ -42,7 +42,7 @@ module System.GPU.OpenCL.Program(
clGetProgramBuildLog,
-- * Kernel Functions
clCreateKernel, clCreateKernelsInProgram, clRetainKernel, clReleaseKernel,
clSetKernelArg, clGetKernelFunctionName, clGetKernelNumArgs,
clSetKernelArg, clSetKernelArgSto, clGetKernelFunctionName, clGetKernelNumArgs,
clGetKernelReferenceCount, clGetKernelContext, clGetKernelProgram,
clGetKernelWorkGroupSize, clGetKernelCompileWorkGroupSize,
clGetKernelLocalMemSize
......@@ -53,13 +53,17 @@ import Control.Monad( zipWithM, forM )
import Foreign
import Foreign.C.Types
import Foreign.C.String( CString, withCString, peekCString )
import System.GPU.OpenCL.Types(
import Control.Parallel.OpenCL.Types(
CLint, CLuint, CLulong, CLProgram, CLContext, CLKernel, CLDeviceID, CLError,
CLProgramInfo_, CLBuildStatus(..), CLBuildStatus_, CLProgramBuildInfo_,
CLKernelInfo_, CLKernelWorkGroupInfo_, wrapCheckSuccess,
whenSuccess, wrapPError, wrapGetInfo, getCLValue, getEnumCL )
#ifdef __APPLE__
#include <OpenCL/opencl.h>
#else
#include <CL/cl.h>
#endif
-- -----------------------------------------------------------------------------
type BuildCallback = CLProgram -> Ptr () -> IO ()
......@@ -682,8 +686,14 @@ object and arg_size != sizeof(cl_mem) or if arg_size is zero and the argument is
declared with the __local qualifier or if the argument is a sampler and arg_size
!= sizeof(cl_sampler).
-}
clSetKernelArg :: Storable a => CLKernel -> CLuint -> a -> IO ()
clSetKernelArg krn idx val = with val $ \pval -> do
clSetKernelArg :: Integral a => CLKernel -> CLuint -> a -> Ptr b -> IO ()
clSetKernelArg krn idx sz pval = do
whenSuccess (raw_clSetKernelArg krn idx (fromIntegral sz) (castPtr pval))
$ return ()
-- | Wrap function of `clSetKernelArg` with Storable data.
clSetKernelArgSto :: Storable a => CLKernel -> CLuint -> a -> IO ()
clSetKernelArgSto krn idx val = with val $ \pval -> do
whenSuccess (raw_clSetKernelArg krn idx (fromIntegral . sizeOf $ val) (castPtr pval))
$ return ()
......
......@@ -30,7 +30,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module System.GPU.OpenCL.Query(
module Control.Parallel.OpenCL.Query(
-- * Types
CLPlatformInfo(..), CLPlatformID, CLDeviceID, CLDeviceType(..),
CLDeviceFPConfig(..), CLDeviceExecCapability(..), CLDeviceLocalMemType(..),
......@@ -69,7 +69,7 @@ import Foreign( Ptr, nullPtr, castPtr, alloca, allocaArray, peek, peekArray )
import Foreign.C.String( CString, peekCString )
import Foreign.C.Types( CSize )
import Foreign.Storable( sizeOf )
import System.GPU.OpenCL.Types(
import Control.Parallel.OpenCL.Types(
CLbool, CLint, CLuint, CLulong, CLPlatformInfo_, CLDeviceType_,
CLDeviceInfo_, CLDeviceFPConfig(..), CLDeviceExecCapability(..),
CLDeviceLocalMemType(..), CLDeviceMemCacheType(..), CLPlatformInfo(..),
......@@ -87,7 +87,11 @@ foreign import CALLCONV "clGetDeviceIDs" raw_clGetDeviceIDs ::
foreign import CALLCONV "clGetDeviceInfo" raw_clGetDeviceInfo ::
CLDeviceID -> CLDeviceInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint
#ifdef __APPLE__
#include <OpenCL/opencl.h>
#else
#include <CL/cl.h>
#endif
-- -----------------------------------------------------------------------------
getNumPlatforms :: IO CLuint
......
......@@ -30,13 +30,13 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-# LANGUAGE DeriveDataTypeable #-}
module System.GPU.OpenCL.Types(
module Control.Parallel.OpenCL.Types(
-- * Symple CL Types
CLbool, CLint, CLuint, CLulong, CLProgram, CLEvent, CLMem, CLPlatformID,
CLDeviceID, CLContext, CLCommandQueue, CLPlatformInfo_, CLDeviceType_,
CLDeviceInfo_, CLContextInfo_, CLContextProperty_, CLCommandQueueInfo_,
CLEventInfo_, CLProfilingInfo_, CLCommandType_, CLCommandQueueProperty_,
CLMemFlags_, CLImageFormat_p, CLMemObjectType_, CLMemInfo_, CLImageInfo_,
CLMemFlags_, CLMemObjectType_, CLMemInfo_, CLImageInfo_, CLMapFlags_,
CLProgramInfo_, CLBuildStatus_,CLKernel, CLProgramBuildInfo_, CLKernelInfo_,
CLKernelWorkGroupInfo_, CLDeviceLocalMemType_, CLDeviceMemCacheType_,
CLSampler, CLFilterMode_, CLSamplerInfo_, CLAddressingMode_,
......@@ -45,7 +45,7 @@ module System.GPU.OpenCL.Types(
CLDeviceExecCapability(..), CLDeviceLocalMemType(..), CLDeviceType(..),
CLCommandQueueProperty(..), CLCommandType(..), CLCommandExecutionStatus(..),
CLProfilingInfo(..), CLPlatformInfo(..), CLMemFlag(..), CLMemObjectType(..),
CLBuildStatus(..), CLAddressingMode(..), CLFilterMode(..),
CLBuildStatus(..), CLAddressingMode(..), CLFilterMode(..), CLMapFlag(..),
-- * Functions
wrapPError, wrapCheckSuccess, wrapGetInfo, whenSuccess, getCLValue,
throwCLError, getEnumCL, bitmaskToFlags, getCommandExecutionStatus,
......@@ -61,7 +61,11 @@ import Data.Typeable( Typeable(..) )
import Control.Applicative( (<$>) )
import Control.Exception( Exception(..), throwIO )
#ifdef __APPLE__
#include <OpenCL/opencl.h>
#else
#include <CL/cl.h>
#endif
-- -----------------------------------------------------------------------------
......@@ -98,6 +102,7 @@ type CLMemFlags_ = {#type cl_mem_flags#}
type CLMemObjectType_ = {#type cl_mem_object_type#}
type CLMemInfo_ = {#type cl_mem_info#}
type CLImageInfo_ = {#type cl_image_info#}
type CLMapFlags_ = {#type cl_map_flags#}
type CLProgramInfo_ = {#type cl_program_info#}
type CLProgramBuildInfo_ = {#type cl_program_build_info#}
type CLBuildStatus_ = {#type cl_build_status#}
......@@ -107,11 +112,6 @@ type CLFilterMode_ = {#type cl_filter_mode#}
type CLSamplerInfo_ = {#type cl_sampler_info#}
type CLAddressingMode_ = {#type cl_addressing_mode#}
{#pointer *cl_image_format as CLImageFormat_p#}
--type CLImageChannelOrder_ = {#type cl_channel_order#}
--type CLImageChannelDataType_ = {#type cl_channel_type#}
-- -----------------------------------------------------------------------------
#c
enum CLError {
......@@ -616,6 +616,14 @@ initialize the contents of the cl_mem object allocated using host-accessible
-}
{#enum CLMemFlag {upcaseFirstLetter} deriving( Show, Bounded, Eq, Ord ) #}
#c
enum CLMapFlag {
cL_MAP_READ=CL_MAP_READ,
cL_MAP_WRITE=CL_MAP_WRITE
};
#endc
{#enum CLMapFlag {upcaseFirstLetter} deriving( Show, Bounded, Eq, Ord ) #}
#c
enum CLMemObjectType {
cL_MEM_OBJECT_BUFFER=CL_MEM_OBJECT_BUFFER,
......
......@@ -39,7 +39,7 @@ import Test.QuickCheck.Monadic( monadicIO, assert, run )
import Test.QuickCheck.Test( Result, Args(..), isSuccess, stdArgs )
import Text.Printf( printf )
import System.Exit( exitSuccess, exitFailure )
import System.GPU.OpenCL
import Control.Parallel.OpenCL
-- -----------------------------------------------------------------------------
clDupSource :: String
......@@ -50,7 +50,7 @@ dupOpencl xs = do
-- Initialize OpenCL
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
context <- clCreateContext [] [dev] print
q <- clCreateCommandQueue context dev []
-- Initialize Kernel
......@@ -68,8 +68,8 @@ dupOpencl xs = do
mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
clSetKernelArg kernel 0 mem_in
clSetKernelArg kernel 1 mem_out
clSetKernelArgSto kernel 0 mem_in
clSetKernelArgSto kernel 1 mem_out
-- Execute Kernel
eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment