blob: 45dc9b31b360083b9e719e5a06dfcac8907abc66 (
plain)
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
|
(in-package #:ocl)
(defun create-context (devices &key platform iterop-user-sync-p)
(let ((properties '(0)))
(when iterop-user-sync-p
(push 1 properties)
(push :context-interop-user-sync properties))
(when platform
(push (cffi:pointer-address platform) properties)
(push :context-platform properties))
(with-foreign-sequences ((c-properties properties 'cl-context-properties)
(c-devices devices 'cl-device-id num-devices))
(check-error-arg
(%create-context c-properties num-devices c-devices (cffi:null-pointer)
(cffi:null-pointer))))))
(defun create-context-from-type (device-type &key platform iterop-user-sync-p
(pfn-notify (cffi:null-pointer))
(user-data (cffi:null-pointer)))
(let ((properties '(0)))
(when iterop-user-sync-p
(push 1 properties)
(push :context-interop-user-sync properties))
(when platform
(push (cffi:pointer-address platform) properties)
(push :context-platform properties))
(with-foreign-sequences ((c-properties properties 'cl-context-properties))
(check-error-arg
(%create-context-from-type c-properties device-type pfn-notify user-data)))))
(defun retain-context (context)
(check-error (%retain-context context)))
(defun release-context (context)
(check-error (%release-context context)))
(defparameter +context-info-type-alist+
'((:context-reference-count . cl-uint)
(:context-num-devices . cl-uint)
(:context-devices . (:pointer cl-device-id))
(:context-properties . (:pointer cl-context-properties))))
(wrap-get-info-function get-context-info %get-context-info +context-info-type-alist+)
(defmacro with-context ((context devices &rest options) &body body)
`(let ((,context (create-context ,devices ,@options)))
(unwind-protect
(progn ,@body)
(release-context ,context))))
|
