#lang at-exp scheme/base (require scheme/foreign (except-in scheme/contract ->) scheme/local scribble/srcdoc (for-syntax scheme/base) (prefix-in c: scheme/contract) (file "include/cl.ss")) (require/doc scheme/base scribble/manual) (unsafe!) (define opencl-path (case (system-type) [(macosx) (build-path "/System" "Library" "Frameworks" "OpenCL.framework" "OpenCL")] [else (error 'opencl "This platform is not (yet) supported.")])) (define opencl-lib (ffi-lib opencl-path)) (define-syntax define-opencl (syntax-rules () [(_ id ty) (define-opencl id id ty)] [(_ id internal-id ty) (define id (get-ffi-obj 'internal-id opencl-lib ty))])) ;;; (define-syntax-rule (define-opencl-bitfield _type valid-options _type/c (value ...)) (begin (define _type (_bitmask (append `(value = ,value) ...) _cl_bitfield)) (define the-symbols '(value ...)) (define symbol/c (apply symbols the-symbols)) (define _type/c (or/c symbol/c (listof symbol/c))) (define valid-options the-symbols) (provide/doc (thing-doc _type ctype? @{A ctype that represents an OpenCL bitfield where @scheme[valid-options] are the valid flags. It is actually a @scheme[_cl_bitfield].}) (thing-doc _type/c contract? @{A contract for @scheme[_type] that accepts any symbol in @scheme[valid-options] or lists containing subsets of @scheme[valid-options].}) (thing-doc valid-options (listof symbol?) @{A list of valid options for @scheme[_type]. Its value is @scheme['(value ...)].})))) (define-syntax-rule (define-opencl-enum _type base-type valid-options _type/c (value ...)) (begin (define _type (_enum (append `(value = ,value) ...) base-type)) (define the-symbols '(value ...)) (define symbol/c (apply symbols the-symbols)) (define _type/c symbol/c) (define valid-options the-symbols) (provide/doc (thing-doc _type ctype? @{A ctype that represents an OpenCL enumeration, implemented by @scheme[base-type], where @scheme[valid-options] are the valid values.}) (thing-doc _type/c contract? @{A contract for @scheme[_type] that accepts any symbol in @scheme[valid-options].}) (thing-doc valid-options (listof symbol?) @{A list of valid options for @scheme[_type]. Its value is @scheme['(value ...)].})))) (define-for-syntax (stxformat fmt stx . others) (datum->syntax stx (string->symbol (apply format fmt (syntax->datum stx) (map syntax->datum others))))) (require (for-syntax scheme/function)) (define-syntax (define-opencl-info stx) (syntax-case stx (args : error variable fixed) [(_ id (id:length id:selector) _param_type _param_type/c (args [arg_id : _arg_type _arg_type/c] ...) (error status error-expr) (variable param_value_size [_vtype _vtype_type _vtype-default _vtype/c vparam_name ...] ...) (fixed [_ftype _ftype/c fparam_name ...] ...)) (with-syntax ([id/c (stxformat "~a/c" #'id)] [(id:_ftype ...) (map (curry stxformat "~a:~a" #'id) (syntax->list #'(_ftype ...)))] [(id:_vtype ...) (map (curry stxformat "~a:~a" #'id) (syntax->list #'(_vtype ...)))]) (syntax/loc stx (begin ; Bind id for documentation (define (id . args) (error 'id "This function behaves differently for each type. Please use ~a or one of ~a." 'id:selector '(id:_ftype ... id:_vtype ...))) (provide/doc (thing-doc id procedure? @{A dummy Scheme function that refers callers to the other @scheme[id]-based functions which access the true C function.})) ; Return status (define (id-return status success) (if (= status CL_SUCCESS) (success) error-expr)) ; Info length (define-opencl id:length id (_fun [arg_id : _arg_type] ... [param_name : _param_type] [param_value_size : _size_t = 0] [param_value : _pointer = #f] [param_value_size_ret : (_ptr o _size_t)] -> [status : _cl_int] -> (id-return status (lambda () param_value_size_ret)))) (provide/doc (proc-doc id:length (([arg_id _arg_type/c] ... [param_name _param_type/c]) () . ->d . [length _size_t/c]) @{Returns the size of @scheme[param_name] field of the argument(s). Calls @scheme[id] with values for @scheme[_param_value_size] and @scheme[_param_value] such that @scheme[param_value_size_ret] is queried.})) ; Fixed length (define-opencl id:_ftype id (_fun [arg_id : _arg_type] ... [param_name : _param_type] [param_value_size : _size_t = (ctype-sizeof _ftype)] [param_value : (_ptr o _ftype)] [param_value_size_ret : _pointer = #f] -> [status : _cl_int] -> (id-return status (lambda () param_value)))) ... (provide/doc (proc-doc id:_ftype (([arg_id _arg_type/c] ... [param_name _param_type/c]) () . ->d . [value _ftype/c]) @{Returns the value associated with @scheme[param_name] for the argument(s). Implemented by @scheme[id] with @scheme[_param_value_size] set to @scheme[(ctype-sizeof _ftype)] so that the value is queried. Valid @scheme[param_name]s are @scheme['(fparam_name ...)].}) ...) ; Variable length (define-opencl id:_vtype id (_fun [arg_id : _arg_type] ... [param_name : _param_type] [param_value_size : _size_t] [param_value : _vtype_type] [param_value_size_ret : _pointer = #f] -> [status : _cl_int] -> (id-return status (lambda () param_value)))) ... (provide/doc (proc-doc id:_vtype (([arg_id _arg_type/c] ... [param_name _param_type/c] [param_value_size _size_t/c]) () . ->d . [value _vtype/c]) @{Returns the value associated with @scheme[param_name] for the argument(s). Implemented by @scheme[id] with @scheme[param_value_size] passed explicitly. Uses @scheme[id:length] to find the maximum value. Valid @scheme[param_name]s are @scheme['(vparam_name ...)].}) ...) ; Dispatcher (define id-selector-map (make-hasheq)) (define (hash-set!* ht v . ks) (for ([k (in-list ks)]) (hash-set! ht k v))) (hash-set!* id-selector-map '_vtype 'vparam_name ...) ... (hash-set!* id-selector-map '_ftype 'fparam_name ...) ... (define (id:selector _arg_type ... _param_type) (case (hash-ref id-selector-map _param_type #f) [(_vtype) (local [(define len (id:length _arg_type ... _param_type))] (if (zero? len) _vtype-default (id:_vtype _arg_type ... _param_type len)))] ... [(_ftype) (id:_ftype _arg_type ... _param_type)] ... [else (error 'id:selector "Invalid parameter: ~e" _param_type)])) (define id/c (or/c _ftype/c ... _vtype/c ...)) (provide/doc (thing-doc id/c contract? @{A contract for the return values of @scheme[id:selector]. Its definition is: @scheme[(or/c _ftype/c ... _vtype/c ...)].}) (proc-doc id:selector (([arg_id _arg_type/c] ... [param_name _param_type/c]) () . ->d . [value id/c]) @{Returns the value associated with @scheme[param_name] for the argument(s). Selects the appropriate @scheme[id]-based function to extract the appropriate value, automatically providing the right length for variable length functions.})))))])) (define-syntax define-opencl-count (syntax-rules (error :) [(_ id (id:count id:extract) ([arg : _arg_type _arg_type/c] ...) _return_type _return_type_vector/c (error status error-expr)) (begin (define (id:return status success) (cond [(= status CL_SUCCESS) (success)] [else error-expr])) (define-opencl id:count id (_fun [arg : _arg_type] ... [num : _cl_uint = 0] [rets : _pointer = #f] [num_rets : (_ptr o _cl_uint)] -> [status : _cl_int] -> (id:return status (lambda () num_rets)))) (define-opencl id (_fun [arg : _arg_type] ... [num : _cl_uint] [rets : (_cvector o _return_type num)] [num_rets : (_ptr o _cl_uint)] -> [status : _cl_int] -> (id:return status (lambda () (values rets num_rets))))) (define (id:extract arg ...) (define how-many (id:count arg ...)) (if (zero? how-many) (make-cvector _return_type 0) (local [(define-values (rs nrs) (id arg ... how-many))] rs))) (provide/doc (proc-doc id:count (([arg _arg_type/c] ...) () . ->d . [how-many _cl_uint/c]) @{Returns how many results @scheme[id] may return for these arguments.}) (proc-doc id (([arg _arg_type/c] ... [how-many _cl_uint/c]) () . ->d . (values [rets _return_type_vector/c] [how-many-possible _cl_uint/c])) @{Returns the minimum of @scheme[how-many] and @scheme[how-many-possible] values in @scheme[rets].}) (proc-doc id:extract (([arg _arg_type/c] ...) () . ->d . [rets _return_type_vector/c]) @{Returns all possible results from @scheme[id] using @scheme[id:count] to extract the number available.})))])) (define ((cvector-of? type) cv) (and (cvector? cv) (equal? (cvector-type cv) type))) (define-syntax (define-opencl-pointer stx) (syntax-case stx () [(_ _id) (with-syntax ([_id/c (stxformat "~a/c" #'_id)] [id? (datum->syntax stx (string->symbol (format "~a?" (substring (symbol->string (syntax->datum #'_id)) 1))))] [_id/null/c (stxformat "~a/null/c" #'_id)] [_id_vector/c (stxformat "~a_vector/c" #'_id)]) (syntax/loc stx (begin (define-cpointer-type _id) (define _id/c id?) (define _id/null/c (or/c false/c id?)) (define _id_vector/c (cvector-of? _id)) (provide/doc (thing-doc _id ctype? @{Represents a pointer to a particular kind of OpenCL object.}) (thing-doc _id/c contract? @{A contract for @scheme[_id] values.}) (thing-doc _id/null/c contract? @{A contract for @scheme[_id] values that includes NULL pointers, represented by @scheme[#f].}) (thing-doc _id_vector/c contract? @{A contract for cvectors of @scheme[_id] values.})))))])) (define-syntax (define-opencl-cstruct stx) (syntax-case stx () [(_ _id ([field _type] ...)) (with-syntax ([id (datum->syntax stx (string->symbol (substring (symbol->string (syntax->datum #'_id)) 1)))]) (with-syntax ([_id/c (stxformat "~a/c" #'_id)] [id? (stxformat "~a?" #'id)] [_id_vector/c (stxformat "~a_vector/c" #'_id)] [make-id (stxformat "make-~a" #'id)] [(_type/c ...) (map (curry stxformat "~a/c") (syntax->list #'(_type ...)))] [(_id-field ...) (map (curry stxformat "~a-~a" #'id) (syntax->list #'(field ...)))] [(set-_id-field! ...) (map (curry stxformat "set-~a-~a!" #'id) (syntax->list #'(field ...)))]) (syntax/loc stx (begin (define-cstruct _id ([field _type] ...)) (define _id/c id?) (define _id_vector/c (cvector-of? _id)) (provide/doc (thing-doc _id ctype? @{Represents a pointer to a particular kind of OpenCL object.}) (proc-doc make-id (->d ([field _type/c] ...) () [_ _id/c]) @{Constructs a @scheme[_id] value.}) (proc-doc _id-field (->d ([obj _id/c]) () [_ _type/c]) @{Extracts the @scheme[field] of a @scheme[_id] value.}) ... (proc-doc set-_id-field! (->d ([obj _id/c] [v _type/c]) () [_ void]) @{Sets the @scheme[field] of a @scheme[_id] value.}) ... (thing-doc _id/c contract? @{A contract for @scheme[_id] values.}) (thing-doc _id_vector/c contract? @{A contract for cvectors of @scheme[_id] values.}))))))])) (define-syntax (define-opencl-alias stx) (syntax-case stx () [(_ _opencl_type _ctype contract-expr) (with-syntax ([_opencl_type/c (stxformat "~a/c" #'_opencl_type)] [_opencl_type_vector/c (stxformat "~a_vector/c" #'_opencl_type)]) (syntax/loc stx (begin (define _opencl_type _ctype) (define _opencl_type/c contract-expr) (define _opencl_type_vector/c (cvector-of? _opencl_type)) (provide/doc (thing-doc _opencl_type ctype? @{An alias for @scheme[_ctype].}) (thing-doc _opencl_type/c contract? @{A contract for @scheme[_opencl_type] values. Defined as @scheme[contract-expr].}) (thing-doc _opencl_type_vector/c contract? @{A contract for vectors of @scheme[_opencl_type] values.})))))])) (define-opencl-alias _cl_uint _uint32 exact-nonnegative-integer?) (define-opencl-alias _cl_int _int32 exact-integer?) (define-opencl-alias _cl_ulong _uint64 exact-nonnegative-integer?) (define-opencl-enum _cl_bool _cl_uint valid-bools _cl_bool/c (CL_FALSE CL_TRUE)) (define-opencl-pointer _cl_platform_id) (define-opencl-enum _cl_platform_info _cl_uint valid-platform-infos _cl_platform_info/c (CL_PLATFORM_PROFILE CL_PLATFORM_VERSION CL_PLATFORM_NAME CL_PLATFORM_VENDOR CL_PLATFORM_EXTENSIONS)) (define-opencl-alias _cl_bitfield _cl_ulong _cl_ulong/c) (define-opencl-pointer _cl_device_id) (define-opencl-bitfield _cl_device_type valid-device-types _cl_device_type/c (CL_DEVICE_TYPE_CPU CL_DEVICE_TYPE_GPU CL_DEVICE_TYPE_ACCELERATOR CL_DEVICE_TYPE_DEFAULT CL_DEVICE_TYPE_ALL)) (define-opencl-enum _cl_device_info _cl_uint valid-device-infos _cl_device_info/c (CL_DEVICE_TYPE CL_DEVICE_VENDOR_ID CL_DEVICE_MAX_COMPUTE_UNITS CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS CL_DEVICE_MAX_WORK_GROUP_SIZE CL_DEVICE_MAX_WORK_ITEM_SIZES CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE CL_DEVICE_MAX_CLOCK_FREQUENCY CL_DEVICE_ADDRESS_BITS CL_DEVICE_MAX_READ_IMAGE_ARGS CL_DEVICE_MAX_WRITE_IMAGE_ARGS CL_DEVICE_MAX_MEM_ALLOC_SIZE CL_DEVICE_IMAGE2D_MAX_WIDTH CL_DEVICE_IMAGE2D_MAX_HEIGHT CL_DEVICE_IMAGE3D_MAX_WIDTH CL_DEVICE_IMAGE3D_MAX_HEIGHT CL_DEVICE_IMAGE3D_MAX_DEPTH CL_DEVICE_IMAGE_SUPPORT CL_DEVICE_MAX_PARAMETER_SIZE CL_DEVICE_MAX_SAMPLERS CL_DEVICE_MEM_BASE_ADDR_ALIGN CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE CL_DEVICE_SINGLE_FP_CONFIG CL_DEVICE_GLOBAL_MEM_CACHE_TYPE CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE CL_DEVICE_GLOBAL_MEM_CACHE_SIZE CL_DEVICE_GLOBAL_MEM_SIZE CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE CL_DEVICE_MAX_CONSTANT_ARGS CL_DEVICE_LOCAL_MEM_TYPE CL_DEVICE_LOCAL_MEM_SIZE CL_DEVICE_ERROR_CORRECTION_SUPPORT CL_DEVICE_PROFILING_TIMER_RESOLUTION CL_DEVICE_ENDIAN_LITTLE CL_DEVICE_AVAILABLE CL_DEVICE_COMPILER_AVAILABLE CL_DEVICE_EXECUTION_CAPABILITIES CL_DEVICE_QUEUE_PROPERTIES CL_DEVICE_NAME CL_DEVICE_VENDOR CL_DRIVER_VERSION CL_DEVICE_PROFILE CL_DEVICE_VERSION CL_DEVICE_EXTENSIONS CL_DEVICE_PLATFORM)) (define-opencl-bitfield _cl_device_fp_config valid-device-fp-config _cl_device_fp_config/c (CL_FP_DENORM CL_FP_INF_NAN CL_FP_ROUND_TO_NEAREST CL_FP_ROUND_TO_ZERO CL_FP_ROUND_TO_INF CL_FP_FMA)) (define-opencl-enum _cl_device_mem_cache_type _cl_uint valid-device-mem-cache-types _cl_device_mem_cache_type/c (CL_NONE CL_READ_ONLY_CACHE CL_READ_WRITE_CACHE)) (define-opencl-enum _cl_device_local_mem_type _cl_uint valid-device-local-mem-types _cl_device_local_mem_type/c (CL_LOCAL CL_GLOBAL)) (define-opencl-bitfield _cl_device_exec_capabilities valid-device-exec-capabilities _cl_device_exec_capabilities/c (CL_EXEC_KERNEL CL_EXEC_NATIVE_KERNEL)) ; XXX This is probably wrong on other platforms (define-opencl-alias _size_t _long exact-nonnegative-integer?) (define-opencl-alias _void* _pointer cpointer?) (define-opencl-alias _void*/null _pointer (or/c false/c cpointer?)) (define-opencl-pointer _cl_context) (define-opencl-bitfield _cl_command_queue_properties valid-command-queue-properties _cl_command_queue_properties/c (CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE CL_QUEUE_PROFILING_ENABLE)) (define-opencl-pointer _cl_command_queue) (define-opencl-bitfield _cl_mem_flags valid-mem-flags _cl_mem_flags/c (CL_MEM_READ_WRITE CL_MEM_WRITE_ONLY CL_MEM_READ_ONLY CL_MEM_USE_HOST_PTR CL_MEM_ALLOC_HOST_PTR CL_MEM_COPY_HOST_PTR)) (define-opencl-pointer _cl_mem) (define-opencl-pointer _cl_event) (define-opencl-enum _cl_channel_order _cl_uint valid-channel-orders _cl_channel_order/c (CL_R CL_A CL_INTENSITY CL_LUMINANCE CL_RG CL_RA CL_RGB CL_RGBA CL_ARGB CL_BGRA)) (define-opencl-enum _cl_channel_type _cl_uint valid-channel-types _cl_channel_type/c (CL_SNORM_INT8 CL_SNORM_INT16 CL_UNORM_INT8 CL_UNORM_INT16 CL_UNORM_SHORT_565 CL_UNORM_SHORT_555 CL_UNORM_INT_101010 CL_SIGNED_INT8 CL_SIGNED_INT16 CL_SIGNED_INT32 CL_UNSIGNED_INT8 CL_UNSIGNED_INT16 CL_UNSIGNED_INT32 CL_HALF_FLOAT CL_FLOAT)) (define-opencl-enum _cl_mem_object_type _cl_uint valid-mem-object-types _cl_mem_object_type/c (CL_MEM_OBJECT_IMAGE2D CL_MEM_OBJECT_IMAGE3D)) (define-opencl-bitfield _cl_map_flags valid-map-flags _cl_map_flags/c (CL_MAP_READ CL_MAP_WRITE)) (define-opencl-pointer _cl_sampler) (define-opencl-enum _cl_addressing_mode _cl_uint valid-addressing-modes _cl_addressing_mode/c (CL_ADDRESS_REPEAT CL_ADDRESS_CLAMP_TO_EDGE CL_ADDRESS_CLAMP CL_ADDRESS_NONE)) (define-opencl-enum _cl_filter_mode _cl_uint valid-filter-modes _cl_filter_mode/c (CL_FILTER_NEAREST CL_FILTER_LINEAR)) (define-opencl-pointer _cl_program) (define-opencl-pointer _cl_kernel) ; XXX This is probably wrong on other platforms (define-opencl-alias _intptr_t _cl_uint _cl_uint/c) (define-opencl-alias _cl_context_properties _intptr_t _intptr_t/c) (define-opencl-cstruct _cl_image_format ([image_channel_order _cl_channel_order] [image_channel_data_type _cl_channel_type])) ;;; clGetPlatformIDs (define-opencl-count clGetPlatformIDs (system-platform-count system-platforms) () _cl_platform_id _cl_platform_id_vector/c (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetPlatformIDs "num_entries is zero and platforms is not NULL or num_platforms and platforms are NULL")] [else (error 'clGetPlatformIDs "Undefined error: ~e" status)]))) ;;; clGetPlatformInfo (define-opencl-info clGetPlatformInfo (platform-info-length platform-info) _cl_platform_info _cl_platform_info/c (args [platform : _cl_platform_id/null _cl_platform_id/null/c]) (error status (cond [(= status CL_INVALID_PLATFORM) (error 'clGetPlatformInfo "platform is an invalid platform")] [(= status CL_INVALID_VALUE) (error 'clGetPlatformInfo "param_name is an invalid value or param_value_size is the wrong size")] [else (error 'clGetPlatformInfo "Undefined error: ~e" status)])) (variable param_value_size [_char* (_bytes o param_value_size) #"" bytes? CL_PLATFORM_PROFILE CL_PLATFORM_VERSION CL_PLATFORM_NAME CL_PLATFORM_VENDOR CL_PLATFORM_EXTENSIONS]) (fixed)) ;;; clGetDeviceIDs (define-opencl-count clGetDeviceIDs (platform-device-count platform-devices) ([platform : _cl_platform_id/null _cl_platform_id/null/c] [device_type : _cl_device_type _cl_device_type/c]) _cl_device_id _cl_device_id_vector/c (error status (cond [(= status CL_INVALID_PLATFORM) (error 'clGetDeviceIDs "platform is not a valid platform")] [(= status CL_INVALID_DEVICE_TYPE) (error 'clGetDeviceIDs "device_type is not a valid value")] [(= status CL_INVALID_VALUE) (error 'clGetDeviceIDs "num_entries is equal to zero and devices is not NULL or both num_devices and devices are NULL")] [(= status CL_DEVICE_NOT_FOUND) (error 'clGetDeviceIDs "No OpenCL devices that matched device_type were found")] [else (error 'clGetDeviceIDs "Undefined error: ~e" status)]))) ;;;; clGetDeviceInfo (define-opencl-info clGetDeviceInfo (device-info-length device-info) _cl_device_info _cl_device_info/c (args [device : _cl_device_id _cl_device_id/c]) (error status (cond [(= status CL_INVALID_DEVICE) (error 'clGetDeviceInfo "device is an invalid device")] [(= status CL_INVALID_VALUE) (error 'clGetDeviceInfo "param_name is an invalid value or param_value_size is the wrong size")] [else (error 'clGetDeviceInfo "Undefined error: ~e" status)])) (variable param_value_size [_size_t* (_cvector o _size_t param_value_size) (make-cvector _size_t 0) _size_t_vector/c CL_DEVICE_MAX_WORK_ITEM_SIZES] [_char* (_bytes o param_value_size) #"" bytes? CL_DEVICE_NAME CL_DEVICE_VENDOR CL_DRIVER_VERSION CL_DEVICE_PROFILE CL_DEVICE_VERSION CL_DEVICE_EXTENSIONS]) (fixed [_cl_device_type _cl_device_type/c CL_DEVICE_TYPE] [_cl_uint _cl_uint/c CL_DEVICE_VENDOR_ID CL_DEVICE_MAX_COMPUTE_UNITS CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE CL_DEVICE_MAX_CLOCK_FREQUENCY CL_DEVICE_ADDRESS_BITS CL_DEVICE_MAX_READ_IMAGE_ARGS CL_DEVICE_MAX_WRITE_IMAGE_ARGS CL_DEVICE_MAX_SAMPLERS CL_DEVICE_MEM_BASE_ADDR_ALIGN CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE] [_size_t _size_t/c CL_DEVICE_MAX_WORK_GROUP_SIZE CL_DEVICE_IMAGE2D_MAX_WIDTH CL_DEVICE_IMAGE2D_MAX_HEIGHT CL_DEVICE_IMAGE3D_MAX_WIDTH CL_DEVICE_IMAGE3D_MAX_HEIGHT CL_DEVICE_IMAGE3D_MAX_DEPTH CL_DEVICE_MAX_PARAMETER_SIZE CL_DEVICE_MAX_CONSTANT_ARGS CL_DEVICE_PROFILING_TIMER_RESOLUTION] [_cl_ulong _cl_ulong/c CL_DEVICE_MAX_MEM_ALLOC_SIZE CL_DEVICE_GLOBAL_MEM_CACHE_SIZE CL_DEVICE_GLOBAL_MEM_SIZE CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE CL_DEVICE_LOCAL_MEM_SIZE] [_cl_bool _cl_bool/c CL_DEVICE_IMAGE_SUPPORT CL_DEVICE_ERROR_CORRECTION_SUPPORT CL_DEVICE_ENDIAN_LITTLE CL_DEVICE_AVAILABLE CL_DEVICE_COMPILER_AVAILABLE] [_cl_device_fp_config _cl_device_fp_config/c CL_DEVICE_SINGLE_FP_CONFIG] [_cl_device_mem_cache_type _cl_device_mem_cache_type/c CL_DEVICE_GLOBAL_MEM_CACHE_TYPE] [_cl_device_local_mem_type _cl_device_local_mem_type/c CL_DEVICE_LOCAL_MEM_TYPE] [_cl_device_exec_capabilities _cl_device_exec_capabilities/c CL_DEVICE_EXECUTION_CAPABILITIES] [_cl_command_queue_properties _cl_command_queue_properties/c CL_DEVICE_QUEUE_PROPERTIES] [_cl_platform_id _cl_platform_id/c CL_DEVICE_PLATFORM])) ;;;; (define-opencl clCreateContext (_fun [properties : _void* = #f ; XXX This is shaped weird, so I don't know how to get it #;(_vector i _cl_context_properties)] [num_devices : _cl_uint = (vector-length devices)] [devices : (_vector i _cl_device_id)] [pfn_notify : _void* = #f ; XXX It is easy to make mistakes with callbacks #;(_fun [errinfo : _bytes] [private_info : _void*] [cb : _size_t] [user_data : _void*] -> _void)] [user_data : _void* = #f] [errcode_ret : (_ptr o _cl_int)] -> [context : _cl_context/null] -> (cond [(= errcode_ret CL_SUCCESS) context] [(= errcode_ret CL_INVALID_PLATFORM) (error 'clCreateContext "~e is NULL and no platform could be selected or platform value specified in ~e is not a valid platform" properties properties)] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateContext "One of the following: (a) if context property name in ~e is not a supported property name, if the value specified for a supported property name is not valid, or if the same property name is specified more than once; (b) ~e is NULL; (c) ~e is equal to zero; (d) ~e is NULL but ~e is not NULL" properties devices num_devices pfn_notify user_data)] [(= errcode_ret CL_INVALID_DEVICE) (error 'clCreateContext "~e contains an invalid device or are not associated with the specified platform" devices)] [(= errcode_ret CL_DEVICE_NOT_AVAILABLE) (error 'clCreateContext "a device in ~e is currently not available even though the device was returned by clGetDeviceIDs" devices)] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateContext "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateContext "Invalid error code: ~e" errcode_ret)]))) (provide/doc (proc-doc clCreateContext (([devices (vectorof _cl_device_id/c)]) () . ->d . [ctxt _cl_context/c]) @{})) ;;;; (define-opencl clCreateContextFromType (_fun [properties : _void* = #f #;(_vector i _cl_context_properties)] [device_type : _cl_device_type] [pfn_notify : _void* = #f #;(_fun [errinfo : _bytes] [private_info : _void*] [cb : _size_t] [user_data : _void*] -> _void)] [user_data : _void* = #f] [errcode_ret : (_ptr o _cl_int)] -> [context : _cl_context/null] -> (cond [(= errcode_ret CL_SUCCESS) context] [(= errcode_ret CL_INVALID_PLATFORM) (error 'clCreateContextFromType "~e is NULL and no platform could be selected or platform value specified in ~e is not a valid platform" properties properties)] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateContextFromType "One of the following: (a) if context property name in ~e is not a supported property name, if the value specified for a supported property name is not valid, or if the same property name is specified more than once; (b) ~e is NULL but ~e is not NULL" properties pfn_notify user_data)] [(= errcode_ret CL_INVALID_DEVICE_TYPE) (error 'clCreateContextFromType "~e is not a valid value" device_type)] [(= errcode_ret CL_DEVICE_NOT_AVAILABLE) (error 'clCreateContextFromType "no devices that match ~e are currently available" device_type)] [(= errcode_ret CL_DEVICE_NOT_FOUND) (error 'clCreateContextFromType "no devices that match ~e were found" device_type)] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateContextFromType "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateContextFromType "Invalid error code: ~e" errcode_ret)]))) (provide/doc (proc-doc clCreateContextFromType (([device_type _cl_device_type/c]) () . ->d . [ctxt _cl_context/c]) @{})) ;;;; (define-opencl clRetainContext (_fun [context : _cl_context] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_CONTEXT) (error 'clRetainContext "~e is not a valid OpenCL context" context)] [else (error 'clRetainContext "Invalid error code: ~e" status)]))) (provide/doc (proc-doc clRetainContext (([ctxt _cl_context/c]) () . ->d . [v void]) @{})) ;;;; (define-opencl clReleaseContext (_fun [context : _cl_context] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_CONTEXT) (error 'clReleaseContext "~e is not a valid OpenCL context" context)] [else (error 'clReleaseContext "Invalid error code: ~e" status)]))) (provide/doc (proc-doc clReleaseContext (([ctxt _cl_context/c]) () . ->d . [v void]) @{})) ;;;; clGetContextInfo (define-opencl-enum _cl_context_info _cl_uint valid-context-infos _cl_context_info/c (CL_CONTEXT_REFERENCE_COUNT CL_CONTEXT_DEVICES CL_CONTEXT_PROPERTIES)) (define-opencl-info clGetContextInfo (context-info-length context-info) _cl_context_info _cl_context_info/c (args [context : _cl_context _cl_context/c]) (error status (cond [(= status CL_INVALID_CONTEXT) (error 'clGetContextInfo "context is not a valid context")] [(= status CL_INVALID_VALUE) (error 'clGetContextInfo "param_name is an invalid value or param_value_size is the wrong size")] [else (error 'clGetContextInfo "Undefined error: ~e" status)])) (variable param_value_size [_cl_device_id* (_cvector o _cl_device_id param_value_size) (make-cvector _cl_device_id 0) _cl_device_id_vector/c CL_CONTEXT_DEVICES] [_cl_context_properties* (_cvector o _cl_context_properties param_value_size) (make-cvector _cl_context_properties 0) _cl_context_properties_vector/c CL_CONTEXT_PROPERTIES]) (fixed [_cl_uint _cl_uint/c CL_CONTEXT_REFERENCE_COUNT])) ;;;; (define-opencl clCreateCommandQueue (_fun [context : _cl_context] [device : _cl_device_id] [properties : _cl_command_queue_properties] [errcode_ret : (_ptr o _cl_int)] -> [queue : _cl_command_queue/null] -> (cond [(= errcode_ret CL_SUCCESS) queue] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateCommandQueue "~e is not a valid context" context)] [(= errcode_ret CL_INVALID_DEVICE) (error 'clCreateCommandQueue "~e is not a valid device or is not associated with ~e" device context)] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateCommandQueue "values specified in ~e are not valid" properties)] [(= errcode_ret CL_INVALID_QUEUE_PROPERTIES) (error 'clCreateCommandQueue "values specified in ~e are valid but are not supported by the device" properties)] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateCommandQueue "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateCommandQueue "Invalid error code: ~e" errcode_ret)]))) (provide/doc (proc-doc clCreateCommandQueue (([ctxt _cl_context/c] [device _cl_device_id/c] [properties _cl_command_queue_properties/c]) () . ->d . [cq _cl_command_queue/c]) @{})) ;;;; (define-opencl clRetainCommandQueue (_fun [command_queue : _cl_command_queue] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clRetainCommandQueue "~e is not a valid command-queue" command_queue)] [else (error 'clRetainCommandQueue "Invalid error code: ~e" status)]))) (provide/doc (proc-doc clRetainCommandQueue (([cq _cl_command_queue/c]) () . ->d . [v void]) @{})) ;;;; (define-opencl clReleaseCommandQueue (_fun [command_queue : _cl_command_queue] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clReleaseCommandQueue "~e is not a valid command-queue" command_queue)] [else (error 'clReleaseCommandQueue "Invalid error code: ~e" status)]))) (provide/doc (proc-doc clReleaseCommandQueue (([cq _cl_command_queue/c]) () . ->d . [v void]) @{})) ;;;; clGetCommandQueueInfo (define-opencl-enum _cl_command_queue_info _cl_uint valid-command-queue-infos _cl_command_queue_info/c (CL_QUEUE_CONTEXT CL_QUEUE_DEVICE CL_QUEUE_REFERENCE_COUNT CL_QUEUE_PROPERTIES)) (define-opencl-info clGetCommandQueueInfo (command-queue-info-length command-queue-info) _cl_command_queue_info _cl_command_queue_info/c (args [command_queue : _cl_command_queue _cl_command_queue/c]) (error status (cond [(= status CL_INVALID_COMMAND_QUEUE) (error 'clGetCommandQueueInfo "command_queue is not a valid command-queue")] [(= status CL_INVALID_VALUE) (error 'clGetCommandQueueInfo "param_name is not one of the supported values or if size in bytes specified by param_value_size is < size of return type and param_value is not a NULL value")] [else (error 'clGetCommandQueueInfo "Invalid error code: ~e" status)])) (variable param_value_size) (fixed [_cl_context _cl_context/c CL_QUEUE_CONTEXT] [_cl_device_id _cl_device_id/c CL_QUEUE_DEVICE] [_cl_uint _cl_uint/c CL_QUEUE_REFERENCE_COUNT] [_cl_command_queue_properties _cl_command_queue_properties/c CL_QUEUE_PROPERTIES])) ;;;; (define-opencl clSetCommandQueueProperty (_fun [command_queue : _cl_command_queue] [properties : _cl_command_queue_properties] [enable : _cl_bool] [old_properties : (_ptr o _cl_command_queue_properties)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) old_properties] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clSetCommandQueueProperty "~e is not a valid command-queue" command_queue)] [(= status CL_INVALID_VALUE) (error 'clSetCommandQueueProperty "the values specified in ~e are not valid" properties)] [(= status CL_INVALID_QUEUE_PROPERTIES) (error 'clSetCommandQueueProperty "values specified in ~e are not supported by the device" properties)] [else (error 'clSetCommandQueueProperty "Invalid error code: ~e" status)]))) (provide/doc (proc-doc clSetCommandQueueProperty (([cq _cl_command_queue/c] [properties _cl_command_queue_properties/c] [enable _cl_bool/c]) () . ->d . [old-properties _cl_command_queue_properties/c]) @{})) ;;;; (define-opencl clCreateBuffer (_fun [context : _cl_context] [flags : _cl_mem_flags] [size : _size_t] [host_ptr : _void*/null] [errcode_ret : (_ptr o _cl_int)] -> [buffer : _cl_mem/null] -> (cond [(= errcode_ret CL_SUCCESS) buffer] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateBuffer "~e is not a valid context" context)] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateBuffer "values specified in ~e are not valid" flags)] [(= errcode_ret CL_INVALID_BUFFER_SIZE) (error 'clCreateBuffer "~e is 0 or is greater than CL_DEVICE_MAX_MEM_ALLOC_SIZE value specified in table 4.3 for all devices in ~e" size context)] [(= errcode_ret CL_INVALID_HOST_PTR) (error 'clCreateBuffer "~e is NULL and CL_MEM_USE_HOST_PTR or CL_MEM_COPY_HOST_PTR are set in ~e or if ~e is not NULL but CL_MEM_COPY_HOST_PTR or CL_MEM_USE_HOST_PTR are not set in ~e" host_ptr flags host_ptr flags)] [(= errcode_ret CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clCreateBuffer "there is a failure to allocate memory for buffer object")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateBuffer "there is a failure to allocate resources required by the OpenCL implmentation on the host")] [else (error 'clCreateBuffer "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateBuffer (([ctxt _cl_context/c] [mem-flags _cl_mem_flags/c] [size _size_t/c] [host-ptr _void*/null/c]) () . ->d . [buffer _cl_mem/c]) @{}]) ;;;; (define-syntax-rule (define-clEnqueueReadBuffer-like clEnqueueReadBuffer) (begin (define-opencl clEnqueueReadBuffer (_fun [command_queue : _cl_command_queue] [buffer : _cl_mem] [blocking_read : _cl_bool] [offset : _size_t] [cb : _size_t] [ptr : _void*] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueReadBuffer "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueReadBuffer "the context associated with command_queue and buffer are not the same or the context associated with command_queue and events in event_wait_list are not the same")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueReadBuffer "buffer is not a valid buffer object")] [(= status CL_INVALID_VALUE) (error 'clEnqueueReadBuffer "the region being read or written specified by (offest, cb) is out of bounds or if ptr is a NULL value")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueReadBuffer "event_wait_list is NULL and num_events_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0, or if event objects in event_wait_list are not valid events")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueReadBuffer "there is a failure to allocate memory for data store associated with buffer")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueReadBuffer "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueReadBuffer "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueReadBuffer (([cq _cl_command_queue/c] [buffer _cl_mem/c] [blocking? _cl_bool/c] [offset _size_t/c] [cb _size_t/c] [ptr _void*/c] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]))) (define-clEnqueueReadBuffer-like clEnqueueReadBuffer) (define-clEnqueueReadBuffer-like clEnqueueWriteBuffer) ;;;; (define-opencl clEnqueueCopyBuffer (_fun [command_queue : _cl_command_queue] [src_buffer : _cl_mem] [dst_buffer : _cl_mem] [src_offset : _size_t] [dst_offset : _size_t] [cb : _size_t] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueCopyBuffer "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueCopyBuffer "the context associated with command_queue, src_buffer and dst_bufer are not the same or the context associated with command_queue and events in event_wait_list are not the same")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueCopyBuffer "src_buffer and dst_buffer are not a valid buffer objects")] [(= status CL_INVALID_VALUE) (error 'clEnqueueCopyBuffer "src_offset, dst_offset, cb, src_offset + cb or dst_offesrt + cb require accessing elements outside the buffer memory objects")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueCopyBuffer "event_wait_list is NULL and num_events_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0, or if event objects in event_wait_list are not valid events")] [(= status CL_MEM_COPY_OVERLAP) (error 'clEnqueueCopyBuffer "src_buffer and dst_buffer are the same buffer object and the source and destination regions overlap")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueCopyBuffer "there is a failure to allocate memory for data store associated with src_buffer or dst_buffer")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueCopyBuffer "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueCopyBuffer "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueCopyBuffer (([cq _cl_command_queue/c] [src _cl_mem/c] [dst _cl_mem/c] [src_offset _size_t/c] [dst_offset _size_t/c] [cb _size_t/c] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]) ;;;; (define-opencl clRetainMemObject (_fun [memobj : _cl_mem] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_MEM_OBJECT) (error 'clRetainMemObject "memobj is not a valid memory object")] [else (error 'clRetainMemObject "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clRetainMemObject (([memobj _cl_mem/c]) () . ->d . [v void]) @{}]) ;;;; (define-opencl clReleaseMemObject (_fun [memobj : _cl_mem] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_MEM_OBJECT) (error 'clReleaseMemObject "memobj is not a valid memory object")] [else (error 'clReleaseMemObject "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clReleaseMemObject (([memobj _cl_mem/c]) () . ->d . [v void]) @{}]) ;;;; (define-opencl clCreateImage2D (_fun [context : _cl_context] [flags : _cl_mem_flags] [image_format : _cl_image_format-pointer] [image_width : _size_t] [image_height : _size_t] [image_row_pitch : _size_t] [host_ptr : _void*/null] [errcode_ret : (_ptr o _cl_int)] -> [mem : _cl_mem/null] -> (cond [(= errcode_ret CL_SUCCESS) mem] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateImage2D "context is not a valid context")] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateImage2D "values specified in flags are not valid")] [(= errcode_ret CL_INVALID_IMAGE_FORMAT_DESCRIPTOR) (error 'clCreateImage2D "values specified in image_format are not valid or if image_format is NULL")] [(= errcode_ret CL_INVALID_IMAGE_SIZE) (error 'clCreateImage2D "image_width or image_height are 0 of if they exceed values specified in CL_DEVICE_IMAGE2D_MAX_WIDTH or CL_DEVICE_IMAGE2D_MAX_HEIGHT respectively for all devices in context or if values specified by image_row_pitch do not follow rules described in the argument description above.")] [(= errcode_ret CL_INVALID_HOST_PTR) (error 'clCreateImage2D "host_ptr is NULL and CL_MEM_USE_HOST_PTR or CL_MEM_COPY_HOST_PTR are set in flags or if host_ptr is not NULL but CL_MEM_COPY_HOST_PTR or CL_MEM_USE_HOST_PTR are not set in flags")] [(= errcode_ret CL_IMAGE_FORMAT_NOT_SUPPORTED) (error 'clCreateImage2D "the image_format is not supported")] [(= errcode_ret CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clCreateImage2D "there is a failure to allocate memory for image object")] [(= errcode_ret CL_INVALID_OPERATION) (error 'clCreateImage2D "there are no devices in context that support images")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateImage2D "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateImage2D "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateImage2D (([ctxt _cl_context/c] [mem-flags _cl_mem_flags/c] [format _cl_image_format/c] [image-width _size_t/c] [image-height _size_t/c] [image-row-pitch _size_t/c] [host-ptr _void*/c]) () . ->d . [img _cl_mem/c]) @{}]) ;;;; (define-opencl clCreateImage3D (_fun [context : _cl_context] [flags : _cl_mem_flags] [image_format : _cl_image_format-pointer] [image_width : _size_t] [image_height : _size_t] [image_depth : _size_t] [image_row_pitch : _size_t] [image_slice_pitch : _size_t] [host_ptr : _void*/null] [errcode_ret : (_ptr o _cl_int)] -> [mem : _cl_mem/null] -> (cond [(= errcode_ret CL_SUCCESS) mem] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateImage3D "context is not a valid context")] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateImage3D "values specified in flags are not valid")] [(= errcode_ret CL_INVALID_IMAGE_FORMAT_DESCRIPTOR) (error 'clCreateImage3D "values specified in image_format are not valid or if image_format is NULL")] [(= errcode_ret CL_INVALID_IMAGE_SIZE) (error 'clCreateImage3D "image_width or image_height are 0 or if image_depth <= 1 or if they exceed values specified in CL_DEVICE_IMAGE3D_MAX_WIDTH, CL_DEVICE_IMAGE3D_MAX_HEIGHT, or CL_DEVICE_IMAGE3D_MAX_DEPTH respectively for all devices in context or if values specified by image_row_pitch and image_slice_ptch do not follow rules described in the argument description above.")] [(= errcode_ret CL_INVALID_HOST_PTR) (error 'clCreateImage3D "host_ptr is NULL and CL_MEM_USE_HOST_PTR or CL_MEM_COPY_HOST_PTR are set in flags or if host_ptr is not NULL but CL_MEM_COPY_HOST_PTR or CL_MEM_USE_HOST_PTR are not set in flags")] [(= errcode_ret CL_IMAGE_FORMAT_NOT_SUPPORTED) (error 'clCreateImage3D "the image_format is not supported")] [(= errcode_ret CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clCreateImage3D "there is a failure to allocate memory for image object")] [(= errcode_ret CL_INVALID_OPERATION) (error 'clCreateImage3D "there are no devices in context that support images")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateImage3D "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateImage3D "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateImage3D (([ctxt _cl_context/c] [mem-flags _cl_mem_flags/c] [format _cl_image_format/c] [image-width _size_t/c] [image-height _size_t/c] [image-depth _size_t/c] [image-row-pitch _size_t/c] [image-slice-pitch _size_t/c] [host-ptr _void*/c]) () . ->d . [img _cl_mem/c]) @{}]) ;;;; (define-opencl-count clGetSupportedImageFormats (context-supported-image-formats-count context-supported-image-formats) ([context : _cl_context _cl_context/c] [flags : _cl_mem_flags _cl_mem_flags/c] [image_type : _cl_mem_object_type _cl_mem_object_type/c]) _cl_image_format _cl_image_format_vector/c (error status (cond [(= status CL_INVALID_CONTEXT) (error 'clGetSupportedImageFormats "context is not a valid context")] [(= status CL_INVALID_VALUE) (error 'clGetSupportedImageFormats "flags or image_type are not valid or if num_entries is 0 and image_foramts is not NULL")] [else (error 'clGetSupportedImageFormats "Invalid error code: ~e" status)]))) ;;;; (define-syntax-rule (define-clEnqueueReadImage-like clEnqueueReadImage) (begin (define-opencl clEnqueueReadImage (_fun [command_queue : _cl_command_queue] [image : _cl_mem] [blocking_read : _cl_bool] [origin : (_vector i _size_t)] ; len = 3 [region : (_vector i _size_t)] ; len = 3 [row_pitch : _size_t] [slice_pitch : _size_t] [ptr : _void*] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueReadImage "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueReadImage "the context associated with command_queue and image are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueReadImage "image is not a valid image object")] [(= status CL_INVALID_VALUE) (error 'clEnqueueReadImage "the region being read or written specified by origin and region is out of bounds or if ptr is a NULL value or if image is a 2D image object and origin[2] is not equal to 0 or region[2] is not eqal to 1 or slice_pitch is not requal to 0")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueReadImage "event_wait_list is NULL and num_event_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0, or event objects in event_wait_list are not valid events")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueReadImage "there is a failure to allocate memory for data store associated with image")] [(= status CL_INVALID_OPERATION) (error 'clEnqueueReadImage "the device associated with command_queue does not support images")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueReadImage "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueReadImage "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueReadImage (([cq _cl_command_queue/c] [image _cl_mem/c] [blocking? _cl_bool/c] [origin (vector/c _size_t/c _size_t/c _size_t/c)] [region (vector/c _size_t/c _size_t/c _size_t/c)] [row-pitch _size_t/c] [slice-ptch _size_t/c] [ptr _void*/c] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]))) (define-clEnqueueReadImage-like clEnqueueReadImage) (define-clEnqueueReadImage-like clEnqueueWriteImage) ;;;; (define-opencl clEnqueueCopyImage (_fun [command_queue : _cl_command_queue] [src_image : _cl_mem] [dst_image : _cl_mem] [src_origin : (_vector i _size_t)] ; len = 3 [dst_origin : (_vector i _size_t)] ; len = 3 [region : (_vector i _size_t)] ; len = 3 [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueCopyImage "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueCopyImage "the context associated with command_queue, src_image and dst_image are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueCopyImage "src_image or dst_image are not valid image objects")] [(= status CL_IMAGE_FORMAT_MISMATCH) (error 'clEnqueueCopyImage "src_image and dst_image do not use the same image format")] [(= status CL_INVALID_VALUE) (error 'clEnqueueCopyImage "the 2D or 3D rectangular region specified by src_origin and src_origin + region referes to a region outside src_image or if the 2D or 3D rectangular region specified by dst_origin and dst_origin+region refers to a region outside dst_image or src_image is a 2D image object and src_origin[2] is not equal to 0 or region[2] is not requal to 1 or dst_image is a 2d image object and dst_origin[2] is not equal to 0 or region[2] is not equal to 1")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueCopyImage "event_wait_list is NULL and num_event_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0, or event objects in event_wait_list are not valid events")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueCopyImage "there is a failure to allocate memory for data store associated with src_image or dst_image")] [(= status CL_INVALID_OPERATION) (error 'clEnqueueCopyImage "the device associated with command_queue does not support images")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueCopyImage "there is a failure to allocate resources required by the OpenCL implementation on the host")] [(= status CL_MEM_COPY_OVERLAP) (error 'clEnqueueCopyImage "src_image and dst_image are the same image object and the source and destination regions overlap")] [else (error 'clEnqueueCopyImage "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueCopyImage (([cq _cl_command_queue/c] [src _cl_mem/c] [dst _cl_mem/c] [src-origin (vector/c _size_t/c _size_t/c _size_t/c)] [dst-origin (vector/c _size_t/c _size_t/c _size_t/c)] [region (vector/c _size_t/c _size_t/c _size_t/c)] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]) ;;;; (define-opencl clEnqueueCopyImageToBuffer (_fun [command_queue : _cl_command_queue] [src_image : _cl_mem] [dst_buffer : _cl_mem] [src_origin : (_vector i _size_t)] ; len = 3 [region : (_vector i _size_t)] ; len = 3 [dst_offset : _size_t] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueCopyImageToBuffer "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueCopyImageToBuffer "the context associated with command_queue, src_image and dst_buffer are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueCopyImageToBuffer "src_image is not a valid image object or dst_buffer is not a valid buffer object")] [(= status CL_INVALID_VALUE) (error 'clEnqueueCopyImageToBuffer "the 2D or 3D rectangular region specified by src_origin and src_origin + region referes to a region outside src_image or if the region specified by dst_offset and dst_offset + dst_cb to a region outside dst_buffer or src_image is a 2D image object and src_origin[2] is not equal to 0 or region[2] is not equal to 1")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueCopyImageToBuffer "event_wait_list is NULL and num_event_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0, or event objects in event_wait_list are not valid events")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueCopyImageToBuffer "there is a failure to allocate memory for data store associated with src_image or dst_buffer")] [(= status CL_INVALID_OPERATION) (error 'clEnqueueCopyImageToBuffer "the device associated with command_queue does not support images")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueCopyImageToBuffer "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueCopyImageToBuffer "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueCopyImageToBuffer (([cq _cl_command_queue/c] [src-image _cl_mem/c] [dst-buffer _cl_mem/c] [src-origin (vector/c _size_t/c _size_t/c _size_t/c)] [region (vector/c _size_t/c _size_t/c _size_t/c)] [dst-offset _size_t/c] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]) ;;;; (define-opencl clEnqueueCopyBufferToImage (_fun [command_queue : _cl_command_queue] [src_buffer : _cl_mem] [dst_image : _cl_mem] [src_offset : _size_t] [dst_origin : (_vector i _size_t)] ; len = 3 [region : (_vector i _size_t)] ; len = 3 [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueCopyBufferToImage "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueCopyBufferToImage "the context associated with command_queue, src_buffer and dst_image are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueCopyBufferToImage "src_buffer is not a valid buffer object or dst_image is not a valid image object")] [(= status CL_INVALID_VALUE) (error 'clEnqueueCopyBufferToImage "the 2D or 3D rectangular region specified by dst_origin and dst_origin + region referes to a region outside dst_image or if the region specified by src_offset and src_offset + src_cb to a region outside src_buffer or dst_image is a 2D image object and dst_origin[2] is not equal to 0 or region[2] is not equal to 1")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueCopyBufferToImage "event_wait_list is NULL and num_event_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0, or event objects in event_wait_list are not valid events")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueCopyBufferToImage "there is a failure to allocate memory for data store associated with src_buffer or dst_image")] [(= status CL_INVALID_OPERATION) (error 'clEnqueueCopyBufferToImage "the device associated with command_queue does not support images")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueCopyBufferToImage "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueCopyBufferToImage "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueCopyBufferToImage (([cq _cl_command_queue/c] [src-buffer _cl_mem/c] [dst-image _cl_mem/c] [src-offset _size_t/c] [dst-origin (vector/c _size_t/c _size_t/c _size_t/c)] [region (vector/c _size_t/c _size_t/c _size_t/c)] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]) ;;;; (define-opencl clEnqueueMapBuffer (_fun [command_queue : _cl_command_queue] [buffer : _cl_mem] [blocking_map : _cl_bool] [map_flags : _cl_map_flags] [offset : _size_t] [cb : _size_t] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] [errcode_ret : (_ptr o _cl_int)] -> [region : _void*] -> (cond [(= errcode_ret CL_SUCCESS) (values event region)] [(= errcode_ret CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueMapBuffer "command_queue is not a valid command-queue")] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clEnqueueMapBuffer "context associated with command_queue and buffer are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [(= errcode_ret CL_INVALID_MEM_OBJECT) (error 'clEnqueueMapBuffer "buffer is not a valid buffer object")] [(= errcode_ret CL_INVALID_VALUE) (error 'clEnqueueMapBuffer "region being mapped given by (offset, cb) is out of bounds or if values specified in map_flags are not valid")] [(= errcode_ret CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueMapBuffer "event_wait_list is NULL and num_events_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0 or if event_objects in event_wait_list are not valid events")] [(= errcode_ret CL_MAP_FAILURE) (error 'clEnqueueMapBuffer "there is a failure to map the requested region into the host address space. This error cannot occur for buffer objects created with CL_MEM_USE_HOST_PTR or CL_MEM_ALLOC_HOST_PTR")] [(= errcode_ret CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueMapBuffer "there is a failure to allocate memory for data store associated with buffer")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueMapBuffer "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueMapBuffer "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clEnqueueMapBuffer (([cq _cl_command_queue/c] [buffer _cl_mem/c] [blocking? _cl_bool/c] [map-flags _cl_map_flags/c] [offset _size_t/c] [cb _size_t/c] [wait-list (vectorof _cl_event/c)]) () . ->d . (values [evt _cl_event/c] [ptr _void*/c])) @{}]) ;;;; (define-opencl clEnqueueMapImage (_fun [command_queue : _cl_command_queue] [image : _cl_mem] [blocking_map : _cl_bool] [map_flags : _cl_map_flags] [origin : (_vector i _size_t)] ; len = 3 [region : (_vector i _size_t)] ; len = 3 [image_row_pitch : (_ptr o _size_t)] [image_slice_pitch : (_ptr o _size_t)] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] [errcode_ret : (_ptr o _cl_int)] -> [region-ptr : _void*] -> (cond [(= errcode_ret CL_SUCCESS) (values image_row_pitch image_slice_pitch event region-ptr)] [(= errcode_ret CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueMapImage "command_queue is not a valid command-queue")] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clEnqueueMapImage "context associated with command_queue and image are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [(= errcode_ret CL_INVALID_MEM_OBJECT) (error 'clEnqueueMapImage "image is not a valid image object")] [(= errcode_ret CL_INVALID_VALUE) (error 'clEnqueueMapImage "region being mapped given by (origin, origin+region) is out of bounds or if values specified in map_flags are not valid or if image is a 2D image object and origin[2] is not equal to 0 or region[2] is not equal to 1 or image_row_pitch is NULL or image is a 3D image object and image_slice_pitch is NULL")] [(= errcode_ret CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueMapImage "event_wait_list is NULL and num_events_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0 or if event_objects in event_wait_list are not valid events")] [(= errcode_ret CL_MAP_FAILURE) (error 'clEnqueueMapImage "there is a failure to map the requested region into the host address space. This error cannot occur for image objects created with CL_MEM_USE_HOST_PTR or CL_MEM_ALLOC_HOST_PTR")] [(= errcode_ret CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueMapImage "there is a failure to allocate memory for data store associated with image")] [(= errcode_ret CL_INVALID_OPERATION) (error 'clEnqueueMapImage "the device associated with command_queue does not support images")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueMapImage "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueMapImage "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clEnqueueMapImage (([cq _cl_command_queue/c] [image _cl_mem/c] [blocking? _cl_bool/c] [map-flags _cl_map_flags/c] [origin (vector/c _size_t/c _size_t/c _size_t/c)] [region (vector/c _size_t/c _size_t/c _size_t/c)] [wait-list (vectorof _cl_event/c)]) () . ->d . (values [image_row_pitch _size_t/c] [image_slice_pitch _size_t/c] [event _cl_event/c] [region-ptr _void*/c])) @{}]) ;;;; (define-opencl clEnqueueUnmapMemObject (_fun [command_queue : _cl_command_queue] [memobj : _cl_mem] [mapped_ptr : _void*] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueUnmapMemObject "command_queue is not a valid command-queue")] [(= status CL_INVALID_MEM_OBJECT) (error 'clEnqueueUnmapMemObject "memobj is not a valid memory object")] [(= status CL_INVALID_VALUE) (error 'clEnqueueUnmapMemObject "mapped_ptr is not a valid pointer returned by clEnqueueMapBuffer or clEnqueueMapImage for memobj")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueUnmapMemObject "event_wait_list is NULL and num_events_in_wait_list > 0 or if event_wait_list is not NULL and num_events_in_wait_list is 0 or if event objects in event_wait_list are not valid event")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueUnmapMemObject "there is a failure to allocate resources required by the OpenCL implementation on the host")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueUnmapMemObject "context associated with command_queue and memobj are not the same or if the context associated with command_queue and events in event_wait_list are not the same")] [else (error 'clEnqueueUnmapMemObject "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueUnmapMemObject (([cq _cl_command_queue/c] [memobj _cl_mem/c] [mapped-ptr _void*/c] [wait-list (vectorof _cl_event/c)]) () . ->d . [evt _cl_event/c]) @{}]) ;;;; (define-opencl-enum _cl_mem_info _cl_uint valid-memobj-infos _cl_mem_info/c (CL_MEM_TYPE CL_MEM_FLAGS CL_MEM_SIZE CL_MEM_HOST_PTR CL_MEM_MAP_COUNT CL_MEM_REFERENCE_COUNT CL_MEM_CONTEXT)) (define-opencl-info clGetMemObjectInfo (memobj-info-length memobj-info) _cl_mem_info _cl_mem_info/c (args [memobj : _cl_mem _cl_mem/c]) (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetMemObjectInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_MEM_OBJECT) (error 'clGetMemObjectInfo "memobj is not a valid memory object")] [else (error 'clGetMemObjectInfo "Invalid error code: ~e" status)])) (variable param_value_size) (fixed [_cl_mem_object_type _cl_mem_object_type/c CL_MEM_TYPE] [_cl_mem_flags _cl_mem_flags/c CL_MEM_FLAGS] [_size_t _size_t/c CL_MEM_SIZE] [_void* _void*/c CL_MEM_HOST_PTR] [_cl_uint _cl_uint/c CL_MEM_MAP_COUNT CL_MEM_REFERENCE_COUNT] [_cl_context _cl_context/c CL_MEM_CONTEXT])) ;;;; (define-opencl-enum _cl_image_info _cl_uint valid-image-infos _cl_image_info/c (CL_IMAGE_FORMAT CL_IMAGE_ELEMENT_SIZE CL_IMAGE_ROW_PITCH CL_IMAGE_SLICE_PITCH CL_IMAGE_WIDTH CL_IMAGE_HEIGHT CL_IMAGE_DEPTH)) (define-opencl-info clGetImageInfo (image-info-length image-info) _cl_image_info _cl_image_info/c (args [memobj : _cl_mem _cl_mem/c]) (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetImageInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_MEM_OBJECT) (error 'clGetImageInfo "memobj is not a valid image object")] [else (error 'clGetImageInfo "Invalid error code: ~e" status)])) (variable param_value_size) (fixed [_cl_image_format _cl_image_format/c CL_IMAGE_FORMAT] [_size_t _size_t/c CL_IMAGE_ELEMENT_SIZE CL_IMAGE_ROW_PITCH CL_IMAGE_SLICE_PITCH CL_IMAGE_WIDTH CL_IMAGE_HEIGHT CL_IMAGE_DEPTH])) ;;;; (define-opencl clCreateSampler (_fun [context : _cl_context] [normalized_coords : _cl_bool] [addressing_mode : _cl_addressing_mode] [filter_mode : _cl_filter_mode] [errcode_ret : (_ptr o _cl_int)] -> [sample : _cl_sampler/null] -> (cond [(= errcode_ret CL_SUCCESS) sample] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateSampler "context is not a valid context")] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateSampler "addressing_mode, filter_mode or normalized_coords or combination of these argument values are not valid")] [(= errcode_ret CL_INVALID_OPERATION) (error 'clCreateSampler "images are not supported by any device associated with context")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateSampler "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateSampler "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateSampler (([ctxt _cl_context/c] [normalized? _cl_bool/c] [addressing-mode _cl_addressing_mode/c] [filter-mode _cl_filter_mode/c]) () . ->d . [sampler _cl_sampler/c]) @{}]) ;;;; (define-opencl clRetainSampler (_fun [sampler : _cl_sampler] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_SAMPLER) (error 'clRetainSampler "sampler is not a valid sampler object")] [else (error 'clRetainSampler "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clRetainSampler (([sampler _cl_sampler/c]) () . ->d . [v void]) @{}]) ;;;; (define-opencl clReleaseSampler (_fun [sampler : _cl_sampler] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_SAMPLER) (error 'clReleaseSampler "sampler is not a valid sampler object")] [else (error 'clReleaseSampler "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clReleaseSampler (([sampler _cl_sampler/c]) () . ->d . [v void]) @{}]) ;;;; (define-opencl-enum _cl_sampler_info _cl_uint valid-sampler-infos _cl_sampler_info/c (CL_SAMPLER_REFERENCE_COUNT CL_SAMPLER_CONTEXT CL_SAMPLER_ADDRESSING_MODE CL_SAMPLER_FILTER_MODE CL_SAMPLER_NORMALIZED_COORDS)) (define-opencl-info clGetSamplerInfo (sampler-info-length sampler-info) _cl_sampler_info _cl_sampler_info/c (args [sampler : _cl_sampler _cl_sampler/c]) (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetSamplerInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_SAMPLER) (error 'clGetSamplerInfo "sampler is not a valid sampler object")] [else (error 'clGetSamplerInfo "Invalid error code: ~e" status)])) (variable param_value_size) (fixed [_cl_uint _cl_uint/c CL_SAMPLER_REFERENCE_COUNT] [_cl_context _cl_context/c CL_SAMPLER_CONTEXT] [_cl_addressing_mode _cl_addressing_mode/c CL_SAMPLER_ADDRESSING_MODE] [_cl_filter_mode _cl_filter_mode/c CL_SAMPLER_FILTER_MODE] [_cl_bool _cl_bool/c CL_SAMPLER_NORMALIZED_COORDS])) ;;;; (define-opencl clCreateProgramWithSource (_fun [context : _cl_context] [count : _cl_uint = (vector-length strings)] [strings : (_vector i _bytes)] [lengths : (_vector i _size_t) = (build-vector count (lambda (i) (bytes-length (vector-ref strings i))))] [errcode_ret : (_ptr o _cl_int)] -> [program : _cl_program/null] -> (cond [(= errcode_ret CL_SUCCESS) program] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateProgramWithSource "context is not a valid context")] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateProgramWithSource "count is zero or strings or any entry in strings is NULL")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateProgramWithSource "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateProgramWithSource "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateProgramWithSource (([ctxt _cl_context/c] [source (vectorof bytes?)]) () . ->d . [program _cl_program/c]) @{}]) ;;;; (define-opencl clCreateProgramWithBinary (_fun [context : _cl_context] [num_devices : _cl_uint = (vector-length device_list)] [device_list : (_vector i _cl_device_id)] [lengths : (_vector i _size_t) = (build-vector num_devices (lambda (i) (bytes-length (vector-ref binaries i))))] [binaries : (_vector i _bytes)] [binary_status : _pointer = #f #;(_cvector o _cl_int num_devices)] [errcode_ret : (_ptr o _cl_int)] -> [program : _cl_program/null] -> (cond [(= errcode_ret CL_SUCCESS) program] [(= errcode_ret CL_INVALID_CONTEXT) (error 'clCreateProgramWithBinary "context is not a valid context")] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateProgramWithBinary "device_list is NULL or num_devices is zero or lengths or binaries are NULL or if any entry in lengths[i] is zero or binaries[i] is NULL")] [(= errcode_ret CL_INVALID_DEVICE) (error 'clCreateProgramWithBinary "OpenCL devices listed in device_list are not in the list of devices associated with context")] [(= errcode_ret CL_INVALID_BINARY) ; XXX Return specifix error based on binary_status (error 'clCreateProgramWithBinary "an invalid program binary was encountered for some device")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateProgramWithBinary "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateProgramWithBinary "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateProgramWithBinary (->d ([ctxt _cl_context/c] [devices (vectorof _cl_device_id/c)] [binaries (vectorof bytes?)]) () ; XXX #;#:pre-cond #;(= (vector-length devices) (vector-length binaries)) [_ _cl_program/c]) @{}]) ;;;; (define-opencl clRetainProgram (_fun [program : _cl_program] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_PROGRAM) (error 'clRetainProgram "program is not a valid program object")] [else (error 'clRetainProgram "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clRetainProgram (([program _cl_program/c]) () . ->d . [_ void]) @{}]) (define-opencl clReleaseProgram (_fun [program : _cl_program] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_PROGRAM) (error 'clReleaseProgram "program is not a valid program object")] [else (error 'clReleaseProgram "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clReleaseProgram (([program _cl_program/c]) () . ->d . [_ void]) @{}]) ;;;; (define-opencl clBuildProgram (_fun [program : _cl_program] [num_devices : _cl_uint = (vector-length device_list)] [device_list : (_vector i _cl_device_id)] [options : _bytes] [pfn_notify : _pointer = #f ; XXX It is easy to make mistakes with callbacks #;(_fun _cl_program _void* -> _void)] [user_data : _pointer = #f ; XXX GC issue on callbacks #; _void*] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_PROGRAM) (error 'clBuildProgram "program is not a valid program object")] [(= status CL_INVALID_VALUE) (error 'clBuildProgram "device_list is NULL and num_devices is greater than zero or device_list is not NULL and num_devices is zero or pfn_notify is NULL but user_data is not NULL")] [(= status CL_INVALID_DEVICE) (error 'clBuildProgram "OpenCL devices listed in device_list are not in the list of devices associated with program")] [(= status CL_INVALID_BINARY) (error 'clBuildProgram "program is created with clCreateWithProgramBinary and devices listed in device_list do not have a valid program binary loaded.")] [(= status CL_INVALID_BUILD_OPTIONS) (error 'clBuildProgram "the build options specified by options are invalid")] [(= status CL_INVALID_OPERATION) (error 'clBuildProgram "the build of a program for any of the devies listed in device_list by a previous call to clBuildProgram for program has not completed")] [(= status CL_COMPILER_NOT_AVAILABLE) (error 'clBuildProgram "program is created with clCreateProgramWithSource and a compiler is not available")] [(= status CL_BUILD_PROGRAM_FAILURE) (error 'clBuildProgram "there is a failure to build the program executable")] [(= status CL_INVALID_OPERATION) (error 'clBuildProgram "there are kernel objects attached to program")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clBuildProgram "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clBuildProgram "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clBuildProgram (([program _cl_program/c] [devices (vectorof _cl_device_id/c)] [options bytes?]) () . ->d . [_v void]) @{}]) ;;;; (define-opencl clUnloadCompiler (_fun -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [else (error 'clUnloadCompiler "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clUnloadCompiler (->d () () [_ void]) @{}]) ;;;; ;;; XXX support CL_PROGRAM_BINARIES (define-opencl-enum _cl_program_info _cl_uint valid-program-infos _cl_program_info/c (CL_PROGRAM_REFERENCE_COUNT CL_PROGRAM_CONTEXT CL_PROGRAM_NUM_DEVICES CL_PROGRAM_DEVICES CL_PROGRAM_SOURCE CL_PROGRAM_BINARY_SIZES #;CL_PROGRAM_BINARIES)) (define-opencl-info clGetProgramInfo (program-info-length program-info) _cl_program_info _cl_program_info/c (args [program : _cl_program _cl_program/c]) (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetProgramInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_PROGRAM) (error 'clGetProgramInfo "program is not a valid program object")] [else (error 'clGetProgramInfo "Invalid error code: ~e" status)])) (variable param_value_size [_cl_device_id* (_cvector o _cl_device_id param_value_size) (make-cvector _cl_device_id 0) _cl_device_id_vector/c CL_PROGRAM_DEVICES] [_char* (_bytes o param_value_size) #"" bytes? CL_PROGRAM_SOURCE] [_size_t* (_cvector o _size_t param_value_size) (make-cvector _size_t 0) _size_t_vector/c CL_PROGRAM_BINARY_SIZES]) (fixed [_cl_uint _cl_uint/c CL_PROGRAM_REFERENCE_COUNT CL_PROGRAM_NUM_DEVICES] [_cl_context _cl_context/c CL_PROGRAM_CONTEXT])) ;;;; clGetProgramBuildInfo (define-opencl-enum _cl_program_build_info _cl_uint valid-program-build-infos _cl_program_build_info/c (CL_PROGRAM_BUILD_STATUS CL_PROGRAM_BUILD_OPTIONS CL_PROGRAM_BUILD_LOG)) (define-opencl-enum _cl_build_status _cl_int valid-build-statuses _cl_build_status/c (CL_BUILD_NONE CL_BUILD_ERROR CL_BUILD_SUCCESS CL_BUILD_IN_PROGRESS)) (define-opencl-info clGetProgramBuildInfo (program-build-info-length program-build-info) _cl_program_build_info _cl_program_build_info/c (args [program : _cl_program _cl_program/c] [device : _cl_device_id _cl_device_id/c]) (error status (cond [(= status CL_INVALID_DEVICE) (error 'clGetProgramBuildInfo "device is not in the list of devices associated with program")] [(= status CL_INVALID_VALUE) (error 'clGetProgramBuildInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_PROGRAM) (error 'clGetProgramBuildInfo "program is not a valid program object")] [else (error 'clGetProgramBuildInfo "Invalid error code: ~e" status)])) (variable param_value_size [_char* (_bytes o param_value_size) #"" bytes? CL_PROGRAM_BUILD_OPTIONS CL_PROGRAM_BUILD_LOG]) (fixed [_cl_build_status _cl_build_status/c CL_PROGRAM_BUILD_STATUS])) ;;;; (define-opencl clCreateKernel (_fun [program : _cl_program] [kernel_name : _bytes] [errcode_ret : (_ptr o _cl_int)] -> [kernel : _cl_kernel/null] -> (cond [(= errcode_ret CL_SUCCESS) kernel] [(= errcode_ret CL_INVALID_PROGRAM) (error 'clCreateKernel "program is not a valid program object")] [(= errcode_ret CL_INVALID_PROGRAM_EXECUTABLE) (error 'clCreateKernel "there is no successfully built executable for program")] [(= errcode_ret CL_INVALID_KERNEL_NAME) (error 'clCreateKernel "kernel_name(~e) is not found in the program" kernel_name)] [(= errcode_ret CL_INVALID_KERNEL_DEFINITION) (error 'clCreateKernel "the function definition for __kernel function given by kernel_name such as the number of arguments, the argument types are not the same for all devices for which the program executable has been built")] [(= errcode_ret CL_INVALID_VALUE) (error 'clCreateKernel "kernel_name is NULL")] [(= errcode_ret CL_OUT_OF_HOST_MEMORY) (error 'clCreateKernel "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateKernel "Invalid error code: ~e" errcode_ret)]))) (provide/doc [proc-doc clCreateKernel (->d ([program _cl_program/c] [kernel-name bytes?]) () [kernel _cl_kernel/c]) @{}]) ;;;; clCreateKernelsInProgram (define-opencl-count clCreateKernelsInProgram (program-kernels-count program-kernels) ([program : _cl_program _cl_program/c]) _cl_kernel _cl_kernel_vector/c (error status (cond [(= status CL_INVALID_PROGRAM) (error 'clCreateKernelsInProgram "program is a not valid program object")] [(= status CL_INVALID_PROGRAM_EXECUTABLE) (error 'clCreateKernelsInProgram "there is no successfully built executable for any device in program")] [(= status CL_INVALID_VALUE) (error 'clCreateKernelsInProgram "kernels is not NULL and num_kernels is less than the number of kernels in program")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clCreateKernelsInProgram "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clCreateKernelsInProgram "Invalid error code: ~e" status)]))) ;;;; (define-opencl clRetainKernel (_fun [kernel : _cl_kernel] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_KERNEL) (error 'clRetainKernel "kernel is not a valid kernel object")] [else (error 'clRetainKernel "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clRetainKernel (->d ([kernel _cl_kernel/c]) () [_ void]) @{}]) (define-opencl clReleaseKernel (_fun [kernel : _cl_kernel] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_KERNEL) (error 'clReleaseKernel "kernel is not a valid kernel object")] [else (error 'clReleaseKernel "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clReleaseKernel (->d ([kernel _cl_kernel/c]) () [_ void]) @{}]) ;;;; (define (clSetKernelArg-return status) (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_KERNEL) (error 'clSetKernelArg "kernel is not a valid kernel object")] [(= status CL_INVALID_ARG_INDEX) (error 'clSetKernelArg "arg_index is not a valid argument index")] [(= status CL_INVALID_ARG_VALUE) (error 'clSetKernelArg "arg_value specified in NULL for an argument that is not declared with the __local qualifier or vice-versa")] [(= status CL_INVALID_MEM_OBJECT) (error 'clSetKernelArg "an argument declared to be a memory object when the specified arg_value is not a valid memory object")] [(= status CL_INVALID_SAMPLER) (error 'clSetKernelArg "an argument declared to be of type sampler_t when the specified arg_value is not a valid sampler object")] [(= status CL_INVALID_ARG_SIZE) (error 'clSetKernelArg "arg_size does not match the size of the data type for an argument is not a memory object or if the argument is a memory object and arg_size != sizeof(cl_mem) or if arg_size is zero and the argument is declared with the __local qualitifer or if the argument is a sampler and arg_size != sizeof(cl_sampler)")] [else (error 'clSetKernelArg "Invalid error code: ~e" status)])) (define-syntax-rule (define-clSetKernelArg clSetKernelArg:_type _type _type/c) (begin (define-opencl clSetKernelArg:_type clSetKernelArg (_fun [kernel : _cl_kernel] [arg_index : _cl_uint] [arg_size : _size_t = (ctype-sizeof _type)] [arg_value : (_ptr i _type)] -> [status : _cl_int] -> (clSetKernelArg-return status))) (provide/doc [proc-doc clSetKernelArg:_type (->d ([kernel _cl_kernel/c] [arg-num _cl_uint/c] [val _type/c]) () [_ void]) @{}]))) ; XXX Make sure this is complete (define-clSetKernelArg clSetKernelArg:_cl_mem _cl_mem _cl_mem/c) (define-clSetKernelArg clSetKernelArg:_cl_uint _cl_uint _cl_uint/c) (define-clSetKernelArg clSetKernelArg:_cl_int _cl_int _cl_int/c) (define-opencl clSetKernelArg:local clSetKernelArg (_fun [kernel : _cl_kernel] [arg_index : _cl_uint] [arg_size : _size_t] [arg_value : _pointer = #f] -> [status : _cl_int] -> (clSetKernelArg-return status))) (provide/doc [proc-doc clSetKernelArg:local (->d ([kernel _cl_kernel/c] [arg-num _cl_uint/c] [arg_size _size_t/c]) () [_ void]) @{}]) ;;;; clGetKernelInfo (define-opencl-enum _cl_kernel_info _cl_uint valid-kernel-infos _cl_kernel_info/c (CL_KERNEL_FUNCTION_NAME CL_KERNEL_NUM_ARGS CL_KERNEL_REFERENCE_COUNT CL_KERNEL_CONTEXT CL_KERNEL_PROGRAM)) (define-opencl-info clGetKernelInfo (kernel-info-length kernel-info) _cl_kernel_info _cl_kernel_info/c (args [kernel : _cl_kernel _cl_kernel/c]) (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetKernelInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_KERNEL) (error 'clGetKernelInfo "kernel is not a valid kernel object")] [else (error 'clGetKernelInfo "Invalid error code: ~e" status)])) (variable param_value_size [_char* (_bytes o param_value_size) #"" bytes? CL_KERNEL_FUNCTION_NAME]) (fixed [_cl_uint _cl_uint/c CL_KERNEL_NUM_ARGS CL_KERNEL_REFERENCE_COUNT] [_cl_context _cl_context/c CL_KERNEL_CONTEXT] [_cl_program _cl_program/c CL_KERNEL_PROGRAM])) ;;;; clGetKernelWorkGroupInfo (define-opencl-enum _cl_kernel_work_group_info _cl_uint valid-kernel-work-group-infos _cl_kernel_work_group_info/c (CL_KERNEL_WORK_GROUP_SIZE CL_KERNEL_COMPILE_WORK_GROUP_SIZE CL_KERNEL_LOCAL_MEM_SIZE)) (define-opencl-info clGetKernelWorkGroupInfo (kernel-work-group-info-length kernel-work-group-info) _cl_kernel_work_group_info _cl_kernel_work_group_info/c (args [kernel : _cl_kernel _cl_kernel/c] [device : _cl_device_id _cl_device_id/c]) (error status (cond [(= status CL_INVALID_DEVICE) (error 'clGetKernelWorkGroupInfo "device is not in the list of devices associated with kernel or if device is NULL but there is more than one device associated with kernel")] [(= status CL_INVALID_VALUE) (error 'clGetKernelInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_KERNEL) (error 'clGetKernelInfo "kernel is not a valid kernel object")] [else (error 'clGetKernelInfo "Invalid error code: ~e" status)])) (variable param_value_size ; XXX This is guaranteed to be 3 [_size_t* (_cvector o _size_t param_value_size) (make-cvector _size_t 3) _size_t_vector/c CL_KERNEL_COMPILE_WORK_GROUP_SIZE]) (fixed [_size_t _size_t/c CL_KERNEL_WORK_GROUP_SIZE] [_cl_ulong _cl_ulong/c CL_KERNEL_LOCAL_MEM_SIZE])) ;;;; (define-opencl clEnqueueNDRangeKernel (_fun [command_queue : _cl_command_queue] [kernel : _cl_kernel] [work_dim : _cl_uint] ; XXX Must be NULL right now [global_work_offset : _pointer = #f] [global_work_size : (_vector i _size_t)] ; len = work_dim [local_work_size : (_vector i _size_t)] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_PROGRAM_EXECUTABLE) (error 'clEnqueueNDRangeKernel "there is no successfully built program executable available for device associated with command_queue.")] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueNDRangeKernel "command_queue is not a valid command-queue")] [(= status CL_INVALID_KERNEL) (error 'clEnqueueNDRangeKernel "kernel is not a valid kernel object")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueNDRangeKernel "context associated with command_queue and kernel is not the same or if the context associated with command_queue and events in event_wait_list are not the same.")] [(= status CL_INVALID_KERNEL_ARGS) (error 'clEnqueueNDRangeKernel "the kernel argument values have not been specified")] [(= status CL_INVALID_WORK_DIMENSION) (error 'clEnqueueNDRangeKernel "work_dim is not a valid value")] [(= status CL_INVALID_GLOBAL_WORK_SIZE) (error 'clEnqueueNDRangeKernel "global_work_size is NULL, or if any of the values specified in global_work_size[0], ... global_work_size[work_dim – 1] are 0 or exceed the range given by the sizeof(size_t) for the device on which the kernel execution will be enqueued.")] [(= status CL_INVALID_WORK_GROUP_SIZE) (error 'clEnqueueNDRangeKernel "local_work_size is specified and number of work- items specified by global_work_size is not evenly divisible by size of work-group given by local_work_size or does not match the work-group size specified for kernel using the __attribute__((reqd_work_group_size(X, Y, Z))) qualifier in program source. OR local_work_size is specified and the total number of work-items in the work-group computed as local_work_size[0] * ... local_work_size[work_dim – 1] is greater than the value specified by CL_DEVICE_MAX_WORK_GROUP_SIZE in table 4.3. OR local_work_size is NULL and the __attribute__((reqd_work_group_size(X, Y, Z))) qualifier is used to declare the work-group size for kernel in the program source.")] [(= status CL_INVALID_WORK_ITEM_SIZE) (error 'clEnqueueNDRangeKernel "the number of work-items specified in any of local_work_size[0], ... local_work_size[work_dim – 1] is greater than the corresponding values specified by CL_DEVICE_MAX_WORK_ITEM_SIZES[0], .... CL_DEVICE_MAX_WORK_ITEM_SIZES[work_dim – 1].")] [(= status CL_INVALID_GLOBAL_OFFSET) (error 'clEnqueueNDRangeKernel "global_work_offset is not NULL")] [(= status CL_OUT_OF_RESOURCES) (error 'clEnqueueNDRangeKernel "there is a failure to queue the execution instance of kernel on the command-queue because of insufficient resources needed to execute the kernel")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueNDRangeKernel "there is a failure to allocate memory for data store associated with image or buffer objects specified as arguments to kernel")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueNDRangeKernel "event_wait_list is NULL and num_events_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0 or if event objects in event_wait_list are not valid events")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueNDRangeKernel "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueNDRangeKernel "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueNDRangeKernel (->d ([cq _cl_command_queue/c] [kernel _cl_kernel/c] [dim (and/c _cl_uint/c (between/c 1 3))] [global-size (vectorof _size_t/c)] [local-size (vectorof _size_t/c)] [wait-list (vectorof _cl_event/c)]) () [evt _cl_event/c]) @{}]) ;;;; clEnqueueTask (define-opencl clEnqueueTask (_fun [command_queue : _cl_command_queue] [kernel : _cl_kernel] [num_events_in_wait_list : _cl_uint = (vector-length event_wait_list)] [event_wait_list : (_vector i _cl_event)] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_PROGRAM_EXECUTABLE) (error 'clEnqueueTask "there is no successfully built program executable available for device associated with command_queue.")] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueTask "command_queue is not a valid command-queue")] [(= status CL_INVALID_KERNEL) (error 'clEnqueueTask "kernel is not a valid kernel object")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueTask "context associated with command_queue and kernel is not the same or if the context associated with command_queue and events in event_wait_list are not the same.")] [(= status CL_INVALID_KERNEL_ARGS) (error 'clEnqueueTask "the kernel argument values have not been specified")] [(= status CL_INVALID_WORK_GROUP_SIZE) (error 'clEnqueueTask "work-group size is specified for kernel using ... qualifier in program source and is not (1, 1, 1)")] [(= status CL_OUT_OF_RESOURCES) (error 'clEnqueueTask "there is a failure to queue the execution instance of kernel on the command-queue because of insufficient resources needed to execute the kernel")] [(= status CL_MEM_OBJECT_ALLOCATION_FAILURE) (error 'clEnqueueTask "there is a failure to allocate memory for data store associated with image or buffer objects specified as arguments to kernel")] [(= status CL_INVALID_EVENT_WAIT_LIST) (error 'clEnqueueTask "event_wait_list is NULL and num_events_in_wait_list > 0 or event_wait_list is not NULL and num_events_in_wait_list is 0 or if event objects in event_wait_list are not valid events")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueTask "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueTask "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueTask (->d ([cq _cl_command_queue/c] [kernel _cl_kernel/c] [wait-list (vectorof _cl_event/c)]) () [evt _cl_event/c]) @{}]) ;;;; XXX clEnqueueNativeKernel ;;;; clWaitForEvents (define-opencl clWaitForEvents (_fun [num_events : _cl_uint = (vector-length event_list)] [event_list : (_vector i _cl_event)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_VALUE) (error 'clWaitForEvents "num_events is zero")] [(= status CL_INVALID_CONTEXT) (error 'clWaitForEvents "events specified in event_list do not belong to the same context")] [(= status CL_INVALID_EVENT) (error 'clWaitForEvents "event objects specified in event_list are not valid event objects")] [else (error 'clWaitForEvents "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clWaitForEvents (->d ([wait-list (vectorof _cl_event/c)]) () [_ void]) @{}]) ;;;; clGetEventInfo (define-opencl-enum _cl_event_info _cl_uint valid-event-infos _cl_event_info/c (CL_EVENT_COMMAND_QUEUE CL_EVENT_COMMAND_TYPE CL_EVENT_COMMAND_EXECUTION_STATUS CL_EVENT_REFERENCE_COUNT)) (define-opencl-enum _cl_command_type _cl_uint valid-command-types _cl_command_type/c (CL_COMMAND_NDRANGE_KERNEL CL_COMMAND_TASK CL_COMMAND_NATIVE_KERNEL CL_COMMAND_READ_BUFFER CL_COMMAND_WRITE_BUFFER CL_COMMAND_COPY_BUFFER CL_COMMAND_READ_IMAGE CL_COMMAND_WRITE_IMAGE CL_COMMAND_COPY_IMAGE CL_COMMAND_COPY_BUFFER_TO_IMAGE CL_COMMAND_COPY_IMAGE_TO_BUFFER CL_COMMAND_MAP_BUFFER CL_COMMAND_MAP_IMAGE CL_COMMAND_UNMAP_MEM_OBJECT CL_COMMAND_MARKER CL_COMMAND_ACQUIRE_GL_OBJECTS CL_COMMAND_RELEASE_GL_OBJECTS)) (define-opencl-enum _command_execution_status _cl_int valid-command-execution-statuses _command_execution_status/c (CL_QUEUED CL_SUBMITTED CL_RUNNING CL_COMPLETE)) (define-opencl-info clGetEventInfo (event-info-length event-info) _cl_event_info _cl_event_info/c (args [event : _cl_event _cl_event/c]) (error status (cond [(= status CL_INVALID_VALUE) (error 'clGetEventInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_EVENT) (error 'clGetEventInfo "event is not a valid event object")] [else (error 'clGetEventInfo "Invalid error code: ~e" status)])) (variable param_value_size) (fixed [_cl_command_queue _cl_command_queue/c CL_EVENT_COMMAND_QUEUE] [_cl_command_type _cl_command_type/c CL_EVENT_COMMAND_TYPE] [_command_execution_status _command_execution_status/c CL_EVENT_COMMAND_EXECUTION_STATUS] [_cl_uint _cl_uint/c CL_EVENT_REFERENCE_COUNT])) ;;;; (define-opencl clRetainEvent (_fun [event : _cl_event] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_EVENT) (error 'clRetainEvent "event is not a valid event object")] [else (error 'clRetainEvent "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clRetainEvent (->d ([evt _cl_event/c]) () [_ void]) @{}]) (define-opencl clReleaseEvent (_fun [event : _cl_event] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_EVENT) (error 'clReleaseEvent "event is not a valid event object")] [else (error 'clReleaseEvent "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clReleaseEvent (->d ([evt _cl_event/c]) () [_ void]) @{}]) ;;;; clEnqueueMarker (define-opencl clEnqueueMarker (_fun [command_queue : _cl_command_queue] [event : (_ptr o _cl_event/null)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) event] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueMarker "command_queue is not a valid command-queue")] [(= status CL_INVALID_VALUE) (error 'clEnqueueMarker "event is a NULL value")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueMarker "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueMarker "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueMarker (->d ([cq _cl_command_queue/c]) () [evt _cl_event/c]) @{}]) ;;;; clEnqueueWaitForEvents (define-opencl clEnqueueWaitForEvents (_fun [command_queue : _cl_command_queue] [num_events : _cl_uint = (vector-length event_list)] [event_list : (_vector i _cl_event)] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueWaitForEvents "command_queue is not a valid command-queue")] [(= status CL_INVALID_CONTEXT) (error 'clEnqueueWaitForEvents "the context associated with command_queue and events in event_list are not the same")] [(= status CL_INVALID_VALUE) (error 'clEnqueueWaitForEvents "num_events is zero or event_list is NULL")] [(= status CL_INVALID_EVENT) (error 'clEnqueueWaitForEvents "event objects specified in event_list are not valid events")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueWaitForEvents "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueWaitForEvents "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueWaitForEvents (->d ([cq _cl_command_queue/c] [wait-list (vectorof _cl_event/c)]) () [_ void]) @{}]) ;;;; clEnqueueBarrier (define-opencl clEnqueueBarrier (_fun [command_queue : _cl_command_queue] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) void] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clEnqueueBarrier "command_queue is not a valid command-queue")] [(= status CL_INVALID_VALUE) (error 'clEnqueueBarrier "event is a NULL value")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clEnqueueBarrier "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clEnqueueBarrier "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clEnqueueBarrier (->d ([cq _cl_command_queue/c]) () [_ void]) @{}]) ;;;; clGetEventProfilingInfo (define-opencl-enum _cl_profiling_info _cl_uint valid-profiling-infos _cl_profiling_info/c (CL_PROFILING_COMMAND_QUEUED CL_PROFILING_COMMAND_SUBMIT CL_PROFILING_COMMAND_START CL_PROFILING_COMMAND_END)) (define-opencl-info clGetEventProfilingInfo (event-profiling-info-length event-profiling-info) _cl_profiling_info _cl_profiling_info/c (args [event : _cl_event _cl_event/c]) (error status (cond [(= status CL_PROFILING_INFO_NOT_AVAILABLE) (error 'clGetEventProfilingInfo "the CL_QUEUE_PROFILING_ENABLE flag is not set for the command-queue and if the profiling information is currently not available (because the command identified by event has not completed)")] [(= status CL_INVALID_VALUE) (error 'clGetEventProfilingInfo "param_name is not valid or if size in bytes specified by param_value_size is < size of return type and param_value is not NULL")] [(= status CL_INVALID_EVENT) (error 'clGetEventProfilingInfo "event is not a valid event object")] [else (error 'clGetEventProfilingInfo "Invalid error code: ~e" status)])) (variable param_value_size) (fixed [_cl_ulong _cl_ulong/c CL_PROFILING_COMMAND_QUEUED CL_PROFILING_COMMAND_SUBMIT CL_PROFILING_COMMAND_START CL_PROFILING_COMMAND_END])) ;;;; (define-opencl clFlush (_fun [command_queue : _cl_command_queue] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clFlush "command_queue is not a valid command-queue")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clFlush "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clFlush "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clFlush (->d ([cq _cl_command_queue/c]) () [_ void]) @{}]) ;;;; (define-opencl clFinish (_fun [command_queue : _cl_command_queue] -> [status : _cl_int] -> (cond [(= status CL_SUCCESS) (void)] [(= status CL_INVALID_COMMAND_QUEUE) (error 'clFinish "command_queue is not a valid command-queue")] [(= status CL_OUT_OF_HOST_MEMORY) (error 'clFinish "there is a failure to allocate resources required by the OpenCL implementation on the host")] [else (error 'clFinish "Invalid error code: ~e" status)]))) (provide/doc [proc-doc clFinish (->d ([cq _cl_command_queue/c]) () [_ void]) @{}])