diff options
Diffstat (limited to 'src/context.lisp')
-rw-r--r-- | src/context.lisp | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/src/context.lisp b/src/context.lisp new file mode 100644 index 0000000..45dc9b3 --- /dev/null +++ b/src/context.lisp @@ -0,0 +1,49 @@ +(in-package #:ocl) + +(defun create-context (devices &key platform iterop-user-sync-p) + (let ((properties '(0))) + (when iterop-user-sync-p + (push 1 properties) + (push :context-interop-user-sync properties)) + (when platform + (push (cffi:pointer-address platform) properties) + (push :context-platform properties)) + (with-foreign-sequences ((c-properties properties 'cl-context-properties) + (c-devices devices 'cl-device-id num-devices)) + (check-error-arg + (%create-context c-properties num-devices c-devices (cffi:null-pointer) + (cffi:null-pointer)))))) + +(defun create-context-from-type (device-type &key platform iterop-user-sync-p + (pfn-notify (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (let ((properties '(0))) + (when iterop-user-sync-p + (push 1 properties) + (push :context-interop-user-sync properties)) + (when platform + (push (cffi:pointer-address platform) properties) + (push :context-platform properties)) + (with-foreign-sequences ((c-properties properties 'cl-context-properties)) + (check-error-arg + (%create-context-from-type c-properties device-type pfn-notify user-data))))) + +(defun retain-context (context) + (check-error (%retain-context context))) + +(defun release-context (context) + (check-error (%release-context context))) + +(defparameter +context-info-type-alist+ + '((:context-reference-count . cl-uint) + (:context-num-devices . cl-uint) + (:context-devices . (:pointer cl-device-id)) + (:context-properties . (:pointer cl-context-properties)))) + +(wrap-get-info-function get-context-info %get-context-info +context-info-type-alist+) + +(defmacro with-context ((context devices &rest options) &body body) + `(let ((,context (create-context ,devices ,@options))) + (unwind-protect + (progn ,@body) + (release-context ,context)))) |