diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/bindings.lisp | 832 | ||||
| -rw-r--r-- | src/command-queue.lisp | 38 | ||||
| -rw-r--r-- | src/constants.lisp | 558 | ||||
| -rw-r--r-- | src/context.lisp | 49 | ||||
| -rw-r--r-- | src/deprecated.lisp | 4 | ||||
| -rw-r--r-- | src/device.lisp | 176 | ||||
| -rw-r--r-- | src/enqueue.lisp | 77 | ||||
| -rw-r--r-- | src/event.lisp | 26 | ||||
| -rw-r--r-- | src/extensions.lisp | 0 | ||||
| -rw-r--r-- | src/flush.lisp | 7 | ||||
| -rw-r--r-- | src/kernel.lisp | 61 | ||||
| -rw-r--r-- | src/memory.lisp | 89 | ||||
| -rw-r--r-- | src/opencl.lisp | 109 | ||||
| -rw-r--r-- | src/package.lisp | 247 | ||||
| -rw-r--r-- | src/platform.lisp | 24 | ||||
| -rw-r--r-- | src/profiling.lisp | 11 | ||||
| -rw-r--r-- | src/program.lisp | 83 | ||||
| -rw-r--r-- | src/sampler.lisp | 27 | ||||
| -rw-r--r-- | src/types.lisp | 630 | 
19 files changed, 3048 insertions, 0 deletions
| diff --git a/src/bindings.lisp b/src/bindings.lisp new file mode 100644 index 0000000..0cc08ba --- /dev/null +++ b/src/bindings.lisp @@ -0,0 +1,832 @@ +(in-package #:ocl-ffi) + +;;; Platform API + +(cffi:defcfun ("clGetPlatformIDs" %get-platform-ids) cl-error-code +  (num-entries cl-uint) +  (platforms cl-platform-id) +  (num-platforms (:pointer cl-uint))) + +(cffi:defcfun ("clGetPlatformInfo" %get-platform-info) cl-error-code +  (platform cl-platform-id) +  (param-name cl-platform-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +;;; Device APIs + +(cffi:defcfun ("clGetDeviceIDs" %get-device-ids) cl-error-code +  (platform cl-platform-id) +  (device-type cl-device-type) +  (num-entries cl-uint) +  (devices (:pointer cl-device-id)) +  (num-devices (:pointer cl-uint))) + +(cffi:defcfun ("clGetDeviceInfo" %get-device-info) cl-error-code +  (device cl-device-id) +  (param-name cl-device-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clCreateSubDevices" %create-sub-devices) cl-int +  (in-device cl-device-id) +  (properties (:pointer cl-device-partition-property)) +  (num-devices cl-uint) +  (out-devices (:pointer cl-device-id)) +  (num-devices-ret (:pointer cl-uint))) + +(cffi:defcfun ("clRetainDevice" %retain-device) cl-error-code +  (device cl-device-id)) + +(cffi:defcfun ("clReleaseDevice" %release-device) cl-error-code +  (device cl-device-id)) + +(cffi:defcfun ("clSetDefaultDeviceCommandQueue" %set-default-device-command-queue) cl-int +  (context cl-context) +  (device cl-device-id) +  (command-queue cl-command-queue)) + +(cffi:defcfun ("clGetDeviceAndHostTimer" %get-device-and-host-timer) cl-int +  (device cl-device-id) +  (device-timestamp (:pointer cl-ulong)) +  (host-timestamp (:pointer cl-ulong))) + +(cffi:defcfun ("clGetHostTimer" %get-host-timer) cl-int +  (device cl-device-id) +  (host-timestamp (:pointer cl-ulong))) + +;;; Context APIs + +(cffi:defcfun ("clCreateContext" %create-context) cl-context +  (properties (:pointer cl-context-properties)) +  (num-devices cl-uint) +  (devices (:pointer cl-device-id)) +  (pfn-notify :pointer) +  (user-data (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateContextFromType" %create-context-from-type) cl-context +  (device-type cl-device-type) +  (pfn-notify :pointer) +  (user-data (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainContext" %retain-context) cl-error-code +  (context cl-context)) + +(cffi:defcfun ("clReleaseContext" %release-context) cl-error-code +  (context cl-context)) + +(cffi:defcfun ("clGetContextInfo" %get-context-info) cl-int +  (context cl-context) +  (param-name cl-context-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clSetContextDestructorCallback" set-context-destructor-callback) cl-int +  (context cl-context) +  (pfn-notify :pointer) +  (user-data (:pointer :void))) + +;;; Command Queue APIs + +(cffi:defcfun ("clCreateCommandQueueWithProperties" %create-command-queue-with-properties) cl-command-queue +  (context cl-context) +  (device cl-device-id) +  (properties (:pointer cl-queue-properties)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainCommandQueue" %retain-command-queue) cl-error-code +  (command-queue cl-command-queue)) + +(cffi:defcfun ("clReleaseCommandQueue" %release-command-queue) cl-error-code +  (command-queue cl-command-queue)) + +(cffi:defcfun ("clGetCommandQueueInfo" %get-command-queue-info) cl-int +  (command-queue cl-command-queue) +  (param-name cl-command-queue-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +;;; Memory Object APIs + +(cffi:defcfun ("clCreateBuffer" %create-buffer) cl-mem +  (context cl-context) +  (flags cl-mem-flags) +  (size :size) +  (host-ptr (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateSubBuffer" create-sub-buffer) cl-mem +  (buffer cl-mem) +  (flags cl-mem-flags) +  (size :size) +  (host-ptr (:pointer :void)) +  (buffer-create-type cl-buffer-create-type) +  (buffer-create-info (:pointer :void)) +  (errcode-ret (:pointer :int))) + +(cffi:defcfun ("clCreateImage" create-image) cl-mem +  (context cl-context) +  (flags cl-mem-flags) +  (image-format (:pointer (:struct cl-image-format))) +  (image-desc (:pointer (:struct cl-image-desc))) +  (host-ptr (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreatePipe" %create-pipe) cl-mem +  (context cl-context) +  (flags cl-mem-flags) +  (pipe-packet-size cl-uint) +  (pipe-max-packets cl-uint) +  (properties (:pointer cl-pipe-properties)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateBufferWithProperties" create-buffer-with-properties) cl-mem +  (context cl-context) +  (properties (:pointer cl-mem-properties)) +  (flags cl-mem-flags) +  (size :size) +  (host-ptr (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateImageWithProperties" create-image-with-properties) cl-mem +  (context cl-context) +  (properties (:pointer cl-mem-properties)) +  (flags cl-mem-flags) +  (image-format (:pointer (:struct cl-image-format))) +  (image-desc (:pointer (:struct cl-image-desc))) +  (host-ptr (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainMemObject" %retain-mem-object) cl-error-code +  (memobj cl-mem)) + +(cffi:defcfun ("clReleaseMemObject" %release-mem-object) cl-error-code +  (memobj cl-mem)) + +(cffi:defcfun ("clGetSupportedImageFormats" %get-supported-image-formats) cl-error-code +  (context cl-context) +  (flags cl-mem-flags) +  (image-type cl-mem-object-type) +  (num-entries cl-uint) +  (image-formats (:pointer (:struct cl-image-format))) +  (num-image-formats (:pointer cl-uint))) + +(cffi:defcfun ("clGetMemObjectInfo" %get-mem-object-info) cl-int +  (memobj cl-mem) +  (param-name cl-mem-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetImageInfo" %get-image-info) cl-int +  (image cl-mem) +  (param-name cl-image-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetPipeInfo" %get-pipe-info) cl-int +  (pipe cl-mem) +  (param-name cl-pipe-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clSetMemObjectDestructorCallback" set-mem-object-destructor-callback) cl-int +  (memobj cl-mem) +  (pfn-notify :pointer) +  (user-data (:pointer :void))) + +;;; SVM Allocation APIs + +(cffi:defcfun ("clSVMAlloc" svm-alloc) (:pointer :void) +  (context cl-context) +  (flags cl-svm-mem-flags) +  (size :size) +  (aligment cl-uint)) + +(cffi:defcfun ("clSVMFree" svm-free) :void +  (context cl-context) +  (svm-pointer (:pointer :void))) + +;;; Sampler APIs + +(cffi:defcfun ("clCreateSamplerWithProperties" %create-sampler-with-properties) cl-sampler +  (context cl-context) +  (sampler-properties (:pointer cl-sampler-properties)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainSampler" %retain-sampler) cl-int +  (sampler cl-sampler)) + +(cffi:defcfun ("clReleaseSampler" %release-sampler) cl-int +  (sampler cl-sampler)) + +(cffi:defcfun ("clGetSamplerInfo" %get-sampler-info) cl-int +  (sampler cl-sampler) +  (param-name cl-sampler-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +;;; Program Object APIs + +(cffi:defcfun ("clCreateProgramWithSource" %create-program-with-source) cl-program +  (context cl-context) +  (count cl-uint) +  (strings (:pointer (:pointer :char))) +  (lengths (:pointer :size)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateProgramWithBinary" create-program-with-binary) cl-program +  (context cl-context) +  (num-devices cl-uint) +  (device-list (:pointer cl-device-id)) +  (lengths (:pointer :size)) +  (binaries (:pointer (:pointer :unsigned-char))) +  (binary-status (:pointer cl-int)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateProgramWithBuiltInKernels" create-program-with-built-in-kernels) cl-program +  (context cl-context) +  (num-devices cl-uint) +  (device-list (:pointer cl-device-id)) +  (kernel-names (:pointer :char)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateProgramWithIL" create-program-with-il) cl-program +  (context cl-context) +  (il (:pointer :void)) +  (length :size) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainProgram" %retain-program) cl-error-code +  (program cl-program)) + +(cffi:defcfun ("clReleaseProgram" %release-program) cl-error-code +  (program cl-program)) + +(cffi:defcfun ("clBuildProgram" %build-program) cl-error-code +  (program cl-program) +  (num-devices cl-uint) +  (device-list (:pointer cl-device-id)) +  (options :string) +  (pfn-notify :pointer) +  (user-data (:pointer :void))) + +(cffi:defcfun ("clCompileProgram" %compile-program) cl-error-code +  (program cl-program) +  (num-devices cl-uint) +  (device-list (:pointer cl-device-id)) +  (options (:pointer :char)) +  (num-input-headers cl-uint) +  (input-headers (:pointer cl-program)) +  (header-include-names (:pointer (:pointer :char))) +  (pfn-notify :pointer) +  (user-data (:pointer :void))) + +(cffi:defcfun ("clLinkProgram" %link-program) cl-program +  (context cl-context) +  (num-devices cl-uint) +  (device-list (:pointer cl-device-id)) +  (options (:pointer :char)) +  (num-input-programs cl-uint) +  (input-programs (:pointer cl-program)) +  (pfn-notify :pointer) +  (user-data (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clSetProgramReleaseCallback" set-program-release-callback) cl-int +  (program cl-program) +  (pfn-notify :pointer) +  (user-data (:pointer :void))) + +(cffi:defcfun ("clSetProgramSpecializationConstant" set-program-specialization-constant) cl-int +  (program cl-program) +  (spec-id cl-uint) +  (spec-size :size) +  (spec-value (:pointer :void))) + +(cffi:defcfun ("clUnloadPlatformCompiler" %unload-platform-compiler) cl-error-code +  (platform cl-platform-id)) + +(cffi:defcfun ("clGetProgramInfo" %get-program-info) cl-int +  (program cl-program) +  (param-name cl-program-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetProgramBuildInfo" %get-program-build-info) cl-int +  (program cl-program) +  (device cl-device-id) +  (param-name cl-program-build-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +;;; Kernel Object APIs + +(cffi:defcfun ("clCreateKernel" %create-kernel) cl-kernel +  (program cl-program) +  (kernel-name :string) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateKernelsInProgram" %create-kernels-in-program) cl-error-code +  (program cl-program) +  (num-kernels cl-uint) +  (kernels (:pointer cl-kernel)) +  (num-kernels-ret (:pointer cl-uint))) + +(cffi:defcfun ("clCloneKernel" %clone-kernel) cl-kernel +  (source-kernel cl-kernel) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainKernel" %retain-kernel) cl-error-code +  (kernel cl-kernel)) + +(cffi:defcfun ("clReleaseKernel" %release-kernel) cl-error-code +  (kernel cl-kernel)) + +(cffi:defcfun ("clSetKernelArg" %set-kernel-arg) cl-error-code +  (kernel cl-kernel) +  (arg-index cl-uint) +  (arg-size :size) +  (arg-value (:pointer :void))) + +(cffi:defcfun ("clSetKernelArgSVMPointer" set-kernel-arg-svm-pointer) cl-int +  (kernel cl-kernel) +  (arg-index cl-uint) +  (arg-value (:pointer :void))) + +(cffi:defcfun ("clSetKernelExecInfo" set-kernel-exec-info) cl-int +  (kernel cl-kernel) +  (param-name cl-kernel-exec-info) +  (param-value-size :size) +  (param-value (:pointer :void))) + +(cffi:defcfun ("clGetKernelInfo" %get-kernel-info) cl-int +  (kernel cl-kernel) +  (param-name cl-kernel-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetKernelArgInfo" %get-kernel-arg-info) cl-int +  (kernel cl-kernel) +  (arg-indx cl-uint) +  (param-name cl-kernel-arg-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetKernelWorkGroupInfo" %get-kernel-work-group-info) cl-int +  (kernel cl-kernel) +  (device cl-device-id) +  (param-name cl-kernel-work-group-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetKernelSubGroupInfo" %get-kernel-sub-group-info) cl-int +  (kernel cl-kernel) +  (device cl-device-id) +  (param-name cl-kernel-sub-group-info) +  (input-value-size :size) +  (input-value (:pointer :void)) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +;;; Event Object APIs + +(cffi:defcfun ("clWaitForEvents" %wait-for-events) cl-error-code +  (num-events cl-uint) +  (event-list (:pointer cl-event))) + +(cffi:defcfun ("clGetEventInfo" %get-event-info) cl-error-code +  (event cl-event) +  (param-name cl-event-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clCreateUserEvent" %create-user-event) cl-event +  (context cl-context) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainEvent" %retain-event) cl-error-code +  (event cl-event)) + +(cffi:defcfun ("clReleaseEvent" %release-event) cl-error-code +  (event cl-event)) + +(cffi:defcfun ("clSetUserEventStatus" %set-user-event-status) cl-error-code +  (event cl-event) +  (execution-status cl-int)) + +(cffi:defcfun ("clSetEventCallback" set-event-callback) cl-int +  (event cl-event) +  (command-exec-callback-type cl-int) +  (pfn-notify :pointer) +  (user-data (:pointer :void))) + +;;; Profiling APIs + +(cffi:defcfun ("clGetEventProfilingInfo" %get-event-profiling-info) cl-error-code +  (event cl-event) +  (param-name cl-profiling-info) +  (param-value-size :size) +  (param-value (:pointer :void)) +  (param-value-size-ret (:pointer :size))) + +;;; Flush and Finish APIs + +(cffi:defcfun ("clFlush" %flush) cl-error-code +  (command-queue cl-command-queue)) + +(cffi:defcfun ("clFinish" %finish) cl-error-code +  (command-queue cl-command-queue)) + +;;; Enqueued Commands APIs + +(cffi:defcfun ("clEnqueueReadBuffer" %enqueue-read-buffer) cl-error-code +  (command-queue cl-command-queue) +  (buffer cl-mem) +  (blocking-read cl-bool) +  (offset :size) +  (size :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueReadBufferRect" enqueue-read-buffer-rect) cl-int +  (command-queue cl-command-queue) +  (buffer cl-mem) +  (blocking-read cl-bool) +  (buffer-origin (:pointer :size)) +  (host-origin (:pointer :size)) +  (region (:pointer :size)) +  (buffer-row-pitch :size) +  (buffer-slice-pitch :size) +  (host-row-pitch :size) +  (host-slice-pitch :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWriteBuffer" enqueue-write-buffer) cl-int +  (command-queue cl-command-queue) +  (buffer cl-mem) +  (blocking-write cl-bool) +  (offset :size) +  (size :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWriteBufferRect" enqueue-write-buffer-rect) cl-int +  (command-queue cl-command-queue) +  (buffer cl-mem) +  (blocking-write cl-bool) +  (buffer-origin (:pointer :size)) +  (host-origin (:pointer :size)) +  (region (:pointer :size)) +  (buffer-row-pitch :size) +  (buffer-slice-pitch :size) +  (host-row-pitch :size) +  (host-slice-pitch :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueFillBuffer" enqueue-fill-buffer) cl-int +  (command-queue cl-command-queue) +  (buffer cl-mem) +  (pattern (:pointer :void)) +  (pattern-size :size) +  (offset :size) +  (size :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyBuffer" enqueue-copy-buffer) cl-int +  (command-queue cl-command-queue) +  (src-buffer cl-mem) +  (dst-buffer cl-mem) +  (src-offset :size) +  (dst-offset :size) +  (size :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyBufferRect" enqueue-copy-buffer-rect) cl-int +  (command-queue cl-command-queue) +  (src-buffer cl-mem) +  (dst-buffer cl-mem) +  (src-origin (:pointer :size)) +  (dst-origin (:pointer :size)) +  (region (:pointer :size)) +  (src-row-pitch :size) +  (src-slice-pitch :size) +  (dst-row-pitch :size) +  (dst-slice-pitch :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueReadImage" enqueue-read-image) cl-int +  (command-queue cl-command-queue) +  (image cl-mem) +  (blocking-read cl-bool) +  (origin (:pointer :size)) +  (region (:pointer :size)) +  (row-pitch :size) +  (slice-pitch :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWriteImage" enqueue-write-image) cl-int +  (command-queue cl-command-queue) +  (image cl-mem) +  (blocking-write cl-bool) +  (origin (:pointer :size)) +  (region (:pointer :size)) +  (input-row-pitch :size) +  (input-slice-pitch :size) +  (ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueFillImage" enqueue-fill-image) cl-int +  (command-queue cl-command-queue) +  (image cl-mem) +  (fill-color (:pointer :void)) +  (origin (:pointer :size)) +  (region (:pointer :size)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyImage" enqueue-copy-image) cl-int +  (command-queue cl-command-queue) +  (src-image cl-mem) +  (dst-image cl-mem) +  (src-origin (:pointer :size)) +  (dst-origin (:pointer :size)) +  (region (:pointer :size)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyImageToBuffer" enqueue-copy-image-to-buffer) cl-int +  (command-queue cl-command-queue) +  (src-image cl-mem) +  (dst-buffer cl-mem) +  (src-origin (:pointer :size)) +  (region (:pointer :size)) +  (dst-offset :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyBufferToImage" enqueue-copy-buffer-to-image) cl-int +  (command-queue cl-command-queue) +  (src-buffer cl-mem) +  (dst-image cl-mem) +  (src-offset :size) +  (dst-origin (:pointer :size)) +  (region (:pointer :size)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueMapBuffer" enqueue-map-buffer) (:pointer :void) +  (command-queue cl-command-queue) +  (buffer cl-mem) +  (blocking-map cl-bool) +  (map-flags cl-map-flags) +  (offset :size) +  (size :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueMapImage" enqueue-map-image) (:pointer :void) +  (command-queue cl-command-queue) +  (image cl-mem) +  (blocking-map cl-bool) +  (map-flags cl-map-flags) +  (origin (:pointer :size)) +  (region (:pointer :size)) +  (image-row-pitch (:pointer :size)) +  (image-slice-pitch (:pointer :size)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueUnmapMemObject" enqueue-unmap-mem-object) cl-int +  (command-queue cl-command-queue) +  (memobj cl-mem) +  (mapped-ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueMigrateMemObjects" enqueue-migrate-mem-objects) cl-int +  (command-queue cl-command-queue) +  (num-mem-objects cl-uint) +  (mem-objects (:pointer cl-mem)) +  (flags cl-mem-migration-flags) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueNDRangeKernel" %enqueue-nd-range-kernel) cl-error-code +  (command-queue cl-command-queue) +  (kernel cl-kernel) +  (work-dim cl-uint) +  (global-work-offset (:pointer :size)) +  (global-work-size (:pointer :size)) +  (local-work-size (:pointer :size)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueNativeKernel" enqueue-native-kernel) cl-int +  (command-queue cl-command-queue) +  (user-func :pointer) +  (args (:pointer :void)) +  (cb-args :size) +  (num-mem-objects cl-uint) +  (mem-list (:pointer cl-mem)) +  (args-mem-loc (:pointer (:pointer :void))) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueMarkerWithWaitList" enqueue-marker-with-wait-list) cl-int +  (command-queue cl-command-queue) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueBarrierWithWaitList" enqueue-barrier-with-wait-list) cl-int +  (command-queue cl-command-queue) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMFree" %enqueue-svm-free) cl-error-code +  (command-queue cl-command-queue) +  (num-svm-pointers cl-uint) +  (svm-pointers (:pointer (:pointer :void))) +  (pfn-free-func :pointer) +  (user-data :pointer) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMemcpy" %enqueue-svm-memcpy) cl-error-code +  (command-queue cl-command-queue) +  (blocking-copy cl-bool) +  (dst-ptr (:pointer :void)) +  (src-ptr (:pointer :void)) +  (size :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMemfill" %enqueue-svm-memfill) cl-error-code +  (command-queue cl-command-queue) +  (svm-ptr (:pointer :void)) +  (pattern (:pointer :void)) +  (pattern-size :size) +  (size :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMap" %enqueue-svm-map) cl-error-code +  (command-queue cl-command-queue) +  (blocking-map cl-bool) +  (flags cl-map-flags) +  (svm-ptr (:pointer :void)) +  (size :size) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMUnmap" %enqueue-svm-unmap) cl-error-code +  (command-queue cl-command-queue) +  (svm-ptr (:pointer :void)) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMigrateMem" %enqueue-svm-migrate-mem) cl-error-code +  (command-queue cl-command-queue) +  (num-svm-pointers cl-uint) +  (svm-pointers (:pointer (:pointer :void))) +  (sizes (:pointer :size)) +  (flags cl-mem-migration-flags) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) + +;;; Extension function access + +(cffi:defcfun ("clGetExtensionFunctionAddressForPlatform" +               get-extension-function-address-for-platform) +    (:pointer :void) +  (platform cl-platform-id) +  (func-name :string)) + +;;; Deprecated OpenCL 1.0 APIs + +(cffi:defcfun ("clSetCommandQueueProperty" set-command-queue-property) cl-int +  (command-queue cl-command-queue) +  (properties cl-command-queue-properties) +  (enable cl-bool) +  (old-properties (:pointer cl-command-queue-properties))) + +;;; Deprecated OpenCL 1.1 APIs + +(cffi:defcfun ("clCreateImage2D" create-image-2d) cl-mem +  (context cl-context) +  (flags cl-mem-flags) +  (image-format (:pointer (:struct cl-image-format))) +  (image-width :size) +  (image-height :size) +  (image-row-pitch :size) +  (host-ptr (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateImage3D" create-image-3d) cl-mem +  (context cl-context) +  (flags cl-mem-flags) +  (image-format (:pointer (:struct cl-image-format))) +  (image-width :size) +  (image-height :size) +  (image-depth :size) +  (image-row-pitch :size) +  (image-slice-pitch :size) +  (host-ptr (:pointer :void)) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueMarker" enqueue-marker) cl-int +  (command-queue cl-command-queue) +  (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWaitForEvents" %enqueue-wait-for-events) cl-error-code +  (command-queue cl-command-queue) +  (num-events cl-uint) +  (event-list (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueBarrier" enqueue-barrier) cl-int +  (command-queue cl-command-queue)) + +(cffi:defcfun ("clUnloadCompiler" unload-compiler) cl-int) + +(cffi:defcfun ("clGetExtensionFunctionAddress" get-extension-function-address) (:pointer :void) +  (func-name :string)) + +;;; Deprecated OpenCL 2.0 APIs + +(cffi:defcfun ("clCreateCommandQueue" %create-command-queue) cl-command-queue +  (context cl-context) +  (device cl-device-id) +  (properties cl-command-queue-properties) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateSampler" create-sampler) cl-sampler +  (context cl-context) +  (normalized-coords cl-bool) +  (addressing-mode cl-addressing-mode) +  (filter-mode cl-filter-mode) +  (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueTask" enqueue-task) cl-int +  (command-queue cl-command-queue) +  (kernel cl-kernel) +  (num-events-in-wait-list cl-uint) +  (event-wait-list (:pointer cl-event)) +  (event (:pointer cl-event))) diff --git a/src/command-queue.lisp b/src/command-queue.lisp new file mode 100644 index 0000000..ec9f89c --- /dev/null +++ b/src/command-queue.lisp @@ -0,0 +1,38 @@ +(in-package #:ocl) + +(defun create-command-queue-with-properties (context device &key queue-properties queue-size) +  (let ((properties '(0))) +    (when queue-properties +      (push (cffi:foreign-bitfield-value 'cl-command-queue-properties queue-properties) properties) +      (push :queue-properties properties)) +    (when queue-size +      (push queue-size properties) +      (push :queue-size properties)) +    (with-foreign-sequence (c-properties properties 'cl-queue-properties) +      (check-error-arg (%create-command-queue-with-properties context device c-properties))))) + +(defun retain-command-queue (command-queue) +  (check-error (%retain-command-queue command-queue))) + +(defun release-command-queue (command-queue) +  (check-error (%release-command-queue command-queue))) + +(defparameter +command-queue-info-type-alist+ +  '((:queue-context          . cl-context) +    (:queue-device           . cl-device-id) +    (:queue-reference-count  . cl-uint) +    (:queue-properties       . cl-command-queue-properties) +    (:queue-properties-array . (:pointer cl-queue-properties)) +    (:queue-size             . cl-uint) +    (:queue-device-default   . cl-command-queue))) + +(wrap-get-info-function get-command-queue-info %get-command-queue-info +                        +command-queue-info-type-alist+) + +(defmacro with-command-queue ((queue context device &key queue-properties queue-size) &body body) +  `(let ((,queue (create-command-queue-with-properties ,context ,device +                                                       :queue-properties ,queue-properties +                                                       :queue-size ,queue-size))) +     (unwind-protect +          (progn ,@body) +       (release-command-queue ,queue)))) diff --git a/src/constants.lisp b/src/constants.lisp new file mode 100644 index 0000000..58da3f2 --- /dev/null +++ b/src/constants.lisp @@ -0,0 +1,558 @@ +(in-package #:ocl) + +;;; Error Codes +;; (defconstant +success+                                  0) +;; (defconstant +device-not-found+                         -1) +;; (defconstant +device-not-available+                     -2) +;; (defconstant +compiler-not-available+                   -3) +;; (defconstant +mem-object-allocation-failure+            -4) +;; (defconstant +out-of-resources+                         -5) +;; (defconstant +out-of-host-memory+                       -6) +;; (defconstant +profiling-info-not-available+             -7) +;; (defconstant +mem-copy-overlap+                         -8) +;; (defconstant +image-format-mismatch+                    -9) +;; (defconstant +image-format-not-supported+               -10) +;; (defconstant +build-program-failure+                    -11) +;; (defconstant +map-failure+                              -12) +;; (defconstant +misaligned-sub-buffer-offset+             -13) +;; (defconstant +exec-status-error-for-events-in-wait-list+ -14) +;; (defconstant +compile-program-failure+                  -15) +;; (defconstant +linker-not-available+                     -16) +;; (defconstant +link-program-failure+                     -17) +;; (defconstant +device-partition-failed+                  -18) +;; (defconstant +kernel-arg-info-not-available+            -19) +;; (defconstant +invalid-value+                            -30) +;; (defconstant +invalid-device-type+                      -31) +;; (defconstant +invalid-platform+                         -32) +;; (defconstant +invalid-device+                           -33) +;; (defconstant +invalid-context+                          -34) +;; (defconstant +invalid-queue-properties+                 -35) +;; (defconstant +invalid-command-queue+                    -36) +;; (defconstant +invalid-host-ptr+                         -37) +;; (defconstant +invalid-mem-object+                       -38) +;; (defconstant +invalid-image-format-descriptor+          -39) +;; (defconstant +invalid-image-size+                       -40) +;; (defconstant +invalid-sampler+                          -41) +;; (defconstant +invalid-binary+                           -42) +;; (defconstant +invalid-build-options+                    -43) +;; (defconstant +invalid-program+                          -44) +;; (defconstant +invalid-program-executable+               -45) +;; (defconstant +invalid-kernel-name+                      -46) +;; (defconstant +invalid-kernel-definition+                -47) +;; (defconstant +invalid-kernel+                           -48) +;; (defconstant +invalid-arg-index+                        -49) +;; (defconstant +invalid-arg-value+                        -50) +;; (defconstant +invalid-arg-size+                         -51) +;; (defconstant +invalid-kernel-args+                      -52) +;; (defconstant +invalid-work-dimension+                   -53) +;; (defconstant +invalid-work-group-size+                  -54) +;; (defconstant +invalid-work-item-size+                   -55) +;; (defconstant +invalid-global-offset+                    -56) +;; (defconstant +invalid-event-wait-list+                  -57) +;; (defconstant +invalid-event+                            -58) +;; (defconstant +invalid-operation+                        -59) +;; (defconstant +invalid-gl-object+                        -60) +;; (defconstant +invalid-buffer-size+                      -61) +;; (defconstant +invalid-mip-level+                        -62) +;; (defconstant +invalid-global-work-size+                 -63) +;; (defconstant +invalid-property+                         -64) +;; (defconstant +invalid-image-descriptor+                 -65) +;; (defconstant +invalid-compiler-options+                 -66) +;; (defconstant +invalid-linker-options+                   -67) +;; (defconstant +invalid-device-partition-count+           -68) +;; (defconstant +invalid-pipe-size+                        -69) +;; (defconstant +invalid-device-queue+                     -70) +;; (defconstant +invalid-spec-id+                          -71) +;; (defconstant +max-size-restriction-exceeded+            -72) + +;;; cl-bool +;; (defconstant +false+ 0) +;; (defconstant +true+ 1) +;; (defconstant +blocking+ +true+) +;; (defconstant +non-blocking+ +false+) + + +;;; cl-platform-info +;; (defconstant +platform-profile+ #x0900) +;; (defconstant +platform-version+ #x0901) +;; (defconstant +platform-name+ #x0902) +;; (defconstant +platform-vendor+ #x0903) +;; (defconstant +platform-extensions+ #x0904) +;; (defconstant +platform-host-timer-resolution+ #x0905) +;; (defconstant +platform-numeric-version+ #x0906) +;; (defconstant +platform-extensions-with-version+ #x0907) + +;;; cl-device-type - bitfield +;; (defconstant +device-type-default+ #x1) +;; (defconstant +device-type-cpu+ #x2) +;; (defconstant +device-type-gpu+ #x4) +;; (defconstant +device-type-accelerator+ #x8) +;; (defconstant +device-type-custom+ #x10) +;; (defconstant +device-type-all+ #xffffffff) + +;;; cl-device-info +;; (defconstant +device-type+ #x1000) +;; (defconstant +device-vendor-id+ #x1001) +;; (defconstant +device-max-compute-units+ #x1002) +;; (defconstant +device-max-work-item-dimensions+ #x1003) +;; (defconstant +device-max-work-group-size+ #x1004) +;; (defconstant +device-max-work-item-sizes+ #x1005) +;; (defconstant +device-preferred-vector-width-char+ #x1006) +;; (defconstant +device-preferred-vector-width-short+ #x1007) +;; (defconstant +device-preferred-vector-width-int+ #x1008) +;; (defconstant +device-preferred-vector-width-long+ #x1009) +;; (defconstant +device-preferred-vector-width-float+ #x100a) +;; (defconstant +device-preferred-vector-width-double+ #x100b) +;; (defconstant +device-max-clock-frequency+ #x100c) +;; (defconstant +device-address-bits+ #x100d) +;; (defconstant +device-max-read-image-args+ #x100e) +;; (defconstant +device-max-write-image-args+ #x100f) +;; (defconstant +device-max-mem-alloc-size+ #x1010) +;; (defconstant +device-image2d-max-width+ #x1011) +;; (defconstant +device-image2d-max-height+ #x1012) +;; (defconstant +device-image3d-max-width+ #x1013) +;; (defconstant +device-image3d-max-height+ #x1014) +;; (defconstant +device-image3d-max-depth+ #x1015) +;; (defconstant +device-image-support+ #x1016) +;; (defconstant +device-max-parameter-size+ #x1017) +;; (defconstant +device-max-samplers+ #x1018) +;; (defconstant +device-mem-base-addr-align+ #x1019) +;; (defconstant +device-min-data-type-align-size+ #x101a) +;; (defconstant +device-single-fp-config+ #x101b) +;; (defconstant +device-global-mem-cache-type+ #x101c) +;; (defconstant +device-global-mem-cacheline-size+ #x101d) +;; (defconstant +device-global-mem-cache-size+ #x101e) +;; (defconstant +device-global-mem-size+ #x101f) +;; (defconstant +device-max-constant-buffer-size+ #x1020) +;; (defconstant +device-max-constant-args+ #x1021) +;; (defconstant +device-local-mem-type+ #x1022) +;; (defconstant +device-local-mem-size+ #x1023) +;; (defconstant +device-error-correction-support+ #x1024) +;; (defconstant +device-profiling-timer-resolution+ #x1025) +;; (defconstant +device-endian-little+ #x1026) +;; (defconstant +device-available+ #x1027) +;; (defconstant +device-compiler-available+ #x1028) +;; (defconstant +device-execution-capabilities+ #x1029) +;; (defconstant +device-queue-properties+ #x102a) +;; (defconstant +device-queue-on-host-properties+ #x102a) +;; (defconstant +device-name+ #x102b) +;; (defconstant +device-vendor+ #x102c) +;; (defconstant +driver-version+ #x102d) +;; (defconstant +device-profile+ #x102e) +;; (defconstant +device-version+ #x102f) +;; (defconstant +device-extensions+ #x1030) +;; (defconstant +device-platform+ #x1031) +;; (defconstant +device-double-fp-config+ #x1032) +;; (defconstant +device-preferred-vector-width-half+ #x1034) +;; (defconstant +device-host-unified-memory+ #x1035) +;; (defconstant +device-native-vector-width-char+ #x1036) +;; (defconstant +device-native-vector-width-short+ #x1037) +;; (defconstant +device-native-vector-width-int+ #x1038) +;; (defconstant +device-native-vector-width-long+ #x1039) +;; (defconstant +device-native-vector-width-float+ #x103a) +;; (defconstant +device-native-vector-width-double+ #x103b) +;; (defconstant +device-native-vector-width-half+ #x103c) +;; (defconstant +device-opencl-c-version+ #x103d) +;; (defconstant +device-linker-available+ #x103e) +;; (defconstant +device-built-in-kernels+ #x103f) +;; (defconstant +device-image-max-buffer-size+ #x1040) +;; (defconstant +device-image-max-array-size+ #x1041) +;; (defconstant +device-parent-device+ #x1042) +;; (defconstant +device-partition-max-sub-devices+ #x1043) +;; (defconstant +device-partition-properties+ #x1044) +;; (defconstant +device-partition-affinity-domain+ #x1045) +;; (defconstant +device-partition-type+ #x1046) +;; (defconstant +device-reference-count+ #x1047) +;; (defconstant +device-preferred-interop-user-sync+ #x1048) +;; (defconstant +device-printf-buffer-size+ #x1049) +;; (defconstant +device-image-pitch-alignment+ #x104a) +;; (defconstant +device-image-base-address-alignment+ #x104b) +;; (defconstant +device-max-read-write-image-args+ #x104c) +;; (defconstant +device-max-global-variable-size+ #x104d) +;; (defconstant +device-queue-on-device-properties+ #x104e) +;; (defconstant +device-queue-on-device-preferred-size+ #x104f) +;; (defconstant +device-queue-on-device-max-size+ #x1050) +;; (defconstant +device-max-on-device-queues+ #x1051) +;; (defconstant +device-max-on-device-events+ #x1052) +;; (defconstant +device-svm-capabilities+ #x1053) +;; (defconstant +device-global-variable-preferred-total-size+ #x1054) +;; (defconstant +device-max-pipe-args+ #x1055) +;; (defconstant +device-pipe-max-active-reservations+ #x1056) +;; (defconstant +device-pipe-max-packet-size+ #x1057) +;; (defconstant +device-preferred-platform-atomic-alignment+ #x1058) +;; (defconstant +device-preferred-global-atomic-alignment+ #x1059) +;; (defconstant +device-preferred-local-atomic-alignment+ #x105a) +;; (defconstant +device-il-version+ #x105b) +;; (defconstant +device-max-num-sub-groups+ #x105c) +;; (defconstant +device-sub-group-independent-forward-progress+ #x105d) +;; (defconstant +device-numeric-version+ #x105e) +;; (defconstant +device-extensions-with-version+ #x1060) +;; (defconstant +device-ils-with-version+ #x1061) +;; (defconstant +device-built-in-kernels-with-version+ #x1062) +;; (defconstant +device-atomic-memory-capabilities+ #x1063) +;; (defconstant +device-atomic-fence-capabilities+ #x1064) +;; (defconstant +device-non-uniform-work-group-support+ #x1065) +;; (defconstant +device-opencl-c-all-versions+ #x1066) +;; (defconstant +device-preferred-work-group-size-multiple+ #x1067) +;; (defconstant +device-work-group-collective-functions-support+ #x1068) +;; (defconstant +device-generic-address-space-support+ #x1069) +;; (defconstant +device-opencl-c-features+ #x106f) +;; (defconstant +device-device-enqueue-capabilities+ #x1070) +;; (defconstant +device-pipe-support+ #x1071) +;; (defconstant +device-latest-conformance-version-passed+ #x1072) + +;;; cl-device-fp-config - bitfield +;; (defconstant +fp-denorm+ #x1) +;; (defconstant +fp-inf-nan+ #x2) +;; (defconstant +fp-round-to-nearest+ #x4) +;; (defconstant +fp-round-to-zero+ #x8) +;; (defconstant +fp-round-to-inf+ #x10) +;; (defconstant +fp-fma+ #x20) +;; (defconstant +fp-soft-float+ #x40) +;; (defconstant +fp-correctly-rounded-divide-sqrt+ #x80) + +;;; cl-device-mem-cache-type +;; (defconstant +none+ #x0) +;; (defconstant +read-only-cache+ #x1) +;; (defconstant +read-write-cache+ #x2) + +;;; cl-device-local-mem-type +;; (defconstant +local+ #x1) +;; (defconstant +global+ #x2) + +;;; cl-device-exec-capabilities - bitfield +;; (defconstant +exec-kernel+ #x1) +;; (defconstant +exec-native-kernel+ #x2) + +;;; cl-command-queue-properties - bitfield +;; (defconstant +queue-out-of-order-exec-mode-enable+ #x1) +;; (defconstant +queue-profiling-enable+ #x2) +;; (defconstant +queue-on-device+ #x4) +;; (defconstant +queue-on-device-default+ #x8) + +;;; cl-context-info +;; (defconstant +context-reference-count+ #x1080) +;; (defconstant +context-devices+ #x1081) +;; (defconstant +context-properties+ #x1082) +;; (defconstant +context-num-devices+ #x1083) + +;;; cl-context-properties +;; (defconstant +context-platform+ #x1084) +;; (defconstant +context-interop-user-sync+ #x1085) + +;;; cl-device-partition-property +(defconstant +device-partition-equally+ #x1086) +(defconstant +device-partition-by-counts+ #x1087) +(defconstant +device-partition-by-counts-list-end+ #x0) +(defconstant +device-partition-by-affinity-domain+ #x1088) + + +;;; cl-device-affinity-domain +;; (defconstant +device-affinity-domain-numa+ #x1) +;; (defconstant +device-affinity-domain-l4-cache+ #x2) +;; (defconstant +device-affinity-domain-l3-cache+ #x4) +;; (defconstant +device-affinity-domain-l2-cache+ #x8) +;; (defconstant +device-affinity-domain-l1-cache+ #x10) +;; (defconstant +device-affinity-domain-next-partitionable+ #x20) + +;;; cl-device-svm-capabilities +;; (defconstant +device-svm-coarse-grain-buffer+ #x1) +;; (defconstant +device-svm-fine-grain-buffer+ #x2) +;; (defconstant +device-svm-fine-grain-system+ #x4) +;; (defconstant +device-svm-atomics+ #x8) + +;;; cl-command-queue-info +;; (defconstant +queue-context+ #x1090) +;; (defconstant +queue-device+ #x1091) +;; (defconstant +queue-reference-count+ #x1092) +;; (defconstant +queue-properties+ #x1093) +;; (defconstant +queue-size+ #x1094) +;; (defconstant +queue-device-default+ #x1095) +;; (defconstant +queue-properties-array+ #x1098) + +;;; cl-mem-flags and cl-svm-mem-flags - bitfield +(defconstant +mem-read-write+ #x1) +(defconstant +mem-write-only+ #x2) +(defconstant +mem-read-only+ #x4) +(defconstant +mem-use-host-ptr+ #x8) +(defconstant +mem-alloc-host-ptr+ #x10) +(defconstant +mem-copy-host-ptr+ #x20) +(defconstant +mem-host-write-only+ #x80) +(defconstant +mem-host-read-only+ #x100) +(defconstant +mem-host-no-access+ #x200) +(defconstant +mem-svm-fine-grain-buffer+ #x400) +(defconstant +mem-svm-atomics+ #x800) +(defconstant +mem-kernel-read-and-write+ #x1000) + + +;;; cl-mem-migration-flags - bitfield +;; (defconstant +migrate-mem-object-host+ #x1) +;; (defconstant +migrate-mem-object-content-undefined+ #x2) + +;;; cl-channel-order +;; (defconstant +r+ #x10b0) +;; (defconstant +a+ #x10b1) +;; (defconstant +rg+ #x10b2) +;; (defconstant +ra+ #x10b3) +;; (defconstant +rgb+ #x10b4) +;; (defconstant +rgba+ #x10b5) +;; (defconstant +bgra+ #x10b6) +;; (defconstant +argb+ #x10b7) +;; (defconstant +intensity+ #x10b8) +;; (defconstant +luminance+ #x10b9) +;; (defconstant +rx+ #x10ba) +;; (defconstant +rgx+ #x10bb) +;; (defconstant +rgbx+ #x10bc) +;; (defconstant +depth+ #x10bd) +;; (defconstant +depth-stencil+ #x10be) +;; (defconstant +srgb+ #x10bf) +;; (defconstant +srgbx+ #x10c0) +;; (defconstant +srgba+ #x10c1) +;; (defconstant +sbgra+ #x10c2) +;; (defconstant +abgr+ #x10c3) + +;;; cl-channel-type +;; (defconstant +snorm-int8+ #x10d0) +;; (defconstant +snorm-int16+ #x10d1) +;; (defconstant +unorm-int8+ #x10d2) +;; (defconstant +unorm-int16+ #x10d3) +;; (defconstant +unorm-short-565+ #x10d4) +;; (defconstant +unorm-short-555+ #x10d5) +;; (defconstant +unorm-int-101010+ #x10d6) +;; (defconstant +signed-int8+ #x10d7) +;; (defconstant +signed-int16+ #x10d8) +;; (defconstant +signed-int32+ #x10d9) +;; (defconstant +unsigned-int8+ #x10da) +;; (defconstant +unsigned-int16+ #x10db) +;; (defconstant +unsigned-int32+ #x10dc) +;; (defconstant +half-float+ #x10dd) +;; (defconstant +float+ #x10de) +;; (defconstant +unorm-int24+ #x10df) +;; (defconstant +unorm-int-101010-2+ #x10e0) + +;;; cl-mem-object-type +;; (defconstant +mem-object-buffer+ #x10f0) +;; (defconstant +mem-object-image2d+ #x10f1) +;; (defconstant +mem-object-image3d+ #x10f2) +;; (defconstant +mem-object-image2d-array+ #x10f3) +;; (defconstant +mem-object-image1d+ #x10f4) +;; (defconstant +mem-object-image1d-array+ #x10f5) +;; (defconstant +mem-object-image1d-buffer+ #x10f6) +;; (defconstant +mem-object-pipe+ #x10f7) + +;;; cl-mem-info +;; (defconstant +mem-type+ #x1100) +;; (defconstant +mem-flags+ #x1101) +;; (defconstant +mem-size+ #x1102) +;; (defconstant +mem-host-ptr+ #x1103) +;; (defconstant +mem-map-count+ #x1104) +;; (defconstant +mem-reference-count+ #x1105) +;; (defconstant +mem-context+ #x1106) +;; (defconstant +mem-associated-memobject+ #x1107) +;; (defconstant +mem-offset+ #x1108) +;; (defconstant +mem-uses-svm-pointer+ #x1109) +;; (defconstant +mem-properties+ #x110a) + +;;; cl-image-info +;; (defconstant +image-format+ #x1110) +;; (defconstant +image-element-size+ #x1111) +;; (defconstant +image-row-pitch+ #x1112) +;; (defconstant +image-slice-pitch+ #x1113) +;; (defconstant +image-width+ #x1114) +;; (defconstant +image-height+ #x1115) +;; (defconstant +image-depth+ #x1116) +;; (defconstant +image-array-size+ #x1117) +;; (defconstant +image-buffer+ #x1118) +;; (defconstant +image-num-mip-levels+ #x1119) +;; (defconstant +image-num-samples+ #x111a) + +;;; cl-pipe-info +;; (defconstant +pipe-packet-size+ #x1120) +;; (defconstant +pipe-max-packets+ #x1121) +;; (defconstant +pipe-properties+ #x1122) + +;;; cl-addressing-mode +;; (defconstant +address-none+ #x1130) +;; (defconstant +address-clamp-to-edge+ #x1131) +;; (defconstant +address-clamp+ #x1132) +;; (defconstant +address-repeat+ #x1133) +;; (defconstant +address-mirrored-repeat+ #x1134) + +;;; cl-filter-mode +;; (defconstant +filter-nearest+ #x1140) +;; (defconstant +filter-linear+ #x1141) + +;;; cl-sampler-info +;; (defconstant +sampler-reference-count+ #x1150) +;; (defconstant +sampler-context+ #x1151) +;; (defconstant +sampler-normalized-coords+ #x1152) +;; (defconstant +sampler-addressing-mode+ #x1153) +;; (defconstant +sampler-filter-mode+ #x1154) +;; (defconstant +sampler-mip-filter-mode+ #x1155) +;; (defconstant +sampler-lod-min+ #x1156) +;; (defconstant +sampler-lod-max+ #x1157) +;; (defconstant +sampler-properties+ #x1158) + + +;;; cl-map-flags - bitfield +;; (defconstant +map-read+ #x1) +;; (defconstant +map-write+ #x2) +;; (defconstant +map-write-invalidate-region+ #x4) + +;;; cl-program-info +;; (defconstant +program-reference-count+ #x1160) +;; (defconstant +program-context+ #x1161) +;; (defconstant +program-num-devices+ #x1162) +;; (defconstant +program-devices+ #x1163) +;; (defconstant +program-source+ #x1164) +;; (defconstant +program-binary-sizes+ #x1165) +;; (defconstant +program-binaries+ #x1166) +;; (defconstant +program-num-kernels+ #x1167) +;; (defconstant +program-kernel-names+ #x1168) +;; (defconstant +program-il+ #x1169) +;; (defconstant +program-scope-global-ctors-present+ #x116a) +;; (defconstant +program-scope-global-dtors-present+ #x116b) + +;;; cl-program-build-info +;; (defconstant +program-build-status+ #x1181) +;; (defconstant +program-build-options+ #x1182) +;; (defconstant +program-build-log+ #x1183) +;; (defconstant +program-binary-type+ #x1184) +;; (defconstant +program-build-global-variable-total-size+ #x1185) + +;;; cl-program-binary-type +;; (defconstant +program-binary-type-none+ #x0) +;; (defconstant +program-binary-type-compiled-object+ #x1) +;; (defconstant +program-binary-type-library+ #x2) +;; (defconstant +program-binary-type-executable+ #x4) + +;;; cl-build-status +;; (defconstant +build-success+ 0) +;; (defconstant +build-none+ -1) +;; (defconstant +build-error+ -2) +;; (defconstant +build-in-progress+ -3) + +;; cl-kernel-info +;; (defconstant +kernel-function-name+ #x1190) +;; (defconstant +kernel-num-args+ #x1191) +;; (defconstant +kernel-reference-count+ #x1192) +;; (defconstant +kernel-context+ #x1193) +;; (defconstant +kernel-program+ #x1194) +;; (defconstant +kernel-attributes+ #x1195) + +;;; cl-kernel-arg-info +;; (defconstant +kernel-arg-address-qualifier+ #x1196) +;; (defconstant +kernel-arg-access-qualifier+ #x1197) +;; (defconstant +kernel-arg-type-name+ #x1198) +;; (defconstant +kernel-arg-type-qualifier+ #x1199) +;; (defconstant +kernel-arg-name+ #x119a) + +;;; cl-kernel-arg-address-qualifier +;; (defconstant +kernel-arg-address-global+ #x119b) +;; (defconstant +kernel-arg-address-local+ #x119c) +;; (defconstant +kernel-arg-address-constant+ #x119d) +;; (defconstant +kernel-arg-address-private+ #x119e) + +;;; cl-kernel-arg-access-qualifier +;; (defconstant +kernel-arg-access-read-only+ #x11a0) +;; (defconstant +kernel-arg-access-write-only+ #x11a1) +;; (defconstant +kernel-arg-access-read-write+ #x11a2) +;; (defconstant +kernel-arg-access-none+ #x11a3) + +;;; cl-kernel-arg-type-qualifier +;; (defconstant +kernel-arg-type-none+ #x0) +;; (defconstant +kernel-arg-type-const+ #x1) +;; (defconstant +kernel-arg-type-restrict+ #x2) +;; (defconstant +kernel-arg-type-volatile+ #x4) +;; (defconstant +kernel-arg-type-pipe+ #x8) + +;;; cl-kernel-work-group-info +;; (defconstant +kernel-work-group-size+ #x11b0) +;; (defconstant +kernel-compile-work-group-size+ #x11b1) +;; (defconstant +kernel-local-mem-size+ #x11b2) +;; (defconstant +kernel-preferred-work-group-size-multiple+ #x11b3) +;; (defconstant +kernel-private-mem-size+ #x11b4) +;; (defconstant +kernel-global-work-size+ #x11b5) + +;;; cl-kernel-sub-group-info +;; (defconstant +kernel-max-sub-group-size-for-ndrange+ #x2033) +;; (defconstant +kernel-sub-group-count-for-ndrange+ #x2034) +;; (defconstant +kernel-local-size-for-sub-group-count+ #x11b8) +;; (defconstant +kernel-max-num-sub-groups+ #x11b9) +;; (defconstant +kernel-compile-num-sub-groups+ #x11ba) + +;;; cl-kernel-exec-info +;; (defconstant +kernel-exec-info-svm-ptrs+ #x11b6) +;; (defconstant +kernel-exec-info-svm-fine-grain-system+ #x11b7) + +;;; cl-event-info +;; (defconstant +event-command-queue+ #x11d0) +;; (defconstant +event-command-type+ #x11d1) +;; (defconstant +event-reference-count+ #x11d2) +;; (defconstant +event-command-execution-status+ #x11d3) +;; (defconstant +event-context+ #x11d4) + +;;; cl-command-type +;; (defconstant +command-ndrange-kernel+ #x11f0) +;; (defconstant +command-task+ #x11f1) +;; (defconstant +command-native-kernel+ #x11f2) +;; (defconstant +command-read-buffer+ #x11f3) +;; (defconstant +command-write-buffer+ #x11f4) +;; (defconstant +command-copy-buffer+ #x11f5) +;; (defconstant +command-read-image+ #x11f6) +;; (defconstant +command-write-image+ #x11f7) +;; (defconstant +command-copy-image+ #x11f8) +;; (defconstant +command-copy-image-to-buffer+ #x11f9) +;; (defconstant +command-copy-buffer-to-image+ #x11fa) +;; (defconstant +command-map-buffer+ #x11fb) +;; (defconstant +command-map-image+ #x11fc) +;; (defconstant +command-unmap-mem-object+ #x11fd) +;; (defconstant +command-marker+ #x11fe) +;; (defconstant +command-acquire-gl-objects+ #x11ff) +;; (defconstant +command-release-gl-objects+ #x1200) +;; (defconstant +command-read-buffer-rect+ #x1201) +;; (defconstant +command-write-buffer-rect+ #x1202) +;; (defconstant +command-copy-buffer-rect+ #x1203) +;; (defconstant +command-user+ #x1204) +;; (defconstant +command-barrier+ #x1205) +;; (defconstant +command-migrate-mem-objects+ #x1206) +;; (defconstant +command-fill-buffer+ #x1207) +;; (defconstant +command-fill-image+ #x1208) +;; (defconstant +command-svm-free+ #x1209) +;; (defconstant +command-svm-memcpy+ #x120a) +;; (defconstant +command-svm-memfill+ #x120b) +;; (defconstant +command-svm-map+ #x120c) +;; (defconstant +command-svm-unmap+ #x120d) +;; (defconstant +command-svm-migrate-mem+ #x120e) + +;;; command execution status +;; (defconstant +complete+ #x0) +;; (defconstant +running+ #x1) +;; (defconstant +submitted+ #x2) +;; (defconstant +queued+ #x3) + +;;; cl-buffer-create-type +;;(defconstant +buffer-create-type-region+ #x1220) + +;;; cl-profiling-info +;; (defconstant +profiling-command-queued+ #x1280) +;; (defconstant +profiling-command-submit+ #x1281) +;; (defconstant +profiling-command-start+ #x1282) +;; (defconstant +profiling-command-end+ #x1283) +;; (defconstant +profiling-command-complete+ #x1284) + +;;; cl-device-atomic-capabilities - bitfield +;; (defconstant +device-atomic-order-relaxed+ #x01) +;; (defconstant +device-atomic-order-acq-rel+ #x02) +;; (defconstant +device-atomic-order-seq-cst+ #x04) +;; (defconstant +device-atomic-scope-work-item+ #x08) +;; (defconstant +device-atomic-scope-work-group+ #x10) +;; (defconstant +device-atomic-scope-device+ #x20) +;; (defconstant +device-atomic-scope-all-devices+ #x40) + +;;; cl-device-device-enqueue-capabilities - bitfield +;; (defconstant +device-queue-supported+ #x1) +;; (defconstant +device-queue-replaceable-default+ #x2) + +;;; cl-khronos-vendor-id +;; (defconstant +khronos-vendor-id-codeplay+ #x10004) diff --git a/src/context.lisp b/src/context.lisp new file mode 100644 index 0000000..45dc9b3 --- /dev/null +++ b/src/context.lisp @@ -0,0 +1,49 @@ +(in-package #:ocl) + +(defun create-context (devices &key platform iterop-user-sync-p) +  (let ((properties '(0))) +    (when iterop-user-sync-p +      (push 1 properties) +      (push :context-interop-user-sync properties)) +    (when platform +      (push (cffi:pointer-address platform) properties) +      (push :context-platform properties)) +    (with-foreign-sequences ((c-properties properties 'cl-context-properties) +                             (c-devices devices 'cl-device-id num-devices)) +      (check-error-arg +       (%create-context c-properties num-devices c-devices (cffi:null-pointer) +                        (cffi:null-pointer)))))) + +(defun create-context-from-type (device-type &key platform iterop-user-sync-p +                                               (pfn-notify (cffi:null-pointer)) +                                               (user-data (cffi:null-pointer))) +  (let ((properties '(0))) +    (when iterop-user-sync-p +      (push 1 properties) +      (push :context-interop-user-sync properties)) +    (when platform +      (push (cffi:pointer-address platform) properties) +      (push :context-platform properties)) +    (with-foreign-sequences ((c-properties properties 'cl-context-properties)) +      (check-error-arg +       (%create-context-from-type c-properties device-type pfn-notify user-data))))) + +(defun retain-context (context) +  (check-error (%retain-context context))) + +(defun release-context (context) +  (check-error (%release-context context))) + +(defparameter +context-info-type-alist+ +  '((:context-reference-count . cl-uint) +    (:context-num-devices     . cl-uint) +    (:context-devices         . (:pointer cl-device-id)) +    (:context-properties      . (:pointer cl-context-properties)))) + +(wrap-get-info-function get-context-info %get-context-info +context-info-type-alist+) + +(defmacro with-context ((context devices &rest options) &body body) +  `(let ((,context (create-context ,devices ,@options))) +     (unwind-protect +          (progn ,@body) +       (release-context ,context)))) diff --git a/src/deprecated.lisp b/src/deprecated.lisp new file mode 100644 index 0000000..ea835fe --- /dev/null +++ b/src/deprecated.lisp @@ -0,0 +1,4 @@ +(in-package #:ocl) + +(defun create-command-queue (context device properties) +  (check-error-arg  (%create-command-queue context device properties))) diff --git a/src/device.lisp b/src/device.lisp new file mode 100644 index 0000000..830ee82 --- /dev/null +++ b/src/device.lisp @@ -0,0 +1,176 @@ +(in-package #:ocl) + +(defun get-device-ids (platform device-type) +  (let (num-devices) +    (cffi:with-foreign-object (c-num-devices 'cl-uint) +      (check-error (%get-device-ids platform device-type 0 (cffi:null-pointer) c-num-devices)) +      (setf num-devices (cffi:mem-ref c-num-devices 'cl-uint))) +    (cffi:with-foreign-object (c-devices 'cl-device-id num-devices) +      (check-error (%get-device-ids platform device-type num-devices c-devices (cffi:null-pointer))) +      (loop :for i :below num-devices +            :collect (cffi:mem-aref c-devices 'cl-device-id i))))) + +(defparameter +device-info-type-alist+ +  '((:device-type                                    . cl-device-type) +    (:device-vendor-id                               . cl-uint) +    (:device-max-compute-units                       . cl-uint) +    (:device-max-work-item-dimensions                . cl-uint) +    (:device-max-work-group-size                     . :size) +    (:device-max-work-item-sizes                     . (:pointer :size)) +    (:device-preferred-vector-width-char             . cl-uint) +    (:device-preferred-vector-width-short            . cl-uint) +    (:device-preferred-vector-width-int              . cl-uint) +    (:device-preferred-vector-width-long             . cl-uint) +    (:device-preferred-vector-width-float            . cl-uint) +    (:device-preferred-vector-width-double           . cl-uint) +    (:device-max-clock-frequency                     . cl-uint) +    (:device-address-bits                            . cl-uint) +    (:device-max-read-image-args                     . cl-uint) +    (:device-max-write-image-args                    . cl-uint) +    (:device-max-mem-alloc-size                      . cl-ulong) +    (:device-image2d-max-width                       . :size) +    (:device-image2d-max-height                      . :size) +    (:device-image3d-max-width                       . :size) +    (:device-image3d-max-height                      . :size) +    (:device-image3d-max-depth                       . :size) +    (:device-image-support                           . cl-bool) +    (:device-max-parameter-size                      . :size) +    (:device-max-samplers                            . cl-uint) +    (:device-mem-base-addr-align                     . cl-uint) +    (:device-min-data-type-align-size                . cl-uint) +    (:device-single-fp-config                        . cl-device-fp-config) +    (:device-global-mem-cache-type                   . cl-device-mem-cache-type) +    (:device-global-mem-cacheline-size               . cl-uint) +    (:device-global-mem-cache-size                   . cl-ulong) +    (:device-global-mem-size                         . cl-ulong) +    (:device-max-constant-buffer-size                . cl-ulong) +    (:device-max-constant-args                       . cl-uint) +    (:device-local-mem-type                          . cl-device-local-mem-type) +    (:device-local-mem-size                          . cl-ulong) +    (:device-error-correction-support                . cl-bool) +    (:device-profiling-timer-resolution              . :size) +    (:device-endian-little                           . cl-bool) +    (:device-available                               . cl-bool) +    (:device-compiler-available                      . cl-bool) +    (:device-execution-capabilities                  . cl-device-exec-capabilities) +    (:device-queue-properties                        . cl-command-queue-properties) +    (:device-queue-on-host-properties                . cl-command-queue-properties) +    (:device-name                                    . :string) +    (:device-vendor                                  . :string) +    (:driver-version                                 . :string) +    (:device-profile                                 . :string) +    (:device-version                                 . :string) +    (:device-extensions                              . :string) +    (:device-platform                                . cl-platform-id) +    (:device-double-fp-config                        . cl-device-fp-config) +    (:device-preferred-vector-width-half             . cl-uint) +    (:device-host-unified-memory                     . cl-bool) +    (:device-native-vector-width-char                . cl-uint) +    (:device-native-vector-width-short               . cl-uint) +    (:device-native-vector-width-int                 . cl-uint) +    (:device-native-vector-width-long                . cl-uint) +    (:device-native-vector-width-float               . cl-uint) +    (:device-native-vector-width-double              . cl-uint) +    (:device-native-vector-width-half                . cl-uint) +    (:device-opencl-c-version                        . :string) +    (:device-linker-available                        . cl-bool) +    (:device-built-in-kernels                        . :string) +    (:device-image-max-buffer-size                   . :size) +    (:device-image-max-array-size                    . :size) +    (:device-parent-device                           . cl-device-id) +    (:device-partition-max-sub-devices               . cl-uint) +    (:device-partition-properties                    . (:pointer cl-device-partition-property)) +    (:device-partition-affinity-domain               . cl-device-affinity-domain) +    (:device-partition-type                          . (:pointer cl-device-partition-property)) +    (:device-reference-count                         . cl-uint) +    (:device-preferred-interop-user-sync             . cl-bool) +    (:device-printf-buffer-size                      . :size) +    (:device-image-pitch-alignment                   . cl-uint) +    (:device-image-base-address-alignment            . cl-uint) +    (:device-max-read-write-image-args               . cl-uint) +    (:device-max-global-variable-size                . :size) +    (:device-queue-on-device-properties              . cl-command-queue-properties) +    (:device-queue-on-device-preferred-size          . cl-uint) +    (:device-queue-on-device-max-size                . cl-uint) +    (:device-max-on-device-queues                    . cl-uint) +    (:device-max-on-device-events                    . cl-uint) +    (:device-svm-capabilities                        . cl-device-svm-capabilities) +    (:device-global-variable-preferred-total-size    . :size) +    (:device-max-pipe-args                           . cl-uint) +    (:device-pipe-max-active-reservations            . cl-uint) +    (:device-pipe-max-packet-size                    . cl-uint) +    (:device-preferred-platform-atomic-alignment     . cl-uint) +    (:device-preferred-global-atomic-alignment       . cl-uint) +    (:device-preferred-local-atomic-alignment        . cl-uint) +    (:device-il-version                              . :string) +    (:device-max-num-sub-groups                      . cl-uint) +    (:device-sub-group-independent-forward-progress  . cl-bool) +    (:device-numeric-version                         . cl-version) +    (:device-extensions-with-version                 . (:pointer cl-name-version)) +    (:device-ils-with-version                        . (:pointer cl-name-version)) +    (:device-built-in-kernels-with-version           . (:pointer cl-name-version)) +    (:device-atomic-memory-capabilities              . cl-device-atomic-capabilities) +    (:device-atomic-fence-capabilities               . cl-device-atomic-capabilities) +    (:device-non-uniform-work-group-support          . cl-bool) +    (:device-opencl-c-all-versions                   . (:pointer cl-name-version)) +    (:device-preferred-work-group-size-multiple      . :size) +    (:device-work-group-collective-functions-support . cl-bool) +    (:device-generic-address-space-support           . cl-bool) +    (:device-opencl-c-features                       . (:pointer cl-name-version)) +    (:device-device-enqueue-capabilities             . cl-device-device-enqueue-capabilities) +    (:device-pipe-support                            . cl-bool) +    (:device-latest-conformance-version-passed       . :string))) + +(wrap-get-info-function get-device-info %get-device-info +device-info-type-alist+) + +;; (defun get-device-info (device param-name) +;;   (let ((type (assoc-value +device-info-type-alist+ param-name)) +;;         (return-size nil) +;;         (error-code nil) +;;         (return-value nil)) +;;     (cffi:with-foreign-object (c-return-size :size) +;;       (setf error-code (%get-device-info device param-name 0 (cffi:null-pointer) c-return-size)) +;;       (unless (eq error-code :success) +;;         (error 'opencl-error :code error-code)) +;;       (setf return-size (cffi:mem-ref c-return-size :size))) +;;     (cond ((vector-type-p type) +;;            (let ((count (/ return-size (cffi:foreign-type-size (second type))))) +;;              (cffi:with-foreign-object (c-value type count) +;;                (setf error-code (%get-device-info device param-name return-size c-value (cffi:null-pointer))) +;;                (setf return-value (loop :for i :below count :collect (cffi:mem-aref c-value type i))) ))) +;;           ((string-type-p type) +;;            (setf return-value +;;                  (cffi:with-foreign-pointer-as-string (c-string return-size) +;;                    (setf error-code (%get-device-info device param-name return-size c-string (cffi:null-pointer)))))) +;;           (t +;;            (cffi:with-foreign-object (c-value type) +;;              (setf error-code (%get-device-info device param-name (cffi:foreign-type-size type) +;;                                                 c-value (cffi:null-pointer))) +;;              (setf return-value (cffi:mem-ref c-value type))))) +;;     (unless (eq error-code :success) +;;       (error 'opencl-error :code error-code)) +;;     return-value)) + +;; (defun create-sub-devices (in-device properties) +;;   (check-error (%create-sub-devices in-device ))) + +(defun retain-device (device) +  (check-error (%retain-device device))) + +(defun release-device (device) +  (check-error (%release-device device))) + +(defun set-default-device-command-queue (context device command-queue) +  (check-error (%set-default-device-command-queue context device command-queue))) + +(defun get-device-and-host-timer (device) +  (cffi:with-foreign-objects ((device-timestamp 'cl-ulong) +                              (host-timestamp 'cl-ulong)) +    (check-error (%get-device-and-host-timer device device-timestamp host-timestamp)) +    (values (cffi:mem-ref device-timestamp 'cl-ulong) +            (cffi:mem-ref host-timestamp 'cl-ulong)))) + +(defun get-host-timer (device) +  (cffi:with-foreign-object (host-timestamp 'cl-ulong) +    (check-error (%get-host-timer device host-timestamp)) +    (cffi:mem-ref host-timestamp 'cl-ulong))) diff --git a/src/enqueue.lisp b/src/enqueue.lisp new file mode 100644 index 0000000..d26f1c3 --- /dev/null +++ b/src/enqueue.lisp @@ -0,0 +1,77 @@ +(in-package #:ocl) + +;; once-only really needed? +;; gensym really needed? +(defmacro wrap-enqueue (form event-wait-list) +  "" +  (let ((num-events-in-wait-list (gensym "NUM-EVENTS-IN-WAIT-LIST")) +        (c-event-wait-list (gensym "C-EVENT-WAIT-LIST")) +        (c-event (gensym "C-EVENT")) +        (i (gensym "I"))) +    (alexandria:once-only (event-wait-list) +      `(let ((,num-events-in-wait-list (length ,event-wait-list))) +         (cffi:with-foreign-object (,c-event 'cl-event) +           (if (zerop ,num-events-in-wait-list) +               (check-error (,@form 0 (cffi:null-pointer) ,c-event)) +               (cffi:with-foreign-object (,c-event-wait-list 'cl-event ,num-events-in-wait-list) +                 (dotimes (,i ,num-events-in-wait-list) +                   (setf (cffi:mem-aref ,c-event-wait-list 'cl-event ,i) (elt ,event-wait-list ,i))) +                 (check-error (,@form ,num-events-in-wait-list ,c-event-wait-list ,c-event)) +                 (cffi:mem-ref ,c-event 'cl-event)))))))) + +(defun enqueue-read-buffer (command-queue buffer blocking-read offset size ptr &optional event-wait-list) +  (wrap-enqueue (%enqueue-read-buffer command-queue buffer (if blocking-read :true :false) offset size ptr) +                event-wait-list)) + +;; TODO: Check dimensions? +(defun enqueue-nd-range-kernel (queue kernel global-work-offset global-work-size +                                local-work-size &optional event-wait-list) +  (setf global-work-offset (alexandria:ensure-list global-work-offset) +        global-work-size (alexandria:ensure-list global-work-size) +        local-work-size (alexandria:ensure-list local-work-size)) +  ;; (assert (length global-work-size) ...) +  (let ((work-dim (length global-work-size))) +    (with-foreign-sequences ((c-global-work-offset global-work-offset :size) +                             (c-global-work-size global-work-size :size) +                             (c-local-work-size local-work-size :size)) +      (wrap-enqueue (%enqueue-nd-range-kernel queue kernel work-dim +                                              c-global-work-offset c-global-work-size +                                              c-local-work-size) +                    event-wait-list)))) + +(defun enqueue-svm-free (command-queue svm-pointers &optional event-wait-list +                                                      (pfn-free-func (cffi:null-pointer)) +                                                      (user-data (cffi:null-pointer))) +  (with-foreign-sequence (c-svm-pointers svm-pointers '(:pointer :void) num-svm-pointers) +    (wrap-enqueue +     (%enqueue-svm-free command-queue num-svm-pointers c-svm-pointers +                        pfn-free-func user-data) +     event-wait-list))) + +(defun enqueue-svm-memcpy (command-queue blocking-copy-p dst-ptr src-ptr size +                           &optional event-wait-list) +  (wrap-enqueue +   (%enqueue-svm-memcpy command-queue (if blocking-copy-p :true :false) dst-ptr src-ptr size) +   event-wait-list)) + +(defun enqueue-svm-memfill (command-queue svm-ptr pattern pattern-size size +                            &optional event-wait-list) +  (wrap-enqueue +   (%enqueue-svm-memfill command-queue svm-ptr pattern pattern-size size) +   event-wait-list)) + +(defun enqueue-svm-map (command-queue blocking-map-p flags svm-ptr size +                        &optional event-wait-list) +  (wrap-enqueue +   (%enqueue-svm-map command-queue (if blocking-map-p :true :false) flags svm-ptr size) +   event-wait-list)) + +(defun enqueue-svm-unmap (command-queue svm-ptr &optional event-wait-list) +  (wrap-enqueue (%enqueue-svm-unmap command-queue svm-ptr) event-wait-list)) + +(defun enqueue-svm-migrate-mem (command-queue svm-pointers sizes flags &optional event-wait-list) +  (assert (or (emptyp sizes) (length= svm-pointers sizes))) +  (with-foreign-sequences ((c-svm-pointers svm-pointers '(:pointer :void) num-svm-pointers) +                           (c-sizes sizes :size)) +    (wrap-enqueue (%enqueue-svm-migrate-mem command-queue num-svm-pointers c-svm-pointers c-sizes flags) +                  event-wait-list))) diff --git a/src/event.lisp b/src/event.lisp new file mode 100644 index 0000000..fb6e98a --- /dev/null +++ b/src/event.lisp @@ -0,0 +1,26 @@ +(in-package #:ocl) + +(defun wait-for-events (event-list) +  (with-foreign-sequence (c-event-list event-list 'cl-event num-events) +    (check-error (%wait-for-events num-events c-event-list)))) + +(defun create-user-event (context) +  (check-error-arg (%create-user-event context))) + +(defparameter +event-info-type-alist+ +  '((:event-command-queue            . cl-command-queue) +    (:event-context                  . cl-context) +    (:event-command-type             . cl-command-type) +    (:event-command-execution-status . cl-int) +    (:event-reference-count          . cl-uint))) + +(wrap-get-info-function get-event-info %get-event-info +event-info-type-alist+) + +(defun retain-event (event) +  (check-error (%retain-event event))) + +(defun release-event (event) +  (check-error (%release-event event))) + +(defun set-user-event-status (event execution-status) +  (check-error (%set-user-event-status event execution-status))) diff --git a/src/extensions.lisp b/src/extensions.lisp new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/src/extensions.lisp diff --git a/src/flush.lisp b/src/flush.lisp new file mode 100644 index 0000000..4ab282b --- /dev/null +++ b/src/flush.lisp @@ -0,0 +1,7 @@ +(in-package #:ocl) + +(defun flush (command-queue) +  (check-error (%flush command-queue))) + +(defun finish (command-queue) +  (check-error (%finish command-queue))) diff --git a/src/kernel.lisp b/src/kernel.lisp new file mode 100644 index 0000000..65bc066 --- /dev/null +++ b/src/kernel.lisp @@ -0,0 +1,61 @@ +(in-package #:ocl) + +(defun create-kernel (program kernel-name) +  (check-error-arg (%create-kernel program kernel-name))) + +(get-cl-objects create-kernels-in-program (program) +    %create-kernels-in-program 'cl-kernel) + +(defun clone-kernel (source-kernel) +  (check-error-arg (%clone-kernel source-kernel))) + +(defun retain-kernel (kernel) +  (check-error (%retain-kernel kernel))) + +(defun release-kernel (kernel) +  (check-error (%release-kernel kernel))) + +(defmacro with-kernel ((kernel program name) &body body) +  `(let ((,kernel (create-kernel ,program ,name))) +     (unwind-protect +          (progn ,@body) +       (release-kernel ,kernel)))) + +(defun set-kernel-arg (kernel arg-index arg-type arg-value) +  (cffi:with-foreign-pointer (value (cffi:foreign-type-size arg-type) size) +    (setf (cffi:mem-ref value arg-type) arg-value) +    (check-error (%set-kernel-arg kernel arg-index size value)))) + +(defparameter +kernel-info-type-alist+ +  '((:kernel-function-name   . :string) +    (:kernel-num-args        . cl-uint) +    (:kernel-reference-count . cl-uint) +    (:kernel-context         . cl-context) +    (:kernel-program         . cl-program) +    (:kernel-attributes      . :string))) + +(wrap-get-info-function get-kernel-info %get-kernel-info +kernel-info-type-alist+) + +(defparameter +kernel-arg-info-type-alist+ +  '((:kernel-arg-address-qualifier . cl-kernel-arg-address-qualifier) +    (:kernel-arg-access-qualifier  . cl-kernel-arg-access-qualifier) +    (:kernel-arg-type-name         . :string) +    (:kernel-arg-type-qualifier    . cl-kernel-arg-type-qualifier) +    (:kernel-arg-name              . :string))) + +;; %get-kernel-arg-info + +(defparameter +kernel-work-group-info-type-alist+ +  '((:kernel-global-work-size                   . (:pointer :size)) +    (:kernel-work-group-size                    . :size) +    (:kernel-compile-work-group-size            . (:pointer :size)) +    (:kernel-local-mem-size                     . cl-ulong) +    (:kernel-preferred-work-group-size-multiple . :size) +    (:kernel-private-mem-size                   . cl-ulong))) + +;; %get-kernel-work-group-info + +;; (defparameter +kernel-sub-group-info-type-alist+ +;;   '(())) + +;; %get-kernel-sub-group-info diff --git a/src/memory.lisp b/src/memory.lisp new file mode 100644 index 0000000..f6ab419 --- /dev/null +++ b/src/memory.lisp @@ -0,0 +1,89 @@ +(in-package #:ocl) + +(defun create-buffer (context flags size &optional (host-ptr (cffi:null-pointer))) +  (check-error-arg (%create-buffer context flags size host-ptr))) + +;; TODO: Support multi-dimensional arrays? row-major? +(defun create-buffer-from-array (context flags array) +  (let* ((length (length array)) +         (c-type (array-foreign-type array)) +         (size (* length (cffi:foreign-type-size c-type)))) +    (cffi:with-foreign-array (c-array array (list :array c-type length)) +      (check-error-arg (%create-buffer context flags size c-array))))) + +(defun create-pipe (context flags packet-size max-packets &key properties) +  (declare (ignorable properties)) +  (check-error-arg +   (%create-pipe context flags packet-size max-packets (cffi:null-pointer)))) + +(defun retain-mem-object (memobj) +  (check-error (%retain-mem-object memobj))) + +(defun release-mem-object (memobj) +  (check-error (%release-mem-object memobj))) + +(get-cl-objects get-supported-image-formats (context flags image-type) +                %get-supported-image-formats 'cl-image-format) + +(defparameter +mem-object-info-type-alist+ +  '((:mem-type                 . cl-mem-object-type) +    (:mem-flags                . cl-mem-flags) +    (:mem-size                 . :size) +    (:mem-host-ptr             . (:pointer :void)) +    (:mem-map-count            . cl-uint) +    (:mem-reference-count      . cl-uint) +    (:mem-context              . cl-context) +    (:mem-associated-memobject . cl-mem) +    (:mem-offset               . :size) +    (:mem-uses-svm-pointer     . cl-bool) +    (:mem-properties           . (:pointer cl-mem-properties)))) + +(wrap-get-info-function get-mem-object-info %get-mem-object-info +                        +mem-object-info-type-alist+) + +(defparameter +image-info-type-alist+ +  '((:image-format         . cl-image-format) +    (:image-element-size   . :size) +    (:image-row-pitch      . :size) +    (:image-slice-pitch    . :size) +    (:image-width          . :size) +    (:image-height         . :size) +    (:image-depth          . :size) +    (:image-array-size     . :size) +    (:image-buffer         . cl-mem) +    (:image-num-mip-levels . cl-uint) +    (:image-num-samples    . cl-uint))) + +(wrap-get-info-function get-image-info %get-image-info +image-info-type-alist+) + +(defparameter +pipe-info-type-alist+ +  '((:pipe-packet-size . cl-uint) +    (:pipe-max-packets . cl-uint) +    (:pipe-properties  . (:pointer cl-pipe-properties)))) + +(wrap-get-info-function get-pipe-info %get-pipe-info +pipe-info-type-alist+) + +(defmacro with-mem-object ()) + +(defmacro with-buffer ((buffer context flags size &optional host-ptr) &body body) +  `(let ((,buffer (create-buffer ,context ,flags ,size ,(if host-ptr host-ptr '(cffi:null-pointer))))) +     (unwind-protect +          (progn ,@body) +       (release-mem-object ,buffer)))) + +(defmacro with-buffer-from-array ((buffer context flags array) &body body) +  `(let ((,buffer (create-buffer-from-array ,context ,flags ,array))) +     (unwind-protect +          (progn ,@body) +       (release-mem-object ,buffer)))) + +(defmacro with-buffers-from-arrays ()) + +(defun copy-buffer-to-array (queue buffer array) +  (let* ((length (length array)) +         (c-type (array-foreign-type array)) +         (size (* length (cffi:foreign-type-size c-type)))) +    (cffi:with-foreign-object (c-array c-type length) +      (enqueue-read-buffer queue buffer t 0 size c-array) +      (dotimes (i length) +        (setf (aref array i) (cffi:mem-aref c-array c-type i)))))) diff --git a/src/opencl.lisp b/src/opencl.lisp new file mode 100644 index 0000000..ca95928 --- /dev/null +++ b/src/opencl.lisp @@ -0,0 +1,109 @@ +(in-package #:ocl) + +(defmacro define-get-info ()) + +(define-condition opencl-error () +  ((code :initarg :code +          :reader opencl-error-code)) +  (:report (lambda (condition stream) +             (format stream "OPENCL-ERROR: ~A~%" (opencl-error-code condition))))) + +(defmacro check-error (error-code) +  (alexandria:once-only (error-code) +    `(unless (eq ,error-code :success) +       (error 'opencl-error :code ,error-code)))) + +;; TODO: Finish me +(defun array-foreign-type (array) +  "Returns the most appropiate foreign type to store ARRAY" +  (case (array-element-type array) +    (single-float :float) +    (double-float :double) +    (t nil))) + +(defun array-foreign-size (array) +  "Returns the size in bytes required to store a foreign version of ARRAY" +  (reduce #'* (array-dimensions array) +          :initial-value (cffi:foreign-type-size (array-foreign-type array)))) + +(defmacro check-error-arg (form) +  (let ((value (gensym "VALUE")) +        (error-code (gensym "ERROR-CODE")) +        (c-error-code (gensym "C-ERROR-CODE"))) +    `(cffi:with-foreign-object (,c-error-code 'cl-error-code) +       (let* ((,value (,@form ,c-error-code)) +              (,error-code (cffi:mem-ref ,c-error-code 'cl-error-code))) +         (if (eq ,error-code :success) +             ,value +             (error 'opencl-error :code ,error-code)))))) + +(defmacro with-foreign-arrays (bindings &body body) +  (if (null bindings) +      `(progn ,@body) +      `(cffi:with-foreign-array ,(first bindings) +         (with-foreign-arrays ,(rest bindings) +           ,@body)))) + +(defmacro with-foreign-sequence ((var lisp-sequence type &optional length) &body body) +  "Like CFFI:WITH-FOREIGN-ARRAY but works also for lists" +  (unless length (setf length (gensym "LENGTH"))) +  (alexandria:once-only (lisp-sequence type) +    `(let ((,length (length ,lisp-sequence))) +       (cffi:with-foreign-object (,var ,type ,length) +         (dotimes (i ,length) +           (setf (cffi:mem-aref ,var ,type i) (elt ,lisp-sequence i))) +         ,@body)))) + +(defmacro with-foreign-sequences (bindings &body body) +  (if bindings +      `(with-foreign-sequence ,(first bindings) +         (with-foreign-sequences ,(rest bindings) +           ,@body)) +      `(progn ,@body))) + +(defun vector-type-p (type) +  (and (consp type) (eq (car type) :pointer))) + +(defun string-type-p (type) +  (eq type :string)) + +(defmacro wrap-get-info-function (name low-level-name type-alist) +  "" +  ;; FIXME? This is a top level form, no call to GENSYM is needed, right? +  `(defun ,name (object param-name) +     (let ((type (assoc-value ,type-alist param-name)) +           (return-size nil) +           (error-code nil) +           (return-value nil)) +       (cffi:with-foreign-object (c-return-size :size) +         (setf error-code (,low-level-name object param-name 0 (cffi:null-pointer) c-return-size)) +         (check-error error-code) +         (setf return-size (cffi:mem-ref c-return-size :size))) +       (cond ((vector-type-p type) +              (let ((count (/ return-size (cffi:foreign-type-size (second type))))) +                (cffi:with-foreign-object (c-value type count) +                  (setf error-code (,low-level-name object param-name return-size c-value (cffi:null-pointer))) +                  (setf return-value (loop :for i :below count :collect (cffi:mem-aref c-value type i)))))) +             ((string-type-p type) +              (setf return-value +                    (cffi:with-foreign-pointer-as-string (c-string return-size) +                      (setf error-code (,low-level-name object param-name return-size c-string (cffi:null-pointer)))))) +             (t +              (cffi:with-foreign-object (c-value type) +                (setf error-code (,low-level-name object param-name (cffi:foreign-type-size type) +                                                  c-value (cffi:null-pointer))) +                (setf return-value (cffi:mem-ref c-value type))))) +       (check-error error-code) +       return-value))) + +(defmacro get-cl-objects (name (&rest args) low-level-name type) +  (assert (every #'symbolp args) nil "ARGS must be a list of only symbols") +  `(defun ,name (,@args) +     (let (n) +       (cffi:with-foreign-object (cn 'cl-uint) +         (check-error (,low-level-name ,@args 0 (cffi:null-pointer) cn)) +         (setf n (cffi:mem-ref cn 'cl-uint))) +       (cffi:with-foreign-object (c-objects ,type n) +         (check-error (,low-level-name ,@args n c-objects (cffi:null-pointer))) +         (loop :for i :below n +               :collect (cffi:mem-aref c-objects ,type i)))))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..ce8dc38 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,247 @@ +(defpackage #:ocl-ffi +  (:use #:cl) +  (:export +   ;; Platform APIs +   %get-platform-ids +   %get-platform-info + +   ;; Device APIs +   %get-device-ids +   %get-device-info +   %create-sub-devices +   %retain-device +   %release-device +   %set-default-device-command-queue +   %get-device-and-host-timer +   %get-host-timer + +   ;; Context APIs +   %create-context +   %create-context-from-type +   %retain-context +   %release-context +   %get-context-info +   set-context-destructor-callback + +   ;; Command Queue APIs +   %create-command-queue-with-properties +   %retain-command-queue +   %release-command-queue +   %get-command-queue-info + +   ;; Memory Object APIs +   %create-buffer +   create-sub-buffer +   create-image +   %create-pipe +   create-buffer-with-properties +   create-image-with-properties +   %retain-mem-object +   %release-mem-object +   %get-supported-image-formats +   %get-mem-object-info +   %get-image-info +   %get-pipe-info +   set-mem-object-destructor-callback + +   ;; SVM Allocation APIs +   svm-alloc +   svm-free + +   ;; Sampler APIs +   %create-sampler-with-properties +   %retain-sampler +   %release-sampler +   %get-sampler-info + +   ;; Program Object APIs +   %create-program-with-source +   create-program-with-binary +   create-program-with-built-in-kernels +   create-program-with-il +   %retain-program +   %release-program +   %build-program +   %compile-program +   %link-program +   set-program-release-callback +   set-program-specialization-constant +   %unload-platform-compiler +   %get-program-info +   %get-program-build-info + +   ;; Kernel Object APIs +   %create-kernel +   %create-kernels-in-program +   %clone-kernel +   %retain-kernel +   %release-kernel +   %set-kernel-arg +   set-kernel-arg-svm-pointer +   set-kernel-exec-info +   %get-kernel-info +   %get-kernel-arg-info +   %get-kernel-work-group-info +   %get-kernel-sub-group-info + +   ;; Event Object APIs +   %wait-for-events +   %get-event-info +   %create-user-event +   %retain-event +   %release-event +   %set-user-event-status +   set-event-callback + +   ;; Profiling APIs +   %get-event-profiling-info + +   ;; Flush and Finish APIs +   %flush +   %finish + +   ;; Enqueued Commands APIs +   %enqueue-read-buffer +   enqueue-read-buffer-rect +   enqueue-write-buffer +   enqueue-write-buffer-rect +   enqueue-fill-buffer +   enqueue-copy-buffer +   enqueue-copy-buffer-rect +   enqueue-read-image +   enqueue-write-image +   enqueue-fill-image +   enqueue-copy-image +   enqueue-copy-image-to-buffer +   enqueue-copy-buffer-to-image +   enqueue-map-buffer +   enqueue-map-image +   enqueue-unmap-mem-object +   enqueue-migrate-mem-objects +   %enqueue-nd-range-kernel +   enqueue-native-kernel +   enqueue-marker-with-wait-list +   enqueue-barrier-with-wait-list +   %enqueue-svm-free +   %enqueue-svm-memcpy +   %enqueue-svm-memfill +   %enqueue-svm-map +   %enqueue-svm-unmap +   %enqueue-svm-migrate-mem + +   ;; Extension function access +   get-extension-function-address-for-platform + +   ;; Deprecated OpenCL 1.0 APIs +   set-command-queue-property + +   ;; Deprecated OpenCL 1.1 APIs +   create-image-2d +   create-image-3d +   enqueue-marker +   %enqueue-wait-for-events +   enqueue-barrier +   unload-compiler +   get-extension-function-address + +   ;; Deprecated OpenCL 2.0 APIs +   %create-command-queue +   create-sampler +   enqueue-task + +   ;; Types +   cl-char +   cl-uchar +   cl-short +   cl-ushort +   cl-int +   cl-uint +   cl-long +   cl-ulong + +   cl-half +   cl-float +   cl-double + +   cl-platform-id +   cl-device-id +   cl-context +   cl-command-queue +   cl-mem +   cl-program +   cl-kernel +   cl-event +   cl-sampler + +   cl-error-code +   cl-bool +   cl-bitfield +   cl-properties + +   cl-platform-info +   cl-device-info + +   cl-device-mem-cache-type +   cl-device-local-mem-type +   cl-context-info +   cl-command-queue-info +   cl-channel-order +   cl-channel-type +   cl-mem-object-type +   cl-mem-info +   cl-image-info +   cl-pipe-info +   cl-addressing-mode +   cl-filter-mode +   cl-sampler-info +   cl-program-info +   cl-program-build-info +   cl-build-status +   cl-kernel-info +   cl-kernel-arg-info +   cl-kernel-arg-address-qualifier +   cl-kernel-arg-access-qualifier +   cl-kernel-work-group-info +   cl-kernel-sub-group-info +   cl-kernel-exec-info +   cl-event-info +   cl-command-type +   cl-buffer-create-type +   cl-profiling-info +   cl-khronos-vendor-id +   cl-device-type +   cl-device-fp-config +   cl-device-exec-capabilities +   cl-device-svm-capabilities +   cl-command-queue-properties +   cl-device-affinity-domain +   cl-mem-flags +   cl-svm-mem-flags +   cl-mem-migration-flags +   cl-program-binary-type +   cl-map-flags +   cl-kernel-arg-type-qualifier +   cl-device-atomic-capabilities +   cl-device-device-enqueue-capabilities +   cl-mem-properties +   cl-queue-properties +   cl-device-partition-property +   cl-context-properties +   cl-pipe-properties +   cl-sampler-properties +   cl-version +   cl-image-format +   cl-buffer-region +   cl-name-version +   cl-image-desc)) + +(defpackage #:ocl +   (:use #:cl #:alexandria #:ocl-ffi)) + +(in-package #:ocl) + +(cffi:define-foreign-library libopencl +  (:unix (:or "libOpenCL.so" "/gnu/store/i70jq190cpc45crbnrw8g8lgb4djyi9r-opencl-icd-loader-2021.06.30/lib/libOpenCL.so")) +  (t (:default "libOpenCL"))) + +(cffi:use-foreign-library libopencl) diff --git a/src/platform.lisp b/src/platform.lisp new file mode 100644 index 0000000..1b976f4 --- /dev/null +++ b/src/platform.lisp @@ -0,0 +1,24 @@ +(in-package #:ocl) + +(defun get-platform-ids () +  (let ((num-platforms nil)) +    (cffi:with-foreign-object (c-num-platforms 'cl-uint) +      (check-error (%get-platform-ids 0 (cffi:null-pointer) c-num-platforms)) +      (setf num-platforms (cffi:mem-ref c-num-platforms 'cl-uint))) +    (cffi:with-foreign-object (c-platforms 'cl-platform-id num-platforms) +      (check-error (%get-platform-ids num-platforms c-platforms (cffi:null-pointer))) +      (loop :for i :below num-platforms +            :collect (cffi:mem-aref c-platforms 'cl-platform-id i))))) + +(defparameter +platform-info-type-alist+ +  '((:platform-profile                 . :string) +    (:platform-version                 . :string) +    (:platform-numeric-version         . cl-version) +    (:platform-name                    . :string) +    (:platform-vendor                  . :string) +    (:platform-extensions              . :string) +    (:platform-extensions-with-version . (:pointer cl-name-version)) +    (:platform-host-timer-resolution   . cl-ulong))) + +(wrap-get-info-function get-platform-info %get-platform-info +                        +platform-info-type-alist+) diff --git a/src/profiling.lisp b/src/profiling.lisp new file mode 100644 index 0000000..2d186d6 --- /dev/null +++ b/src/profiling.lisp @@ -0,0 +1,11 @@ +(in-package #:ocl) + +(defparameter +event-profiling-info-type-alist+ +  '((:profiling-command-queued   . cl-ulong) +    (:profiling-command-submit   . cl-ulong) +    (:profiling-command-start    . cl-ulong) +    (:profiling-command-end      . cl-ulong) +    (:profiling-command-complete . cl-ulong))) + +(wrap-get-info-function get-event-profiling-info %get-event-profiling-info +                        +event-profiling-info-type-alist+) diff --git a/src/program.lisp b/src/program.lisp new file mode 100644 index 0000000..4f27a25 --- /dev/null +++ b/src/program.lisp @@ -0,0 +1,83 @@ +(in-package #:ocl) + +(defun create-program-with-source (context list-of-strings) +  (setf list-of-strings (alexandria:ensure-list list-of-strings)) +  (let ((num-strings (length list-of-strings))) +    (cffi:with-foreign-object (c-strings :pointer num-strings) +      (dotimes (i num-strings) +        (setf (cffi:mem-aref c-strings :pointer i) +              (cffi:foreign-string-alloc (elt list-of-strings i)))) +      (unwind-protect +           (check-error-arg (%create-program-with-source context num-strings c-strings (cffi:null-pointer))) +        (dotimes (i num-strings) +          (cffi:foreign-string-free (cffi:mem-aref c-strings :pointer i))))))) + +(defun retain-program (program) +  (check-error (%retain-program program))) + +(defun release-program (program) +  (%release-program program)) + +(defun build-program (program device-list &key (options (cffi:null-pointer)) +                                            (pfn-notify (cffi:null-pointer)) +                                            (user-data (cffi:null-pointer))) +  (setf device-list (alexandria:ensure-list device-list)) +  (with-foreign-sequence (c-devices device-list 'cl-device-id num-devices) +    (check-error (%build-program program num-devices c-devices options +                                 pfn-notify user-data)))) + +;; (defun compile-program (program device-list +;;                         &key (options (cffi:null-pointer)) +;;                           input-headers +;;                           header-include-names +;;                           (pfn-notify (cffi:null-pointer)) +;;                           (user-data (cffi:null-pointer))) +;;   (with-foreign-sequence ((c-device-list device-list 'cl-device-id num-devices) +;;                           (c-input-headers input-headers 'cl-program num-input-headers)) +;;     (check-error (%compile-program program num-devices c-device-list options +;;                                    num-input-headers c-input-headers +;;                                    pfn-notify user-data)))) + +(defun link-program (context device-list input-programs &key (options (cffi:null-pointer)) +                                                          (pfn-notify (cffi:null-pointer)) +                                                          (user-data (cffi:null-pointer))) +  (assert (not (emptyp input-programs))) +  (with-foreign-sequences ((c-device-list device-list 'cl-device-id num-devices) +                           (c-input-programs input-programs 'cl-program num-input-programs)) +    (check-error-arg (%link-program context num-devices c-device-list options +                                    num-input-programs c-input-programs +                                    pfn-notify user-data)))) + +(defun unload-platform-compiler (platform) +  (check-error (%unload-platform-compiler platform))) + +(defparameter +program-info-type-alist+ +  '((:program-reference-count            . cl-uint) +    (:program-context                    . cl-context) +    (:program-num-devices                . cl-uint) +    (:program-devices                    . (:pointer cl-device-id)) +    (:program-source                     . :string) +    (:program-il                         . (:pointer :char)) +    (:program-binary-sizes               . (:pointer :size)) +    (:program-binaries                   . (:pointer (:pointer :char))) +    (:program-num-kernels                . :size) +    (:program-kernel-names               . (:pointer :char)) +    (:program-scope-global-ctors-present . cl-bool) +    (:program-scope-global-dtors-present . cl-bool))) + +;; %get-program-info + +(defparameter +program-build-info-type-alist+ +  '((:program-build-status                     . cl-build-status) +    (:program-build-options                    . :string) +    (:program-build-log                        . :string) +    (:program-binary-type                      . cl-program-binary-type) +    (:program-build-global-variable-total-size . :size))) + +;; %get-program-build-info + +(defmacro with-program-from-source ((program context list-of-strings) &body body) +  `(let ((,program (create-program-with-source ,context ,list-of-strings))) +     (unwind-protect +          (progn ,@body) +       (release-program ,program)))) diff --git a/src/sampler.lisp b/src/sampler.lisp new file mode 100644 index 0000000..5521ed7 --- /dev/null +++ b/src/sampler.lisp @@ -0,0 +1,27 @@ +(in-package #:ocl) + +(defun create-sampler-with-properties (context &key (normalized-coords-p t) +                                                 (addressing-mode :address-clamp) +                                                 (filter-mode :filter-nearest)) +  (let ((properties `(:sampler-normalized-coords ,normalized-coords-p +                      :sampler-addressing-mode ,addressing-mode +                      :sampler-filter-mode ,filter-mode +                      0))) +    (with-foreign-sequence (c-properties properties 'cl-sampler-properties) +      (check-error-arg (%create-sampler-with-properties context sampler-properties))))) + +(defun retain-sampler (sampler) +  (check-error (%retain-sampler sampler))) + +(defun release-sampler (sampler) +  (check-error (%release-sampler sampler))) + +(defparameter +sampler-info-type-alist+ +  '((:sampler-reference-count   . cl-uint) +    (:sampler-context           . cl-context) +    (:sampler-normalized-coords . cl-bool) +    (:sampler-addressing-mode   . cl-addressing-mode) +    (:sampler-filter-mode       . cl-filter-mode) +    (:sampler-properties        . (:pointer cl-sampler-properties)))) + +(wrap-get-info-function get-sampler-info %get-sampler-info +sampler-info-type-alist+) diff --git a/src/types.lisp b/src/types.lisp new file mode 100644 index 0000000..20a4882 --- /dev/null +++ b/src/types.lisp @@ -0,0 +1,630 @@ +(in-package #:ocl-ffi) + +(cffi:defctype cl-char :int8) +(cffi:defctype cl-uchar :uint8) +(cffi:defctype cl-short :int16) +(cffi:defctype cl-ushort :uint16) +(cffi:defctype cl-int :int32) +(cffi:defctype cl-uint :uint32) +(cffi:defctype cl-long :int64) +(cffi:defctype cl-ulong :uint64) + +(cffi:defctype cl-half :uint16) +(cffi:defctype cl-float :float) +(cffi:defctype cl-double :double) + +(cffi:defctype cl-platform-id :pointer) +(cffi:defctype cl-device-id :pointer) +(cffi:defctype cl-context :pointer) +(cffi:defctype cl-command-queue :pointer) +(cffi:defctype cl-mem :pointer) +(cffi:defctype cl-program :pointer) +(cffi:defctype cl-kernel :pointer) +(cffi:defctype cl-event :pointer) +(cffi:defctype cl-sampler :pointer) + +;;; Error Codes +(cffi:defcenum (cl-error-code cl-int) +  (:complete                                  0) +  (:running                                   1) +  (:submitted                                 2) +  (:queued                                    3) +  (:success                                   0) +  (:device-not-found                         -1) +  (:device-not-available                     -2) +  (:compiler-not-available                   -3) +  (:mem-object-allocation-failure            -4) +  (:out-of-resources                         -5) +  (:out-of-host-memory                       -6) +  (:profiling-info-not-available             -7) +  (:mem-copy-overlap                         -8) +  (:image-format-mismatch                    -9) +  (:image-format-not-supported               -10) +  (:build-program-failure                    -11) +  (:map-failure                              -12) +  (:misaligned-sub-buffer-offset             -13) +  (:exec-status-error-for-events-in-wait-list -14) +  (:compile-program-failure                  -15) +  (:linker-not-available                     -16) +  (:link-program-failure                     -17) +  (:device-partition-failed                  -18) +  (:kernel-arg-info-not-available            -19) +  (:invalid-value                            -30) +  (:invalid-device-type                      -31) +  (:invalid-platform                         -32) +  (:invalid-device                           -33) +  (:invalid-context                          -34) +  (:invalid-queue-properties                 -35) +  (:invalid-command-queue                    -36) +  (:invalid-host-ptr                         -37) +  (:invalid-mem-object                       -38) +  (:invalid-image-format-descriptor          -39) +  (:invalid-image-size                       -40) +  (:invalid-sampler                          -41) +  (:invalid-binary                           -42) +  (:invalid-build-options                    -43) +  (:invalid-program                          -44) +  (:invalid-program-executable               -45) +  (:invalid-kernel-name                      -46) +  (:invalid-kernel-definition                -47) +  (:invalid-kernel                           -48) +  (:invalid-arg-index                        -49) +  (:invalid-arg-value                        -50) +  (:invalid-arg-size                         -51) +  (:invalid-kernel-args                      -52) +  (:invalid-work-dimension                   -53) +  (:invalid-work-group-size                  -54) +  (:invalid-work-item-size                   -55) +  (:invalid-global-offset                    -56) +  (:invalid-event-wait-list                  -57) +  (:invalid-event                            -58) +  (:invalid-operation                        -59) +  (:invalid-gl-object                        -60) +  (:invalid-buffer-size                      -61) +  (:invalid-mip-level                        -62) +  (:invalid-global-work-size                 -63) +  (:invalid-property                         -64) +  (:invalid-image-descriptor                 -65) +  (:invalid-compiler-options                 -66) +  (:invalid-linker-options                   -67) +  (:invalid-device-partition-count           -68) +  (:invalid-pipe-size                        -69) +  (:invalid-device-queue                     -70) +  (:invalid-spec-id                          -71) +  (:max-size-restriction-exceeded            -72)) + +(cffi:defcenum (cl-bool cl-uint) +  (:false 0) +  (:true 1) +  (:blocking 1) +  (:non-blocking 0)) + +(cffi:defctype cl-bitfield cl-ulong) +(cffi:defctype cl-properties cl-ulong) + +(cffi:defcenum (cl-platform-info cl-uint) +  (:platform-profile #x0900) +  (:platform-version #x0901) +  (:platform-name #x0902) +  (:platform-vendor #x0903) +  (:platform-extensions #x0904) +  (:platform-host-timer-resolution #x0905) +  (:platform-numeric-version #x0906) +  (:platform-extensions-with-version #x0907)) + +(cffi:defcenum (cl-device-info cl-uint) +  (:device-type #x1000) +  (:device-vendor-id #x1001) +  (:device-max-compute-units #x1002) +  (:device-max-work-item-dimensions #x1003) +  (:device-max-work-group-size #x1004) +  (:device-max-work-item-sizes #x1005) +  (:device-preferred-vector-width-char #x1006) +  (:device-preferred-vector-width-short #x1007) +  (:device-preferred-vector-width-int #x1008) +  (:device-preferred-vector-width-long #x1009) +  (:device-preferred-vector-width-float #x100a) +  (:device-preferred-vector-width-double #x100b) +  (:device-max-clock-frequency #x100c) +  (:device-address-bits #x100d) +  (:device-max-read-image-args #x100e) +  (:device-max-write-image-args #x100f) +  (:device-max-mem-alloc-size #x1010) +  (:device-image2d-max-width #x1011) +  (:device-image2d-max-height #x1012) +  (:device-image3d-max-width #x1013) +  (:device-image3d-max-height #x1014) +  (:device-image3d-max-depth #x1015) +  (:device-image-support #x1016) +  (:device-max-parameter-size #x1017) +  (:device-max-samplers #x1018) +  (:device-mem-base-addr-align #x1019) +  (:device-min-data-type-align-size #x101a) +  (:device-single-fp-config #x101b) +  (:device-global-mem-cache-type #x101c) +  (:device-global-mem-cacheline-size #x101d) +  (:device-global-mem-cache-size #x101e) +  (:device-global-mem-size #x101f) +  (:device-max-constant-buffer-size #x1020) +  (:device-max-constant-args #x1021) +  (:device-local-mem-type #x1022) +  (:device-local-mem-size #x1023) +  (:device-error-correction-support #x1024) +  (:device-profiling-timer-resolution #x1025) +  (:device-endian-little #x1026) +  (:device-available #x1027) +  (:device-compiler-available #x1028) +  (:device-execution-capabilities #x1029) +  (:device-queue-properties #x102a) +  (:device-queue-on-host-properties #x102a) +  (:device-name #x102b) +  (:device-vendor #x102c) +  (:driver-version #x102d) +  (:device-profile #x102e) +  (:device-version #x102f) +  (:device-extensions #x1030) +  (:device-platform #x1031) +  (:device-double-fp-config #x1032) +  (:device-preferred-vector-width-half #x1034) +  (:device-host-unified-memory #x1035) +  (:device-native-vector-width-char #x1036) +  (:device-native-vector-width-short #x1037) +  (:device-native-vector-width-int #x1038) +  (:device-native-vector-width-long #x1039) +  (:device-native-vector-width-float #x103a) +  (:device-native-vector-width-double #x103b) +  (:device-native-vector-width-half #x103c) +  (:device-opencl-c-version #x103d) +  (:device-linker-available #x103e) +  (:device-built-in-kernels #x103f) +  (:device-image-max-buffer-size #x1040) +  (:device-image-max-array-size #x1041) +  (:device-parent-device #x1042) +  (:device-partition-max-sub-devices #x1043) +  (:device-partition-properties #x1044) +  (:device-partition-affinity-domain #x1045) +  (:device-partition-type #x1046) +  (:device-reference-count #x1047) +  (:device-preferred-interop-user-sync #x1048) +  (:device-printf-buffer-size #x1049) +  (:device-image-pitch-alignment #x104a) +  (:device-image-base-address-alignment #x104b) +  (:device-max-read-write-image-args #x104c) +  (:device-max-global-variable-size #x104d) +  (:device-queue-on-device-properties #x104e) +  (:device-queue-on-device-preferred-size #x104f) +  (:device-queue-on-device-max-size #x1050) +  (:device-max-on-device-queues #x1051) +  (:device-max-on-device-events #x1052) +  (:device-svm-capabilities #x1053) +  (:device-global-variable-preferred-total-size #x1054) +  (:device-max-pipe-args #x1055) +  (:device-pipe-max-active-reservations #x1056) +  (:device-pipe-max-packet-size #x1057) +  (:device-preferred-platform-atomic-alignment #x1058) +  (:device-preferred-global-atomic-alignment #x1059) +  (:device-preferred-local-atomic-alignment #x105a) +  (:device-il-version #x105b) +  (:device-max-num-sub-groups #x105c) +  (:device-sub-group-independent-forward-progress #x105d) +  (:device-numeric-version #x105e) +  (:device-extensions-with-version #x1060) +  (:device-ils-with-version #x1061) +  (:device-built-in-kernels-with-version #x1062) +  (:device-atomic-memory-capabilities #x1063) +  (:device-atomic-fence-capabilities #x1064) +  (:device-non-uniform-work-group-support #x1065) +  (:device-opencl-c-all-versions #x1066) +  (:device-preferred-work-group-size-multiple #x1067) +  (:device-work-group-collective-functions-support #x1068) +  (:device-generic-address-space-support #x1069) +  (:device-opencl-c-features #x106f) +  (:device-device-enqueue-capabilities #x1070) +  (:device-pipe-support #x1071) +  (:device-latest-conformance-version-passed #x1072)) + +(cffi:defcenum (cl-device-mem-cache-type cl-uint) +  (:none #x0) +  (:read-only-cache #x1) +  (:read-write-cache #x2)) + +(cffi:defcenum (cl-device-local-mem-type cl-uint) +  (:local #x1) +  (:global #x2)) + + +(cffi:defcenum (cl-context-info cl-uint) +  (:context-reference-count #x1080) +  (:context-devices #x1081) +  (:context-properties #x1082) +  (:context-num-devices #x1083)) + +(cffi:defcenum (cl-command-queue-info cl-uint) +  (:queue-context #x1090) +  (:queue-device #x1091) +  (:queue-reference-count #x1092) +  (:queue-properties #x1093) +  (:queue-size #x1094) +  (:queue-device-default #x1095) +  (:queue-properties-array #x1098)) + +(cffi:defcenum (cl-channel-order cl-uint) +  (:r #x10b0) +  (:a #x10b1) +  (:rg #x10b2) +  (:ra #x10b3) +  (:rgb #x10b4) +  (:rgba #x10b5) +  (:bgra #x10b6) +  (:argb #x10b7) +  (:intensity #x10b8) +  (:luminance #x10b9) +  (:rx #x10ba) +  (:rgx #x10bb) +  (:rgbx #x10bc) +  (:depth #x10bd) +  (:depth-stencil #x10be) +  (:srgb #x10bf) +  (:srgbx #x10c0) +  (:srgba #x10c1) +  (:sbgra #x10c2) +  (:abgr #x10c3)) + +(cffi:defcenum (cl-channel-type cl-uint) +  (:snorm-int8 #x10d0) +  (:snorm-int16 #x10d1) +  (:unorm-int8 #x10d2) +  (:unorm-int16 #x10d3) +  (:unorm-short-565 #x10d4) +  (:unorm-short-555 #x10d5) +  (:unorm-int-101010 #x10d6) +  (:signed-int8 #x10d7) +  (:signed-int16 #x10d8) +  (:signed-int32 #x10d9) +  (:unsigned-int8 #x10da) +  (:unsigned-int16 #x10db) +  (:unsigned-int32 #x10dc) +  (:half-float #x10dd) +  (:float #x10de) +  (:unorm-int24 #x10df) +  (:unorm-int-101010-2 #x10e0)) + +(cffi:defcenum (cl-mem-object-type cl-uint) +  (:mem-object-buffer #x10f0) +  (:mem-object-image2d #x10f1) +  (:mem-object-image3d #x10f2) +  (:mem-object-image2d-array #x10f3) +  (:mem-object-image1d #x10f4) +  (:mem-object-image1d-array #x10f5) +  (:mem-object-image1d-buffer #x10f6) +  (:mem-object-pipe #x10f7)) + +(cffi:defcenum (cl-mem-info cl-uint) +  (:mem-type #x1100) +  (:mem-flags #x1101) +  (:mem-size #x1102) +  (:mem-host-ptr #x1103) +  (:mem-map-count #x1104) +  (:mem-reference-count #x1105) +  (:mem-context #x1106) +  (:mem-associated-memobject #x1107) +  (:mem-offset #x1108) +  (:mem-uses-svm-pointer #x1109) +  (:mem-properties #x110a)) + +(cffi:defcenum (cl-image-info cl-uint) +  (:image-format #x1110) +  (:image-element-size #x1111) +  (:image-row-pitch #x1112) +  (:image-slice-pitch #x1113) +  (:image-width #x1114) +  (:image-height #x1115) +  (:image-depth #x1116) +  (:image-array-size #x1117) +  (:image-buffer #x1118) +  (:image-num-mip-levels #x1119) +  (:image-num-samples #x111a)) + +(cffi:defcenum (cl-pipe-info cl-uint) +  (:pipe-packet-size #x1120) +  (:pipe-max-packets #x1121) +  (:pipe-properties #x1122)) + +(cffi:defcenum (cl-addressing-mode cl-uint) +  (:address-none #x1130) +  (:address-clamp-to-edge #x1131) +  (:address-clamp #x1132) +  (:address-repeat #x1133) +  (:address-mirrored-repeat #x1134)) + +(cffi:defcenum (cl-filter-mode cl-uint) +  (:filter-nearest #x1140) +  (:filter-linear #x1141)) + +(cffi:defcenum (cl-sampler-info cl-uint) +  (:sampler-reference-count #x1150) +  (:sampler-context #x1151) +  (:sampler-normalized-coords #x1152) +  (:sampler-addressing-mode #x1153) +  (:sampler-filter-mode #x1154) +  (:sampler-mip-filter-mode #x1155) +  (:sampler-lod-min #x1156) +  (:sampler-lod-max #x1157) +  (:sampler-properties #x1158)) + +(cffi:defcenum (cl-program-info cl-uint) +  (:program-reference-count #x1160) +  (:program-context #x1161) +  (:program-num-devices #x1162) +  (:program-devices #x1163) +  (:program-source #x1164) +  (:program-binary-sizes #x1165) +  (:program-binaries #x1166) +  (:program-num-kernels #x1167) +  (:program-kernel-names #x1168) +  (:program-il #x1169) +  (:program-scope-global-ctors-present #x116a) +  (:program-scope-global-dtors-present #x116b)) + +(cffi:defcenum (cl-program-build-info cl-uint) +  (:program-build-status #x1181) +  (:program-build-options #x1182) +  (:program-build-log #x1183) +  (:program-binary-type #x1184) +  (:program-build-global-variable-total-size #x1185)) + +(cffi:defcenum (cl-build-status cl-int) +  (:build-success 0) +  (:build-none -1) +  (:build-error -2) +  (:build-in-progress -3)) + +(cffi:defcenum (cl-kernel-info cl-uint) +  (:kernel-function-name #x1190) +  (:kernel-num-args #x1191) +  (:kernel-reference-count #x1192) +  (:kernel-context #x1193) +  (:kernel-program #x1194) +  (:kernel-attributes #x1195)) + +(cffi:defcenum (cl-kernel-arg-info cl-uint) +  (:kernel-arg-address-qualifier #x1196) +  (:kernel-arg-access-qualifier #x1197) +  (:kernel-arg-type-name #x1198) +  (:kernel-arg-type-qualifier #x1199) +  (:kernel-arg-name #x119a)) + +(cffi:defcenum (cl-kernel-arg-address-qualifier cl-uint) +  (:kernel-arg-address-global #x119b) +  (:kernel-arg-address-local #x119c) +  (:kernel-arg-address-constant #x119d) +  (:kernel-arg-address-private #x119e)) + +(cffi:defcenum (cl-kernel-arg-access-qualifier cl-uint) +  (:kernel-arg-access-read-only #x11a0) +  (:kernel-arg-access-write-only #x11a1) +  (:kernel-arg-access-read-write #x11a2) +  (:kernel-arg-access-none #x11a3)) + +(cffi:defcenum (cl-kernel-work-group-info cl-uint) +  (:kernel-work-group-size #x11b0) +  (:kernel-compile-work-group-size #x11b1) +  (:kernel-local-mem-size #x11b2) +  (:kernel-preferred-work-group-size-multiple #x11b3) +  (:kernel-private-mem-size #x11b4) +  (:kernel-global-work-size #x11b5)) + +(cffi:defcenum (cl-kernel-sub-group-info cl-uint) +  (:kernel-max-sub-group-size-for-ndrange #x2033) +  (:kernel-sub-group-count-for-ndrange #x2034) +  (:kernel-local-size-for-sub-group-count #x11b8) +  (:kernel-max-num-sub-groups #x11b9) +  (:kernel-compile-num-sub-groups #x11ba)) + +(cffi:defcenum (cl-kernel-exec-info cl-uint) +  (:kernel-exec-info-svm-ptrs #x11b6) +  (:kernel-exec-info-svm-fine-grain-system #x11b7)) + + +(cffi:defcenum (cl-event-info cl-uint) +  (:event-command-queue #x11d0) +  (:event-command-type #x11d1) +  (:event-reference-count #x11d2) +  (:event-command-execution-status #x11d3) +  (:event-context #x11d4)) + +(cffi:defcenum (cl-command-type cl-uint) +  (:command-ndrange-kernel #x11f0) +  (:command-task #x11f1) +  (:command-native-kernel #x11f2) +  (:command-read-buffer #x11f3) +  (:command-write-buffer #x11f4) +  (:command-copy-buffer #x11f5) +  (:command-read-image #x11f6) +  (:command-write-image #x11f7) +  (:command-copy-image #x11f8) +  (:command-copy-image-to-buffer #x11f9) +  (:command-copy-buffer-to-image #x11fa) +  (:command-map-buffer #x11fb) +  (:command-map-image #x11fc) +  (:command-unmap-mem-object #x11fd) +  (:command-marker #x11fe) +  (:command-acquire-gl-objects #x11ff) +  (:command-release-gl-objects #x1200) +  (:command-read-buffer-rect #x1201) +  (:command-write-buffer-rect #x1202) +  (:command-copy-buffer-rect #x1203) +  (:command-user #x1204) +  (:command-barrier #x1205) +  (:command-migrate-mem-objects #x1206) +  (:command-fill-buffer #x1207) +  (:command-fill-image #x1208) +  (:command-svm-free #x1209) +  (:command-svm-memcpy #x120a) +  (:command-svm-memfill #x120b) +  (:command-svm-map #x120c) +  (:command-svm-unmap #x120d) +  (:command-svm-migrate-mem #x120e)) + +(defconstant +complete+ #x0) +(defconstant +running+ #x1) +(defconstant +submitted+ #x2) +(defconstant +queued+ #x3) + +(cffi:defcenum (cl-buffer-create-type cl-uint) +    (:buffer-create-type-region #x1220)) + +(cffi:defcenum (cl-profiling-info cl-uint) +  (:profiling-command-queued #x1280) +  (:profiling-command-submit #x1281) +  (:profiling-command-start #x1282) +  (:profiling-command-end #x1283) +  (:profiling-command-complete #x1284)) + +(cffi:defcenum (cl-khronos-vendor-id cl-uint) +  (:khronos-vendor-id-codeplay #x10004)) + +(cffi:defbitfield (cl-device-type cl-bitfield) +  :device-type-default +  :device-type-cpu +  :device-type-gpu +  :device-type-accelerator +  :device-type-custom +  (:device-type-all #xffffffff)) + +(cffi:defbitfield (cl-device-fp-config cl-bitfield) +  :fp-denorm +  :fp-inf-nan +  :fp-round-to-nearest +  :fp-round-to-zero +  :fp-round-to-inf +  :fp-fma +  :fp-soft-float +  :fp-correctly-rounded-divide-sqrt) + +(cffi:defbitfield (cl-device-exec-capabilities cl-bitfield) +  :exec-kernel +  :exec-native-kernel) + +(cffi:defbitfield (cl-device-svm-capabilities cl-bitfield) +  :device-svm-coarse-grain-buffer +  :device-svm-fine-grain-buffer +  :device-svm-fine-grain-system +  :device-svm-atomics) + +(cffi:defbitfield (cl-command-queue-properties cl-bitfield) +  :queue-out-of-order-exec-mode-enable +  :queue-profiling-enable +  :queue-on-device +  :queue-on-device-default) + +(cffi:defbitfield (cl-device-affinity-domain cl-bitfield) +  :device-affinity-domain-numa +  :device-affinity-domain-l4-cache +  :device-affinity-domain-l3-cache +  :device-affinity-domain-l2-cache +  :device-affinity-domain-l1-cache +  :device-affinity-domain-next-partitionable) + +(cffi:defbitfield (cl-mem-flags cl-bitfield) +  :mem-read-write +  :mem-write-only +  :mem-read-only +  :mem-use-host-ptr +  :mem-alloc-host-ptr +  :mem-copy-host-ptr +  (:mem-host-write-only #x80) +  :mem-host-read-only +  :mem-host-no-access +  :mem-svm-fine-grain-buffer +  :mem-svm-atomics +  :mem-kernel-read-and-write) + +(cffi:defbitfield (cl-svm-mem-flags cl-bitfield) +  :mem-read-write +  :mem-write-only +  :mem-read-only +  :mem-use-host-ptr +  :mem-alloc-host-ptr +  :mem-copy-host-ptr +  (:mem-host-write-only #x80) +  :mem-host-read-only +  :mem-host-no-access +  :mem-svm-fine-grain-buffer +  :mem-svm-atomics +  :mem-kernel-read-and-write) + + +(cffi:defbitfield (cl-mem-migration-flags cl-bitfield) +  :migrate-mem-object-host +  :migrate-mem-object-content-undefined) + +(cffi:defbitfield (cl-program-binary-type cl-uint) +  :program-binary-type-none +  :program-binary-type-compiled-object +  :program-binary-type-library +  :program-binary-type-executable) + +(cffi:defbitfield (cl-map-flags cl-bitfield) +  :map-read +  :map-write +  :map-write-invalidate-region) + +(cffi:defbitfield (cl-kernel-arg-type-qualifier cl-bitfield) +  (:kernel-arg-type-none+ #x0) +  :kernel-arg-type-const +  :kernel-arg-type-restrict +  :kernel-arg-type-volatile +  :kernel-arg-type-pipe) + +(cffi:defbitfield (cl-device-atomic-capabilities cl-bitfield) +  :device-atomic-order-relaxed +  :device-atomic-order-acq-rel +  :device-atomic-order-seq-cst +  :device-atomic-scope-work-item +  :device-atomic-scope-work-group +  :device-atomic-scope-device +  :device-atomic-scope-all-devices) + +(cffi:defbitfield (cl-device-device-enqueue-capabilities cl-bitfield) +  :device-queue-supported +  :device-queue-replaceable-default) + +(cffi:defctype cl-mem-properties cl-properties) +(cffi:defctype cl-queue-properties cl-properties) +(cffi:defctype cl-device-partition-property :intptr) + +(cffi:defcenum (cl-context-properties :intptr :allow-undeclared-values t) +  (:context-platform #x1084) +  (:context-interop-user-sync #x1085)) + +(cffi:defctype cl-pipe-properties :intptr) +(cffi:defctype cl-sampler-properties cl-properties) + +(cffi:defctype cl-version cl-uint) + +(cffi:defcstruct cl-image-format +  (image-channel-order cl-channel-order) +  (image-channel-data-type cl-channel-type)) + +(cffi:defcstruct cl-buffer-region +  (origin :size) +  (size :size)) + +(cffi:defcstruct cl-name-version +  (version cl-version) +  ;; +name-version-max-name-size+ 64 +  (name :char :count 64)) + +(cffi:defcstruct cl-image-desc +  (image-type cl-mem-object-type) +  (image-width :size) +  (image-height :size) +  (image-depth :size) +  (image-array-size :size) +  (image-row-pitch :size) +  (image-slice-pitch :size) +  (num-mip-levels cl-uint) +  (num-samples cl-uint) +  ;; Anon union buffer / mem_object +  (buffer cl-mem)) | 
