summaryrefslogtreecommitdiff
path: root/t/test.lisp
blob: 98e9a89905a293917d03edc0446da4b30ba24bd8 (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
(asdf:load-systems :slynk :opencl :alexandria)

(in-package #:ocl)

;; (slynk:create-server)

(defun print-platform (platform)
  (loop :for info :in '(:platform-profile
                        :platform-version
                        :platform-name
                        :platform-vendor
                        :platform-extensions
                        :platform-host-timer-resolution)
        :do
        (format t "~A: ~A~%" info (get-platform-info platform info))))

(defun main (context kernel queue)
  (let* ((a (make-array 3 :element-type 'single-float :initial-contents '(1.0 2.0 3.0)))
         (b (make-array 3 :element-type 'single-float :initial-contents '(2.0 2.0 3.0)))
         (c (make-array 3 :element-type 'single-float))
         (size (* (cffi:foreign-type-size :float) 3)))
    (with-buffer-from-array (a-buffer context '(:mem-copy-host-ptr :mem-read-only) a)
      (with-buffer-from-array (b-buffer context '(:mem-copy-host-ptr :mem-read-only) b)
        (with-buffer (c-buffer context :mem-write-only size)

          (set-kernel-arg kernel 0 'cl-mem a-buffer)
          (set-kernel-arg kernel 1 'cl-mem b-buffer)
          (set-kernel-arg kernel 2 'cl-mem c-buffer)
          (set-kernel-arg kernel 3 :unsigned-int 3)

          (enqueue-nd-range-kernel queue kernel 0 3 1)

          (finish queue)

          (copy-buffer-to-array queue c-buffer c)

          (dotimes (i 3)
            (format t "~A~%" (aref c i))))))))

(let ((platforms (get-platform-ids)))
  (format t "~&Found ~A OpenCL platforms!~%" (length platforms))
  (print-platform (first platforms))
  (let ((devices (get-device-ids (first platforms) :device-type-cpu)))
    (format t "Found ~A devices!~%Type: ~A~%" (length devices)
            (get-device-info (first devices) :device-type))
    (with-context (context devices :platform (first platforms))
      (with-program-from-source (program context (alexandria:read-file-into-string "test.cl"))
        (build-program program (first devices))
        (with-command-queue (queue context (first devices))
          (with-kernel (kernel program "vecAdd")
            (main context kernel queue)))))))