blob: 4f27a251ef4ed73b496e52b668f55b28f9d80881 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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))))
|
