(in-package #:ocl)

(defun get-device-ids (platform device-type)
  (let (num-devices)
    (cffi:with-foreign-object (c-num-devices 'cl-uint)
      (check-error (%get-device-ids platform device-type 0 (cffi:null-pointer) c-num-devices))
      (setf num-devices (cffi:mem-ref c-num-devices 'cl-uint)))
    (cffi:with-foreign-object (c-devices 'cl-device-id num-devices)
      (check-error (%get-device-ids platform device-type num-devices c-devices (cffi:null-pointer)))
      (loop :for i :below num-devices
            :collect (cffi:mem-aref c-devices 'cl-device-id i)))))

(defparameter +device-info-type-alist+
  '((:device-type                                    . cl-device-type)
    (:device-vendor-id                               . cl-uint)
    (:device-max-compute-units                       . cl-uint)
    (:device-max-work-item-dimensions                . cl-uint)
    (:device-max-work-group-size                     . :size)
    (:device-max-work-item-sizes                     . (:pointer :size))
    (:device-preferred-vector-width-char             . cl-uint)
    (:device-preferred-vector-width-short            . cl-uint)
    (:device-preferred-vector-width-int              . cl-uint)
    (:device-preferred-vector-width-long             . cl-uint)
    (:device-preferred-vector-width-float            . cl-uint)
    (:device-preferred-vector-width-double           . cl-uint)
    (:device-max-clock-frequency                     . cl-uint)
    (:device-address-bits                            . cl-uint)
    (:device-max-read-image-args                     . cl-uint)
    (:device-max-write-image-args                    . cl-uint)
    (:device-max-mem-alloc-size                      . cl-ulong)
    (:device-image2d-max-width                       . :size)
    (:device-image2d-max-height                      . :size)
    (:device-image3d-max-width                       . :size)
    (:device-image3d-max-height                      . :size)
    (:device-image3d-max-depth                       . :size)
    (:device-image-support                           . cl-bool)
    (:device-max-parameter-size                      . :size)
    (:device-max-samplers                            . cl-uint)
    (:device-mem-base-addr-align                     . cl-uint)
    (:device-min-data-type-align-size                . cl-uint)
    (:device-single-fp-config                        . cl-device-fp-config)
    (:device-global-mem-cache-type                   . cl-device-mem-cache-type)
    (:device-global-mem-cacheline-size               . cl-uint)
    (:device-global-mem-cache-size                   . cl-ulong)
    (:device-global-mem-size                         . cl-ulong)
    (:device-max-constant-buffer-size                . cl-ulong)
    (:device-max-constant-args                       . cl-uint)
    (:device-local-mem-type                          . cl-device-local-mem-type)
    (:device-local-mem-size                          . cl-ulong)
    (:device-error-correction-support                . cl-bool)
    (:device-profiling-timer-resolution              . :size)
    (:device-endian-little                           . cl-bool)
    (:device-available                               . cl-bool)
    (:device-compiler-available                      . cl-bool)
    (:device-execution-capabilities                  . cl-device-exec-capabilities)
    (:device-queue-properties                        . cl-command-queue-properties)
    (:device-queue-on-host-properties                . cl-command-queue-properties)
    (:device-name                                    . :string)
    (:device-vendor                                  . :string)
    (:driver-version                                 . :string)
    (:device-profile                                 . :string)
    (:device-version                                 . :string)
    (:device-extensions                              . :string)
    (:device-platform                                . cl-platform-id)
    (:device-double-fp-config                        . cl-device-fp-config)
    (:device-preferred-vector-width-half             . cl-uint)
    (:device-host-unified-memory                     . cl-bool)
    (:device-native-vector-width-char                . cl-uint)
    (:device-native-vector-width-short               . cl-uint)
    (:device-native-vector-width-int                 . cl-uint)
    (:device-native-vector-width-long                . cl-uint)
    (:device-native-vector-width-float               . cl-uint)
    (:device-native-vector-width-double              . cl-uint)
    (:device-native-vector-width-half                . cl-uint)
    (:device-opencl-c-version                        . :string)
    (:device-linker-available                        . cl-bool)
    (:device-built-in-kernels                        . :string)
    (:device-image-max-buffer-size                   . :size)
    (:device-image-max-array-size                    . :size)
    (:device-parent-device                           . cl-device-id)
    (:device-partition-max-sub-devices               . cl-uint)
    (:device-partition-properties                    . (:pointer cl-device-partition-property))
    (:device-partition-affinity-domain               . cl-device-affinity-domain)
    (:device-partition-type                          . (:pointer cl-device-partition-property))
    (:device-reference-count                         . cl-uint)
    (:device-preferred-interop-user-sync             . cl-bool)
    (:device-printf-buffer-size                      . :size)
    (:device-image-pitch-alignment                   . cl-uint)
    (:device-image-base-address-alignment            . cl-uint)
    (:device-max-read-write-image-args               . cl-uint)
    (:device-max-global-variable-size                . :size)
    (:device-queue-on-device-properties              . cl-command-queue-properties)
    (:device-queue-on-device-preferred-size          . cl-uint)
    (:device-queue-on-device-max-size                . cl-uint)
    (:device-max-on-device-queues                    . cl-uint)
    (:device-max-on-device-events                    . cl-uint)
    (:device-svm-capabilities                        . cl-device-svm-capabilities)
    (:device-global-variable-preferred-total-size    . :size)
    (:device-max-pipe-args                           . cl-uint)
    (:device-pipe-max-active-reservations            . cl-uint)
    (:device-pipe-max-packet-size                    . cl-uint)
    (:device-preferred-platform-atomic-alignment     . cl-uint)
    (:device-preferred-global-atomic-alignment       . cl-uint)
    (:device-preferred-local-atomic-alignment        . cl-uint)
    (:device-il-version                              . :string)
    (:device-max-num-sub-groups                      . cl-uint)
    (:device-sub-group-independent-forward-progress  . cl-bool)
    (:device-numeric-version                         . cl-version)
    (:device-extensions-with-version                 . (:pointer cl-name-version))
    (:device-ils-with-version                        . (:pointer cl-name-version))
    (:device-built-in-kernels-with-version           . (:pointer cl-name-version))
    (:device-atomic-memory-capabilities              . cl-device-atomic-capabilities)
    (:device-atomic-fence-capabilities               . cl-device-atomic-capabilities)
    (:device-non-uniform-work-group-support          . cl-bool)
    (:device-opencl-c-all-versions                   . (:pointer cl-name-version))
    (:device-preferred-work-group-size-multiple      . :size)
    (:device-work-group-collective-functions-support . cl-bool)
    (:device-generic-address-space-support           . cl-bool)
    (:device-opencl-c-features                       . (:pointer cl-name-version))
    (:device-device-enqueue-capabilities             . cl-device-device-enqueue-capabilities)
    (:device-pipe-support                            . cl-bool)
    (:device-latest-conformance-version-passed       . :string)))

(wrap-get-info-function get-device-info %get-device-info +device-info-type-alist+)

;; (defun get-device-info (device param-name)
;;   (let ((type (assoc-value +device-info-type-alist+ param-name))
;;         (return-size nil)
;;         (error-code nil)
;;         (return-value nil))
;;     (cffi:with-foreign-object (c-return-size :size)
;;       (setf error-code (%get-device-info device param-name 0 (cffi:null-pointer) c-return-size))
;;       (unless (eq error-code :success)
;;         (error 'opencl-error :code error-code))
;;       (setf return-size (cffi:mem-ref c-return-size :size)))
;;     (cond ((vector-type-p type)
;;            (let ((count (/ return-size (cffi:foreign-type-size (second type)))))
;;              (cffi:with-foreign-object (c-value type count)
;;                (setf error-code (%get-device-info device param-name return-size c-value (cffi:null-pointer)))
;;                (setf return-value (loop :for i :below count :collect (cffi:mem-aref c-value type i))) )))
;;           ((string-type-p type)
;;            (setf return-value
;;                  (cffi:with-foreign-pointer-as-string (c-string return-size)
;;                    (setf error-code (%get-device-info device param-name return-size c-string (cffi:null-pointer))))))
;;           (t
;;            (cffi:with-foreign-object (c-value type)
;;              (setf error-code (%get-device-info device param-name (cffi:foreign-type-size type)
;;                                                 c-value (cffi:null-pointer)))
;;              (setf return-value (cffi:mem-ref c-value type)))))
;;     (unless (eq error-code :success)
;;       (error 'opencl-error :code error-code))
;;     return-value))

;; (defun create-sub-devices (in-device properties)
;;   (check-error (%create-sub-devices in-device )))

(defun retain-device (device)
  (check-error (%retain-device device)))

(defun release-device (device)
  (check-error (%release-device device)))

(defun set-default-device-command-queue (context device command-queue)
  (check-error (%set-default-device-command-queue context device command-queue)))

(defun get-device-and-host-timer (device)
  (cffi:with-foreign-objects ((device-timestamp 'cl-ulong)
                              (host-timestamp 'cl-ulong))
    (check-error (%get-device-and-host-timer device device-timestamp host-timestamp))
    (values (cffi:mem-ref device-timestamp 'cl-ulong)
            (cffi:mem-ref host-timestamp 'cl-ulong))))

(defun get-host-timer (device)
  (cffi:with-foreign-object (host-timestamp 'cl-ulong)
    (check-error (%get-host-timer device host-timestamp))
    (cffi:mem-ref host-timestamp 'cl-ulong)))