(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)))