Skip to content
This repository has been archived by the owner on Jun 28, 2022. It is now read-only.

Commit

Permalink
update examples to use exceptions
Browse files Browse the repository at this point in the history
  • Loading branch information
zhensydow committed Nov 23, 2011
1 parent 9417e1d commit 29e7446
Show file tree
Hide file tree
Showing 3 changed files with 60 additions and 81 deletions.
35 changes: 14 additions & 21 deletions examples/example01.hs
Expand Up @@ -29,33 +29,26 @@ 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 System.GPU.OpenCL
import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( newArray, peekArray )

myTry :: IO (Either CLError b) -> IO b
myTry f = do
v <- f
case v of
Left err -> error . show $ err
Right res -> return res

programSource :: String
programSource = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id];\n}"

main :: IO ()
main = do
-- Initialize OpenCL
(platform:_) <- myTry $ clGetPlatformIDs
(dev:_) <- myTry $ clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- myTry $ clCreateContext [dev] print
q <- myTry $ clCreateCommandQueue context dev []
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
q <- clCreateCommandQueue context dev []

-- Initialize Kernel
program <- myTry $ clCreateProgramWithSource context programSource
myTry $ clBuildProgram program [dev] ""
kernel <- myTry $ clCreateKernel program "duparray"
program <- clCreateProgramWithSource context programSource
clBuildProgram program [dev] ""
kernel <- clCreateKernel program "duparray"

-- Initialize parameters
let original = [0 .. 20] :: [CFloat]
Expand All @@ -64,17 +57,17 @@ main = do
putStrLn $ "Original array = " ++ show original
input <- newArray original

mem_in <- myTry $ clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_out <- myTry $ clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
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)

myTry $ clSetKernelArg kernel 0 mem_in
myTry $ clSetKernelArg kernel 1 mem_out
clSetKernelArg kernel 0 mem_in
clSetKernelArg kernel 1 mem_out

-- Execute Kernel
eventExec <- myTry $ clEnqueueNDRangeKernel q kernel [length original] [1] []
eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []

-- Get Result
eventRead <- myTry $ clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]
eventRead <- clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]

result <- peekArray (length original) input
putStrLn $ "Result array = " ++ show result
Expand Down
47 changes: 20 additions & 27 deletions examples/example02.hs
Expand Up @@ -36,13 +36,6 @@ import Foreign.Marshal.Array( peekArray, withArray )
import Data.List( foldl' )
import Control.Monad( forM_, forM )

myTry :: IO (Either CLError b) -> IO b
myTry f = do
v <- f
case v of
Left err -> error . show $ err
Right res -> return res

programSource :: String
programSource = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id] + id;\n}"

Expand All @@ -52,15 +45,15 @@ sumres (t1,t2,t3) (u1,u2,u3) = (t1+u1,t2+u2,t3+u3)
main :: IO ()
main = do
-- Initialize OpenCL
(platform:_) <- myTry $ clGetPlatformIDs
(dev:_) <- myTry $ clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- myTry $ clCreateContext [dev] print
q <- myTry $ clCreateCommandQueue context dev [CL_QUEUE_PROFILING_ENABLE]
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
q <- clCreateCommandQueue context dev [CL_QUEUE_PROFILING_ENABLE]

-- Initialize Kernel
program <- myTry $ clCreateProgramWithSource context programSource
myTry $ clBuildProgram program [dev] ""
kernel <- myTry $ clCreateKernel program "duparray"
program <- clCreateProgramWithSource context programSource
clBuildProgram program [dev] ""
kernel <- clCreateKernel program "duparray"

-- run tests
forM_ [100,200..30000] $ \s -> do
Expand All @@ -78,33 +71,33 @@ main = do

executeArray :: [CFloat] -> CLContext -> CLCommandQueue -> CLKernel -> IO (CLulong, CLulong, CLulong, [CFloat])
executeArray original ctx q krn = withArray original $ \input -> do
mem_in <- myTry $ clCreateBuffer ctx [CL_MEM_READ_ONLY] (vecSize, nullPtr)
mem_out <- myTry $ clCreateBuffer ctx [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
mem_in <- clCreateBuffer ctx [CL_MEM_READ_ONLY] (vecSize, nullPtr)
mem_out <- clCreateBuffer ctx [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)

myTry $ clSetKernelArg krn 0 mem_in
myTry $ clSetKernelArg krn 1 mem_out
clSetKernelArg krn 0 mem_in
clSetKernelArg krn 1 mem_out

-- Put Input
eventWrite <- myTry $ clEnqueueWriteBuffer q mem_in True 0 vecSize (castPtr input) []
eventWrite <- clEnqueueWriteBuffer q mem_in True 0 vecSize (castPtr input) []

-- Execute Kernel
eventExec <- myTry $ clEnqueueNDRangeKernel q krn [length original] [1] [eventWrite]
eventExec <- clEnqueueNDRangeKernel q krn [length original] [1] [eventWrite]

-- Get Result
eventRead <- myTry $ clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]
eventRead <- clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]

_ <- clWaitForEvents [eventRead]

t_start0 <- myTry $ clGetEventProfilingInfo eventWrite CL_PROFILING_COMMAND_START
t_end0 <- myTry $ clGetEventProfilingInfo eventWrite CL_PROFILING_COMMAND_END
t_start0 <- clGetEventProfilingInfo eventWrite CL_PROFILING_COMMAND_START
t_end0 <- clGetEventProfilingInfo eventWrite CL_PROFILING_COMMAND_END
let t_write = t_end0 - t_start0

t_start1 <- myTry $ clGetEventProfilingInfo eventExec CL_PROFILING_COMMAND_START
t_end1 <- myTry $ clGetEventProfilingInfo eventExec CL_PROFILING_COMMAND_END
t_start1 <- clGetEventProfilingInfo eventExec CL_PROFILING_COMMAND_START
t_end1 <- clGetEventProfilingInfo eventExec CL_PROFILING_COMMAND_END
let t_exec = t_end1 - t_start1

t_start2 <- myTry $ clGetEventProfilingInfo eventRead CL_PROFILING_COMMAND_START
t_end2 <- myTry $ clGetEventProfilingInfo eventRead CL_PROFILING_COMMAND_END
t_start2 <- clGetEventProfilingInfo eventRead CL_PROFILING_COMMAND_START
t_end2 <- clGetEventProfilingInfo eventRead CL_PROFILING_COMMAND_END
let t_read = t_end2 - t_start2

result <- peekArray (length original) input
Expand Down
59 changes: 26 additions & 33 deletions examples/example03.hs
Expand Up @@ -34,13 +34,6 @@ import Foreign( castPtr, nullPtr, sizeOf )
import Foreign.C.Types( CFloat )
import Foreign.Marshal.Array( newArray, peekArray )

myTry :: IO (Either CLError b) -> IO b
myTry f = do
v <- f
case v of
Left err -> error . show $ err
Right res -> return res

programSource1 :: String
programSource1 = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id];\n}"

Expand All @@ -50,20 +43,20 @@ programSource2 = "__kernel void triparray(__global float *in, __global float *ou
main :: IO ()
main = do
-- Initialize OpenCL
(platform:_) <- myTry $ clGetPlatformIDs
(dev:_) <- myTry $ clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- myTry $ clCreateContext [dev] print
q <- myTry $ clCreateCommandQueue context dev []
(platform:_) <- clGetPlatformIDs
(dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL
context <- clCreateContext [dev] print
q <- clCreateCommandQueue context dev []

-- Initialize Kernels
program1 <- myTry $ clCreateProgramWithSource context programSource1
myTry $ clBuildProgram program1 [dev] ""
kernel1 <- myTry $ clCreateKernel program1 "duparray"
kernel3 <- myTry $ clCreateKernel program1 "duparray"
program1 <- clCreateProgramWithSource context programSource1
clBuildProgram program1 [dev] ""
kernel1 <- clCreateKernel program1 "duparray"
kernel3 <- clCreateKernel program1 "duparray"

program2 <- myTry $ clCreateProgramWithSource context programSource2
myTry $ clBuildProgram program2 [dev] ""
kernel2 <- myTry $ clCreateKernel program2 "triparray"
program2 <- clCreateProgramWithSource context programSource2
clBuildProgram program2 [dev] ""
kernel2 <- clCreateKernel program2 "triparray"

-- Initialize parameters
let original = [0 .. 10] :: [CFloat]
Expand All @@ -72,32 +65,32 @@ main = do
putStrLn $ "Original array = " ++ show original
input <- newArray original

mem_in <- myTry $ clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_mid <- myTry $ clCreateBuffer context [CL_MEM_READ_WRITE] (vecSize, nullPtr)
mem_out1 <- myTry $ clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
mem_out2 <- myTry $ clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input)
mem_mid <- clCreateBuffer context [CL_MEM_READ_WRITE] (vecSize, nullPtr)
mem_out1 <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)
mem_out2 <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)

myTry $ clSetKernelArg kernel1 0 mem_in
myTry $ clSetKernelArg kernel1 1 mem_mid
clSetKernelArg kernel1 0 mem_in
clSetKernelArg kernel1 1 mem_mid

myTry $ clSetKernelArg kernel2 0 mem_mid
myTry $ clSetKernelArg kernel2 1 mem_out1
clSetKernelArg kernel2 0 mem_mid
clSetKernelArg kernel2 1 mem_out1

myTry $ clSetKernelArg kernel3 0 mem_mid
myTry $ clSetKernelArg kernel3 1 mem_out2
clSetKernelArg kernel3 0 mem_mid
clSetKernelArg kernel3 1 mem_out2

-- Execute Kernels
eventExec1 <- myTry $ clEnqueueNDRangeKernel q kernel1 [length original] [1] []
eventExec2 <- myTry $ clEnqueueNDRangeKernel q kernel2 [length original] [1] [eventExec1]
eventExec3 <- myTry $ clEnqueueNDRangeKernel q kernel3 [length original] [1] [eventExec1]
eventExec1 <- clEnqueueNDRangeKernel q kernel1 [length original] [1] []
eventExec2 <- clEnqueueNDRangeKernel q kernel2 [length original] [1] [eventExec1]
eventExec3 <- clEnqueueNDRangeKernel q kernel3 [length original] [1] [eventExec1]

-- Get Result
eventRead <- myTry $ clEnqueueReadBuffer q mem_out1 True 0 vecSize (castPtr input) [eventExec2,eventExec3]
eventRead <- clEnqueueReadBuffer q mem_out1 True 0 vecSize (castPtr input) [eventExec2,eventExec3]

result <- peekArray (length original) input
putStrLn $ "Result array 1 = " ++ show result

eventRead <- myTry $ clEnqueueReadBuffer q mem_out2 True 0 vecSize (castPtr input) [eventExec2,eventExec3]
eventRead <- clEnqueueReadBuffer q mem_out2 True 0 vecSize (castPtr input) [eventExec2,eventExec3]

result <- peekArray (length original) input
putStrLn $ "Result array 2 = " ++ show result
Expand Down

0 comments on commit 29e7446

Please sign in to comment.