1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
(in-package #:ocl)
(defun create-buffer (context flags size &optional (host-ptr (cffi:null-pointer)))
(check-error-arg (%create-buffer context flags size host-ptr)))
;; TODO: Support multi-dimensional arrays? row-major?
(defun create-buffer-from-array (context flags array)
(let* ((length (length array))
(c-type (array-foreign-type array))
(size (* length (cffi:foreign-type-size c-type))))
(cffi:with-foreign-array (c-array array (list :array c-type length))
(check-error-arg (%create-buffer context flags size c-array)))))
(defun create-pipe (context flags packet-size max-packets &key properties)
(declare (ignorable properties))
(check-error-arg
(%create-pipe context flags packet-size max-packets (cffi:null-pointer))))
(defun retain-mem-object (memobj)
(check-error (%retain-mem-object memobj)))
(defun release-mem-object (memobj)
(check-error (%release-mem-object memobj)))
(get-cl-objects get-supported-image-formats (context flags image-type)
%get-supported-image-formats 'cl-image-format)
(defparameter +mem-object-info-type-alist+
'((:mem-type . cl-mem-object-type)
(:mem-flags . cl-mem-flags)
(:mem-size . :size)
(:mem-host-ptr . (:pointer :void))
(:mem-map-count . cl-uint)
(:mem-reference-count . cl-uint)
(:mem-context . cl-context)
(:mem-associated-memobject . cl-mem)
(:mem-offset . :size)
(:mem-uses-svm-pointer . cl-bool)
(:mem-properties . (:pointer cl-mem-properties))))
(wrap-get-info-function get-mem-object-info %get-mem-object-info
+mem-object-info-type-alist+)
(defparameter +image-info-type-alist+
'((:image-format . cl-image-format)
(:image-element-size . :size)
(:image-row-pitch . :size)
(:image-slice-pitch . :size)
(:image-width . :size)
(:image-height . :size)
(:image-depth . :size)
(:image-array-size . :size)
(:image-buffer . cl-mem)
(:image-num-mip-levels . cl-uint)
(:image-num-samples . cl-uint)))
(wrap-get-info-function get-image-info %get-image-info +image-info-type-alist+)
(defparameter +pipe-info-type-alist+
'((:pipe-packet-size . cl-uint)
(:pipe-max-packets . cl-uint)
(:pipe-properties . (:pointer cl-pipe-properties))))
(wrap-get-info-function get-pipe-info %get-pipe-info +pipe-info-type-alist+)
(defmacro with-mem-object ())
(defmacro with-buffer ((buffer context flags size &optional host-ptr) &body body)
`(let ((,buffer (create-buffer ,context ,flags ,size ,(if host-ptr host-ptr '(cffi:null-pointer)))))
(unwind-protect
(progn ,@body)
(release-mem-object ,buffer))))
(defmacro with-buffer-from-array ((buffer context flags array) &body body)
`(let ((,buffer (create-buffer-from-array ,context ,flags ,array)))
(unwind-protect
(progn ,@body)
(release-mem-object ,buffer))))
(defmacro with-buffers-from-arrays ())
(defun copy-buffer-to-array (queue buffer array)
(let* ((length (length array))
(c-type (array-foreign-type array))
(size (* length (cffi:foreign-type-size c-type))))
(cffi:with-foreign-object (c-array c-type length)
(enqueue-read-buffer queue buffer t 0 size c-array)
(dotimes (i length)
(setf (aref array i) (cffi:mem-aref c-array c-type i))))))
|
