From 6fe823a614279cceb2d48507bd8e93b0efd87f94 Mon Sep 17 00:00:00 2001 From: Thomas Albers Date: Sat, 4 Mar 2023 22:47:28 +0100 Subject: Initial commit --- src/device.lisp | 176 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 176 insertions(+) create mode 100644 src/device.lisp (limited to 'src/device.lisp') diff --git a/src/device.lisp b/src/device.lisp new file mode 100644 index 0000000..830ee82 --- /dev/null +++ b/src/device.lisp @@ -0,0 +1,176 @@ +(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))) -- cgit v1.2.3