Initial commit

1 files changed, 77 insertions, 0 deletions

diff --git a/src/enqueue.lisp b/src/enqueue.lisp
new file mode 100644
index 0000000..d26f1c3
--- /dev/null
+++ b/src/enqueue.lisp
@@ -0,0 +1,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)))