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/program.lisp | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 src/program.lisp (limited to 'src/program.lisp') diff --git a/src/program.lisp b/src/program.lisp new file mode 100644 index 0000000..4f27a25 --- /dev/null +++ b/src/program.lisp @@ -0,0 +1,83 @@ +(in-package #:ocl) + +(defun create-program-with-source (context list-of-strings) + (setf list-of-strings (alexandria:ensure-list list-of-strings)) + (let ((num-strings (length list-of-strings))) + (cffi:with-foreign-object (c-strings :pointer num-strings) + (dotimes (i num-strings) + (setf (cffi:mem-aref c-strings :pointer i) + (cffi:foreign-string-alloc (elt list-of-strings i)))) + (unwind-protect + (check-error-arg (%create-program-with-source context num-strings c-strings (cffi:null-pointer))) + (dotimes (i num-strings) + (cffi:foreign-string-free (cffi:mem-aref c-strings :pointer i))))))) + +(defun retain-program (program) + (check-error (%retain-program program))) + +(defun release-program (program) + (%release-program program)) + +(defun build-program (program device-list &key (options (cffi:null-pointer)) + (pfn-notify (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (setf device-list (alexandria:ensure-list device-list)) + (with-foreign-sequence (c-devices device-list 'cl-device-id num-devices) + (check-error (%build-program program num-devices c-devices options + pfn-notify user-data)))) + +;; (defun compile-program (program device-list +;; &key (options (cffi:null-pointer)) +;; input-headers +;; header-include-names +;; (pfn-notify (cffi:null-pointer)) +;; (user-data (cffi:null-pointer))) +;; (with-foreign-sequence ((c-device-list device-list 'cl-device-id num-devices) +;; (c-input-headers input-headers 'cl-program num-input-headers)) +;; (check-error (%compile-program program num-devices c-device-list options +;; num-input-headers c-input-headers +;; pfn-notify user-data)))) + +(defun link-program (context device-list input-programs &key (options (cffi:null-pointer)) + (pfn-notify (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (assert (not (emptyp input-programs))) + (with-foreign-sequences ((c-device-list device-list 'cl-device-id num-devices) + (c-input-programs input-programs 'cl-program num-input-programs)) + (check-error-arg (%link-program context num-devices c-device-list options + num-input-programs c-input-programs + pfn-notify user-data)))) + +(defun unload-platform-compiler (platform) + (check-error (%unload-platform-compiler platform))) + +(defparameter +program-info-type-alist+ + '((:program-reference-count . cl-uint) + (:program-context . cl-context) + (:program-num-devices . cl-uint) + (:program-devices . (:pointer cl-device-id)) + (:program-source . :string) + (:program-il . (:pointer :char)) + (:program-binary-sizes . (:pointer :size)) + (:program-binaries . (:pointer (:pointer :char))) + (:program-num-kernels . :size) + (:program-kernel-names . (:pointer :char)) + (:program-scope-global-ctors-present . cl-bool) + (:program-scope-global-dtors-present . cl-bool))) + +;; %get-program-info + +(defparameter +program-build-info-type-alist+ + '((:program-build-status . cl-build-status) + (:program-build-options . :string) + (:program-build-log . :string) + (:program-binary-type . cl-program-binary-type) + (:program-build-global-variable-total-size . :size))) + +;; %get-program-build-info + +(defmacro with-program-from-source ((program context list-of-strings) &body body) + `(let ((,program (create-program-with-source ,context ,list-of-strings))) + (unwind-protect + (progn ,@body) + (release-program ,program)))) -- cgit v1.2.3