Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

modify to show messages when CUDA driver APIs called

  • Loading branch information...
commit c1984f7a0f29184054efc8ebcd62bb9900a8af2f 1 parent 8aa7494
@takagi authored
Showing with 117 additions and 130 deletions.
  1. +74 −69 src/cl-cuda.lisp
  2. +43 −61 t/test-cl-cuda.lisp
View
143 src/cl-cuda.lisp
@@ -5,6 +5,18 @@
(in-package :cl-cuda)
+;;; defcufun
+
+(defmacro defcufun (name-and-options return-type &body args0)
+ (let* ((name (car name-and-options))
+ (name% (symbolicate name "%"))
+ (name-and-options% (cons name% (cdr name-and-options))))
+ (with-gensyms (args)
+ `(progn
+ (defun ,name (&rest ,args)
+ (check-cuda-errors ',name (apply #',name% ,args)))
+ (defcfun ,name-and-options% ,return-type ,@args0)))))
+
;;; load CUDA driver API
@@ -28,104 +40,102 @@
;;; Functions
;; cuInit
-(defcfun (cu-init "cuInit") cu-result (flags :unsigned-int))
+(defcufun (cu-init "cuInit") cu-result (flags :unsigned-int))
;; cuDeviceGet
-(defcfun (cu-device-get "cuDeviceGet") cu-result
+(defcufun (cu-device-get "cuDeviceGet") cu-result
(device (:pointer cu-device))
(ordinal :int))
;; cuDeviceGetCount
-(defcfun (cu-device-get-count "cuDeviceGetCount") cu-result
+(defcufun (cu-device-get-count "cuDeviceGetCount") cu-result
(count (:pointer :int)))
;; cuDeviceComputeCapability
-(defcfun (cu-device-compute-capability "cuDeviceComputeCapability") cu-result
+(defcufun (cu-device-compute-capability "cuDeviceComputeCapability") cu-result
(major (:pointer :int))
(minor (:pointer :int))
(dev cu-device))
;; cuDeviceGetName
-(defcfun (cu-device-get-name "cuDeviceGetName") cu-result
+(defcufun (cu-device-get-name "cuDeviceGetName") cu-result
(name :string)
(len :int)
(dev cu-device))
;; cuCtxCreate
-(defcfun (cu-ctx-create "cuCtxCreate") cu-result
+(defcufun (cu-ctx-create "cuCtxCreate") cu-result
(pctx (:pointer cu-context))
(flags :unsigned-int)
(dev cu-device))
;; cuCtxDestroy
-(defcfun (cu-ctx-destroy "cuCtxDestroy") cu-result
+(defcufun (cu-ctx-destroy "cuCtxDestroy") cu-result
(pctx cu-context))
;; cuMemAlloc
-(defcfun (cu-mem-alloc "cuMemAlloc") cu-result
+(defcufun (cu-mem-alloc "cuMemAlloc") cu-result
(dptr (:pointer cu-device-ptr))
(bytesize size-t))
;; cuMemFree
-(defcfun (cu-mem-free "cuMemFree") cu-result
+(defcufun (cu-mem-free "cuMemFree") cu-result
(dptr cu-device-ptr))
;; cuMemcpyHtoD
-(defcfun (cu-memcpy-host-to-device "cuMemcpyHtoD")
- cu-result
- (dst-device cu-device-ptr)
- (src-host :pointer)
- (byte-count size-t))
+(defcufun (cu-memcpy-host-to-device "cuMemcpyHtoD") cu-result
+ (dst-device cu-device-ptr)
+ (src-host :pointer)
+ (byte-count size-t))
;; cuMemcpyDtoH
-(defcfun (cu-memcpy-device-to-host "cuMemcpyDtoH")
- cu-result
- (dst-host :pointer)
- (src-device cu-device-ptr)
- (byte-count size-t))
+(defcufun (cu-memcpy-device-to-host "cuMemcpyDtoH") cu-result
+ (dst-host :pointer)
+ (src-device cu-device-ptr)
+ (byte-count size-t))
;; cuModuleLoad
-(defcfun (cu-module-load "cuModuleLoad")
- cu-result
- (module (:pointer cu-module))
- (fname :string))
+(defcufun (cu-module-load "cuModuleLoad") cu-result
+ (module (:pointer cu-module))
+ (fname :string))
;; cuModuleUnload
-(defcfun (cu-module-unload "cuModuleUnload")
- cu-result
- (module cu-module))
+(defcufun (cu-module-unload "cuModuleUnload") cu-result
+ (module cu-module))
;; cuModuleGetFunction
-(defcfun (cu-module-get-function "cuModuleGetFunction")
- cu-result
- (hfunc (:pointer cu-function))
- (hmod cu-module)
- (name :string))
+(defcufun (cu-module-get-function "cuModuleGetFunction") cu-result
+ (hfunc (:pointer cu-function))
+ (hmod cu-module)
+ (name :string))
;; cuLaunchKernel
-(defcfun (cu-launch-kernel "cuLaunchKernel")
- cu-result
- (f cu-function)
- (grid-dim-x :unsigned-int)
- (grid-dim-y :unsigned-int)
- (grid-dim-z :unsigned-int)
- (block-dim-x :unsigned-int)
- (block-dim-y :unsigned-int)
- (block-dim-z :unsigned-int)
- (shared-mem-bytes :unsigned-int)
- (hstream cu-stream)
- (kernel-params (:pointer :pointer))
- (extra (:pointer :pointer)))
+(defcufun (cu-launch-kernel "cuLaunchKernel") cu-result
+ (f cu-function)
+ (grid-dim-x :unsigned-int)
+ (grid-dim-y :unsigned-int)
+ (grid-dim-z :unsigned-int)
+ (block-dim-x :unsigned-int)
+ (block-dim-y :unsigned-int)
+ (block-dim-z :unsigned-int)
+ (shared-mem-bytes :unsigned-int)
+ (hstream cu-stream)
+ (kernel-params (:pointer :pointer))
+ (extra (:pointer :pointer)))
;;; Constants
+
(defvar +cuda-success+ 0)
;;; Helpers
-(defun check-cuda-errors (err)
- (when (/= +cuda-success+ err)
- (error (format nil "check-cuda-errors: Driver API error = ~A ~%" err)))
+
+(defun check-cuda-errors (name return-code)
+ (unless (= return-code +cuda-success+)
+ (error (format nil "~A failed with driver API error No. ~A.~%"
+ name return-code)))
+ (format t "~A succeeded.~%" name)
(values))
(defmacro with-cuda-context (args &body body)
@@ -134,24 +144,22 @@
(with-gensyms (device ctx)
`(with-foreign-objects ((,device 'cu-device)
(,ctx 'cu-context))
- (check-cuda-errors (cu-init 0))
- (check-cuda-errors (cu-device-get ,device ,dev-id))
- (check-cuda-errors (cu-ctx-create ,ctx ,flags
- (mem-ref ,device 'cu-device)))
+ (cu-init 0)
+ (cu-device-get ,device ,dev-id)
+ (cu-ctx-create ,ctx ,flags (mem-ref ,device 'cu-device))
(unwind-protect
(progn ,@body)
(progn
(kernel-manager-unload *kernel-manager*)
- (check-cuda-errors (cu-ctx-destroy
- (mem-ref ,ctx 'cu-context))))))))))
+ (cu-ctx-destroy (mem-ref ,ctx 'cu-context)))))))))
(defmacro with-cuda-memory-block (args &body body)
(destructuring-bind (dptr size) args
`(with-foreign-object (,dptr 'cu-device-ptr)
- (check-cuda-errors (cu-mem-alloc ,dptr ,size))
+ (cu-mem-alloc ,dptr ,size)
(unwind-protect
(progn ,@body)
- (check-cuda-errors (cu-mem-free (mem-ref ,dptr 'cu-device-ptr)))))))
+ (cu-mem-free (mem-ref ,dptr 'cu-device-ptr))))))
(defmacro with-cuda-memory-blocks (bindings &body body)
(if bindings
@@ -170,10 +178,9 @@
(with-foreign-string (,func-name ,function)
(with-foreign-objects ((,hmodule 'cu-module)
(,hfunc 'cu-function))
- (check-cuda-errors (cu-module-load ,hmodule ,module-name))
- (check-cuda-errors
- (cu-module-get-function ,hfunc (mem-ref ,hmodule 'cu-module)
- ,func-name))
+ (cu-module-load ,hmodule ,module-name)
+ (cu-module-get-function ,hfunc (mem-ref ,hmodule 'cu-module)
+ ,func-name)
,@body))))))
(defmacro with-non-pointer-arguments (bindings &body body)
@@ -212,12 +219,11 @@
(grid-dim-x grid-dim-y grid-dim-z) grid-dim
(destructuring-bind
(block-dim-x block-dim-y block-dim-z) block-dim
- (check-cuda-errors
- (cu-launch-kernel (mem-ref ,hfunc 'cu-function)
- grid-dim-x grid-dim-y grid-dim-z
- block-dim-x block-dim-y block-dim-z
- 0 (null-pointer)
- ,args (null-pointer))))))))))))
+ (cu-launch-kernel (mem-ref ,hfunc 'cu-function)
+ grid-dim-x grid-dim-y grid-dim-z
+ block-dim-x block-dim-y block-dim-z
+ 0 (null-pointer)
+ ,args (null-pointer)))))))))))
(defmacro defkernel (name arg-bindings &rest body)
(kernel-manager-define-function *kernel-manager* name arg-bindings body)
@@ -446,8 +452,7 @@
(let ((hmodule (kernel-manager-module-handle mgr))
(hfunc (foreign-alloc 'cu-function))
(fname (kernel-manager-function-c-name mgr name)))
- (check-cuda-errors
- (cu-module-get-function hfunc (mem-ref hmodule 'cu-module) fname))
+ (cu-module-get-function hfunc (mem-ref hmodule 'cu-module) fname)
(setf (kernel-manager-function-handle mgr name) hfunc)))
(defun kernel-manager-load-module (mgr)
@@ -457,7 +462,7 @@
(error "some kernel functions are already loaded."))
(let ((hmodule (foreign-alloc 'cu-module))
(path (kernel-manager-module-path mgr)))
- (check-cuda-errors (cu-module-load hmodule path))
+ (cu-module-load hmodule path)
(setf (kernel-manager-module-handle mgr) hmodule)))
(defun no-kernel-functions-loaded-p (mgr)
@@ -468,7 +473,7 @@
(defun kernel-manager-unload (mgr)
(swhen (kernel-manager-module-handle mgr)
- (check-cuda-errors (cu-module-unload (mem-ref it 'cu-module))))
+ (cu-module-unload (mem-ref it 'cu-module)))
(free-function-handles mgr)
(free-module-handle mgr))
View
104 t/test-cl-cuda.lisp
@@ -11,138 +11,128 @@
;;; test cuInit
+(diag "test cuInit")
(cu-init 0)
;;; test cuDeviceGet
+(diag "test cuDeviceGet")
(let ((dev-id 0))
(cffi:with-foreign-object (device 'cu-device)
(setf (cffi:mem-ref device :int) 42)
- (check-cuda-errors (cu-device-get device dev-id))
+ (cu-device-get device dev-id)
(format t "CUDA device handle: ~A~%" (cffi:mem-ref device 'cu-device))))
;;; test cuDeviceGetCount
+(diag "test cuDeviceGetCount")
(cffi:with-foreign-object (count :int)
- (check-cuda-errors (cu-device-get-count count))
+ (cu-device-get-count count)
(format t "CUDA device count: ~A~%" (cffi:mem-ref count :int)))
;;; test cuDeviceComputeCapability
+(diag "test cuDeviceComputeCapability")
(let ((dev-id 0))
(cffi:with-foreign-objects ((major :int)
(minor :int)
(device 'cu-device))
- (check-cuda-errors (cu-device-get device dev-id))
- (check-cuda-errors
- (cu-device-compute-capability major minor
- (cffi:mem-ref device 'cu-device)))
+ (cu-device-get device dev-id)
+ (cu-device-compute-capability major minor (cffi:mem-ref device 'cu-device))
(format t "CUDA device compute capability: ~A.~A~%"
- (cffi:mem-ref major :int) (cffi:mem-ref minor :int))))
+ (cffi:mem-ref major :int) (cffi:mem-ref minor :int))))
;;; test cuDeviceGetName
+(diag "test cuDeviceGetName")
(let ((dev-id 0))
(cffi:with-foreign-object (device 'cu-device)
(cffi:with-foreign-pointer-as-string ((name size) 255)
- (check-cuda-errors (cu-device-get device dev-id))
- (check-cuda-errors (cu-device-get-name name size
- (cffi:mem-ref device 'cu-device)))
+ (cu-device-get device dev-id)
+ (cu-device-get-name name size (cffi:mem-ref device 'cu-device))
(format t "CUDA device name: ~A~%" (cffi:foreign-string-to-lisp name)))))
;;; test cuCtxCreate/cuCtxDestroy
+(diag "test cuCtxCreate/cuCtxDestroy")
(let ((flags 0)
(dev-id 0))
(cffi:with-foreign-objects ((pctx 'cu-context)
(device 'cu-device))
- (check-cuda-errors (cu-device-get device dev-id))
- (check-cuda-errors (cu-ctx-create pctx flags
- (cffi:mem-ref device 'cu-device)))
- (format t "a CUDA context is created.~%")
- (check-cuda-errors (cu-ctx-destroy (cffi:mem-ref pctx 'cu-context)))
- (format t "a CUDA context is destroyed.~%")))
+ (cu-device-get device dev-id)
+ (cu-ctx-create pctx flags (cffi:mem-ref device 'cu-device))
+ (cu-ctx-destroy (cffi:mem-ref pctx 'cu-context))))
;;; test cuMemAlloc/cuMemFree
+(diag "test cuMemAlloc/cuMemFree")
(let ((flags 0)
(dev-id 0))
(cffi:with-foreign-objects ((device 'cu-device)
(pctx 'cu-context)
(dptr 'cu-device-ptr))
- (check-cuda-errors (cu-device-get device dev-id))
- (check-cuda-errors (cu-ctx-create pctx flags
- (cffi:mem-ref device 'cu-device)))
- (check-cuda-errors (cu-mem-alloc dptr 1024))
- (format t "a CUDA memory block is allocated.~%")
- (check-cuda-errors (cu-mem-free (cffi:mem-ref dptr 'cu-device-ptr)))
- (format t "a CUDA memory block is freed.~%")
- (check-cuda-errors (cu-ctx-destroy (cffi:mem-ref pctx 'cu-context)))))
+ (cu-device-get device dev-id)
+ (cu-ctx-create pctx flags (cffi:mem-ref device 'cu-device))
+ (cu-mem-alloc dptr 1024)
+ (cu-mem-free (cffi:mem-ref dptr 'cu-device-ptr))
+ (cu-ctx-destroy (cffi:mem-ref pctx 'cu-context))))
;;; test cuMemAlloc/cuMemFree using with-cuda-context
+(diag "test cuMemAlloc/cuMemFree using with-cuda-context")
(let ((dev-id 0))
(with-cuda-context (dev-id)
(cffi:with-foreign-object (dptr 'cu-device-ptr)
- (check-cuda-errors (cu-mem-alloc dptr 1024))
- (format t "a CUDA memory block is allocated.~%")
- (check-cuda-errors (cu-mem-free (cffi:mem-ref dptr 'cu-device-ptr)))
- (format t "a CUDA memory block is freed.~%"))))
+ (cu-mem-alloc dptr 1024)
+ (cu-mem-free (cffi:mem-ref dptr 'cu-device-ptr)))))
;;; test cuMemAlloc/cuMemFree using with-cuda-context and with-cuda-mem-block
+(diag "test cuMemAlloc/cuMemFree using with-cuda-context and with-cuda-mem-block")
(let ((dev-id 0))
(with-cuda-context (dev-id)
- (with-cuda-memory-block (dptr 1024)
- (format t "a CUDA memory block is allocated.~%"))))
+ (with-cuda-memory-block (dptr 1024))))
;;; test cuMemAlloc/cuMemFree using with-cuda-context and with-cuda-mem-blocks
+(diag "test cuMemAlloc/cuMemFree using with-cuda-context and with-cuda-mem-blocks")
(let ((dev-id 0))
(with-cuda-context (dev-id)
(with-cuda-memory-blocks ((dptr1 1024)
- (dptr2 1024))
- (format t "two CUDA memory blocks are allocated.~%"))))
+ (dptr2 1024)))))
;;; test cuMemcpyHtoD/cuMemcpyDtoH
+(diag "test cuMemcpyHtoD/cuMemcpyDtoH")
(let ((dev-id 0)
(size 1024))
(with-cuda-context (dev-id)
(cffi:with-foreign-object (hptr :float size)
(with-cuda-memory-block (dptr size)
- (check-cuda-errors
- (cu-memcpy-host-to-device (cffi:mem-ref dptr 'cu-device-ptr)
- hptr size))
- (format t "a CUDA memory block is copied from host to device.~%")
- (check-cuda-errors
- (cu-memcpy-device-to-host hptr
- (cffi:mem-ref dptr 'cu-device-ptr) size))
- (format t "a CUDA memory block is copied from device to host.~%")))))
+ (cu-memcpy-host-to-device (cffi:mem-ref dptr 'cu-device-ptr) hptr size)
+ (cu-memcpy-device-to-host hptr (cffi:mem-ref dptr 'cu-device-ptr) size)))))
;;; test cuModuleLoad
+(diag "test cuModuleLoad")
(let ((dev-id 0))
(cffi:with-foreign-string (fname "/Developer/GPU Computing/C/src/vectorAddDrv/data/vectorAdd_kernel.ptx")
(with-cuda-context (dev-id)
(cffi:with-foreign-object (module 'cu-module)
- (check-cuda-errors (cu-module-load module fname))
+ (cu-module-load module fname)
(format t "CUDA module \"vectorAdd_kernel.ptx\" is loaded.~%")))))
;;; test cuModuleGetFunction
+(diag "test cuModuleGetFunction")
(let ((dev-id 0))
(cffi:with-foreign-string (fname "/Developer/GPU Computing/C/src/vectorAddDrv/data/vectorAdd_kernel.ptx")
(cffi:with-foreign-string (name "VecAdd_kernel")
(with-cuda-context (dev-id)
(cffi:with-foreign-objects ((module 'cu-module)
(hfunc 'cu-function))
- (check-cuda-errors (cu-module-load module fname))
- (check-cuda-errors
- (cu-module-get-function hfunc
- (cffi:mem-ref module 'cu-module)
- name))
- (format t "CUDA function \"VecAdd_kernel\" is loaded.~%"))))))
+ (cu-module-load module fname)
+ (cu-module-get-function hfunc (cffi:mem-ref module 'cu-module) name))))))
;;; test cuLaunchKernel
@@ -182,31 +172,23 @@
(d-c size))
(random-init h-a n)
(random-init h-b n)
- (check-cuda-errors
- (cu-memcpy-host-to-device (cffi:mem-ref d-a 'cu-device-ptr)
- h-a size))
- (check-cuda-errors
- (cu-memcpy-host-to-device (cffi:mem-ref d-b 'cu-device-ptr)
- h-b size))
+ (cu-memcpy-host-to-device (cffi:mem-ref d-a 'cu-device-ptr) h-a size)
+ (cu-memcpy-host-to-device (cffi:mem-ref d-b 'cu-device-ptr) h-b size)
(vec-add-kernel d-a d-b d-c n
:grid-dim (list blocks-per-grid 1 1)
:block-dim (list threads-per-block 1 1))
- (format t "CUDA function \"vec_add_kernel\" is launched.~%")
- (check-cuda-errors
- (cu-memcpy-device-to-host h-c
- (cffi:mem-ref d-c 'cu-device-ptr)
- size))
+ (cu-memcpy-device-to-host h-c (cffi:mem-ref d-c 'cu-device-ptr) size)
(verify-result h-a h-b h-c n)))))
-(defkernel test-let1 (void ())
+(defkernel let1 (void ())
(let ((i 0))
(return))
(let ((i 0))))
-(defun test-test-let1 ()
+(defun test-let1 ()
(let ((dev-id 0))
(with-cuda-context (dev-id)
- (test-let1 :grid-dim (list 1 1 1)
+ (let1 :grid-dim (list 1 1 1)
:block-dim (list 1 1 1)))))
(defkernel use-one (void ())
Please sign in to comment.
Something went wrong with that request. Please try again.