From 6fe823a614279cceb2d48507bd8e93b0efd87f94 Mon Sep 17 00:00:00 2001
From: Thomas Albers <thomas@thomaslabs.org>
Date: Sat, 4 Mar 2023 22:47:28 +0100
Subject: Initial commit

---
 src/context.lisp | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 src/context.lisp

(limited to 'src/context.lisp')

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))))
-- 
cgit v1.2.3