extra/opencl/ffi/ffi-tests.factor

   1 ! Copyright (C) 2010 Erik Charlebois.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: tools.test opencl.ffi multiline locals kernel io.encodings.ascii
   4 io.encodings.string sequences libc alien.c-types destructors math specialized-arrays
   5 math.order alien ;
   6 FROM: alien.c-types => float ;
   7 SPECIALIZED-ARRAYS: float void* ;
   8 IN: opencl.ffi.tests
   9
  10 STRING: kernel-source
  11 __kernel void square(
  12     __global float* input,
  13     __global float* output,
  14     const unsigned int count)
  15 {
  16     int i = get_global_id(0);
  17     if (i < count)
  18         output[i] = input[i] * input[i];
  19 }
  20 ;
  21
  22 ERROR: cl-error err ;
  23 : cl-success ( err -- )
  24     dup CL_SUCCESS = [ drop ] [ cl-error ] if ;
  25
  26 :: cl-string-array ( str -- alien )
  27     str ascii encode 0 suffix :> str-buffer
  28     str-buffer length malloc &free :> str-alien
  29     str-alien str-buffer dup length memcpy str-alien ;
  30
  31 :: opencl-square ( in -- out )
  32     0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
  33     dup <void*-array> [ f clGetPlatformIDs cl-success ] keep first
  34     CL_DEVICE_TYPE_DEFAULT 1 f void* <ref> [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id
  35     f 1 device-id void* <ref> f f 0 int <ref> [ clCreateContext ] keep int deref cl-success   :> context
  36     context device-id 0 0 int <ref> [ clCreateCommandQueue ] keep int deref cl-success    :> queue
  37
  38     [
  39         context 1 kernel-source cl-string-array void* <ref>
  40         f 0 int <ref> [ clCreateProgramWithSource ] keep int deref cl-success
  41         [ 0 f f f f clBuildProgram cl-success ]
  42         [ "square" cl-string-array 0 int <ref> [ clCreateKernel ] keep int deref cl-success ]
  43         [ ] tri
  44     ] with-destructors :> ( kernel program )
  45
  46     context CL_MEM_READ_ONLY in byte-length f
  47     0 int <ref> [ clCreateBuffer ] keep int deref cl-success :> input
  48
  49     context CL_MEM_WRITE_ONLY in byte-length f
  50     0 int <ref> [ clCreateBuffer ] keep int deref cl-success :> output
  51
  52     queue input CL_TRUE 0 in byte-length in 0 f f clEnqueueWriteBuffer cl-success
  53
  54     kernel 0 cl_mem heap-size input void* <ref> clSetKernelArg cl-success
  55     kernel 1 cl_mem heap-size output void* <ref> clSetKernelArg cl-success
  56     kernel 2 uint heap-size in length uint <ref> clSetKernelArg cl-success
  57
  58     queue kernel 1 f in length ulonglong <ref> f
  59     0 f f clEnqueueNDRangeKernel cl-success
  60
  61     queue clFinish cl-success
  62
  63     queue output CL_TRUE 0 in byte-length in length <float-array>
  64     [ 0 f f clEnqueueReadBuffer cl-success ] keep
  65
  66     input clReleaseMemObject cl-success
  67     output clReleaseMemObject cl-success
  68     program clReleaseProgram cl-success
  69     kernel clReleaseKernel cl-success
  70     queue clReleaseCommandQueue cl-success
  71     context clReleaseContext cl-success ;
  72
  73 [ float-array{ 1.0 4.0 9.0 16.0 100.0 } ]
  74 [ float-array{ 1.0 2.0 3.0 4.0 10.0 } opencl-square ] unit-test