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
|
(in-package #:ocl)
;; once-only really needed?
;; gensym really needed?
(defmacro wrap-enqueue (form event-wait-list)
""
(let ((num-events-in-wait-list (gensym "NUM-EVENTS-IN-WAIT-LIST"))
(c-event-wait-list (gensym "C-EVENT-WAIT-LIST"))
(c-event (gensym "C-EVENT"))
(i (gensym "I")))
(alexandria:once-only (event-wait-list)
`(let ((,num-events-in-wait-list (length ,event-wait-list)))
(cffi:with-foreign-object (,c-event 'cl-event)
(if (zerop ,num-events-in-wait-list)
(check-error (,@form 0 (cffi:null-pointer) ,c-event))
(cffi:with-foreign-object (,c-event-wait-list 'cl-event ,num-events-in-wait-list)
(dotimes (,i ,num-events-in-wait-list)
(setf (cffi:mem-aref ,c-event-wait-list 'cl-event ,i) (elt ,event-wait-list ,i)))
(check-error (,@form ,num-events-in-wait-list ,c-event-wait-list ,c-event))
(cffi:mem-ref ,c-event 'cl-event))))))))
(defun enqueue-read-buffer (command-queue buffer blocking-read offset size ptr &optional event-wait-list)
(wrap-enqueue (%enqueue-read-buffer command-queue buffer (if blocking-read :true :false) offset size ptr)
event-wait-list))
;; TODO: Check dimensions?
(defun enqueue-nd-range-kernel (queue kernel global-work-offset global-work-size
local-work-size &optional event-wait-list)
(setf global-work-offset (alexandria:ensure-list global-work-offset)
global-work-size (alexandria:ensure-list global-work-size)
local-work-size (alexandria:ensure-list local-work-size))
;; (assert (length global-work-size) ...)
(let ((work-dim (length global-work-size)))
(with-foreign-sequences ((c-global-work-offset global-work-offset :size)
(c-global-work-size global-work-size :size)
(c-local-work-size local-work-size :size))
(wrap-enqueue (%enqueue-nd-range-kernel queue kernel work-dim
c-global-work-offset c-global-work-size
c-local-work-size)
event-wait-list))))
(defun enqueue-svm-free (command-queue svm-pointers &optional event-wait-list
(pfn-free-func (cffi:null-pointer))
(user-data (cffi:null-pointer)))
(with-foreign-sequence (c-svm-pointers svm-pointers '(:pointer :void) num-svm-pointers)
(wrap-enqueue
(%enqueue-svm-free command-queue num-svm-pointers c-svm-pointers
pfn-free-func user-data)
event-wait-list)))
(defun enqueue-svm-memcpy (command-queue blocking-copy-p dst-ptr src-ptr size
&optional event-wait-list)
(wrap-enqueue
(%enqueue-svm-memcpy command-queue (if blocking-copy-p :true :false) dst-ptr src-ptr size)
event-wait-list))
(defun enqueue-svm-memfill (command-queue svm-ptr pattern pattern-size size
&optional event-wait-list)
(wrap-enqueue
(%enqueue-svm-memfill command-queue svm-ptr pattern pattern-size size)
event-wait-list))
(defun enqueue-svm-map (command-queue blocking-map-p flags svm-ptr size
&optional event-wait-list)
(wrap-enqueue
(%enqueue-svm-map command-queue (if blocking-map-p :true :false) flags svm-ptr size)
event-wait-list))
(defun enqueue-svm-unmap (command-queue svm-ptr &optional event-wait-list)
(wrap-enqueue (%enqueue-svm-unmap command-queue svm-ptr) event-wait-list))
(defun enqueue-svm-migrate-mem (command-queue svm-pointers sizes flags &optional event-wait-list)
(assert (or (emptyp sizes) (length= svm-pointers sizes)))
(with-foreign-sequences ((c-svm-pointers svm-pointers '(:pointer :void) num-svm-pointers)
(c-sizes sizes :size))
(wrap-enqueue (%enqueue-svm-migrate-mem command-queue num-svm-pointers c-svm-pointers c-sizes flags)
event-wait-list)))
|
