Initial commit

1 files changed, 83 insertions, 0 deletions

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