anchor.diff:  ;;; Definition of Memory Block
   ;;;
   
  +(defstruct memory-block-cuda
  +  cffi-ptr device-ptr type length)
  +
  +(defstruct memory-block-interop
  +  cffi-ptr vertex-buffer-object graphic-resource-ptr type length)
  +
   (defun alloc-memory-block-cuda (type n)
  -  (let ((cffi-ptr   (cffi:foreign-alloc (cffi-type type) :count n))
  -        (device-ptr (cffi:foreign-alloc 'cu-device-ptr)))
  -    (cu-mem-alloc device-ptr (* n (type-size type)))
  -    (list :cuda cffi-ptr device-ptr type n)))
  +  (let ((blk (make-memory-block-cuda)))
  +    (symbol-macrolet ((cffi-ptr   (memory-block-cuda-cffi-ptr   blk))
  +                      (device-ptr (memory-block-cuda-device-ptr blk))
  +                      (blk-type   (memory-block-cuda-type       blk))
  +                      (length     (memory-block-cuda-length     blk)))
  +      (unwind-protect-case ()
  +          (progn
  +            ;; allocate a memory block
  +            (setf cffi-ptr   (cffi:foreign-alloc (cffi-type type) :count n)
  +                  device-ptr (cffi:foreign-alloc 'cu-device-ptr :initial-element 0)
  +                  blk-type   type
  +                  length     n)
  +            ;; allocate device memory
  +            (cu-mem-alloc (memory-block-cuda-device-ptr blk) (* n (type-size type)))
  +            ;; return a memory block
  +            blk)
  +        (:abort (free-memory-block-cuda blk))))))
   
   (defun alloc-memory-block-interop (type n)
  -  (let* ((cffi-ptr (cffi:foreign-alloc (cffi-type type) :count n))
  -         (vbo      (car (gl:gen-buffers 1)))
  -         (gres-ptr (cffi:foreign-alloc 'cu-graphics-resource)))
  -    ;; create and initialize a buffer object's data store
  -    (gl:bind-buffer :array-buffer vbo)
  -    (let ((ary (gl:alloc-gl-array (cffi-type type) n)))
  -      (unwind-protect (gl:buffer-data :array-buffer :dynamic-draw ary)
  -        (gl:free-gl-array ary)))
  -    (gl:bind-buffer :array-buffer 0)
  -    ;; register a buffer object accessed through CUDA
  -    (cu-graphics-gl-register-buffer gres-ptr vbo cu-graphics-register-flags-none)
  -    (list :interop cffi-ptr vbo gres-ptr type n)))
  +  (let ((blk (make-memory-block-interop)))
  +    (symbol-macrolet ((cffi-ptr (memory-block-interop-cffi-ptr             blk))
  +                      (vbo      (memory-block-interop-vertex-buffer-object blk))
  +                      (gres-ptr (memory-block-interop-graphic-resource-ptr blk))
  +                      (blk-type (memory-block-interop-type                 blk))
  +                      (length   (memory-block-interop-length               blk)))
  +      (unwind-protect-case ()
  +          (progn
  +            ;; allocate memory area
  +            (setf cffi-ptr (cffi:foreign-alloc (cffi-type type) :count n)
  +                  vbo      (car (gl:gen-buffers 1))
  +                  gres-ptr (cffi:foreign-alloc 'cu-graphics-resource :initial-element (cffi:null-pointer))
  +                  blk-type type
  +                  length   n)
  +            ;; create and initialize a buffer object's data store
  +            (gl:bind-buffer :array-buffer vbo)
  +            (let ((ary (gl:alloc-gl-array (cffi-type type) n)))
  +              (unwind-protect (gl:buffer-data :array-buffer :dynamic-draw ary)
  +                (gl:free-gl-array ary)))
  +            (gl:bind-buffer :array-buffer 0)
  +            ;; register a buffer object accessed through CUDA
  +            (cu-graphics-gl-register-buffer gres-ptr vbo cu-graphics-register-flags-none)
  +            ;; return a memory block
  +            blk)
  +        (:abort (free-memory-block-interop blk))))))
   
   (defun alloc-memory-block (type n &key (interop nil))
     (unless (non-pointer-type-p type)
  
positive.code: 
  ;;; Timer
  
  (defun make-timer-object (start-event stop-event)
    (cons start-event stop-event))
  
  (defun timer-object-start-event (timer-object)
    (car timer-object))
  
  (defun (setf timer-object-start-event) (val timer-object)
    (setf (car timer-object) val))
  
  (defun timer-object-stop-event (timer-object)
    (cdr timer-object))
  
  (defun (setf timer-object-stop-event) (val timer-object)
    (setf (cdr timer-object) val))
  
  (defun create-timer ()
    (let ((start-event (cffi:foreign-alloc 'cu-event))
          (stop-event  (cffi:foreign-alloc 'cu-event)))
      (cu-event-create start-event cu-event-default)
      (cu-event-create stop-event  cu-event-default)
      (make-timer-object start-event stop-event)))
  
  (defun destroy-timer (timer-object)
    (let ((start-event (timer-object-start-event timer-object))
          (stop-event  (timer-object-stop-event  timer-object)))
      (cu-event-destroy (cffi:mem-ref start-event 'cu-event))
      (cu-event-destroy (cffi:mem-ref stop-event 'cu-event))
      (cffi:foreign-free start-event)
      (cffi:foreign-free stop-event)
      (setf (timer-object-start-event timer-object) (cffi:null-pointer)
            (timer-object-stop-event  timer-object) (cffi:null-pointer))))
  
  (defmacro with-timer ((timer)&body body)
    `(progn
       (let (,timer)
         (setf ,timer (create-timer))
         (unwind-protect (progn ,@body)
           (destroy-timer ,timer)))))
  
  (defun start-timer (timer-object)
    (let ((start-event (timer-object-start-event timer-object)))
  
negative.code: (let (device context)
    
    (defun init-cuda-context (dev-id &key (interop nil))
      (when (or device context)
        (error "CUDA context is already initialized"))
      (unwind-protect-case ()
          (let ((flags 0))
            ;; allocate memory areas for a CUDA device and a CUDA context
            (setf device  (cffi:foreign-alloc 'cu-device  :initial-element 0)
                  context (cffi:foreign-alloc 'cu-context :initial-element (cffi:null-pointer)))
            ;; initialized CUDA
            (cu-init 0)
            ;; get a CUDA device
            (cu-device-get device dev-id)
            ;; create a CUDA context
            (if (not interop)
                (cu-ctx-create    context flags (cffi:mem-ref device 'cu-device))
                (cu-gl-ctx-create context flags (cffi:mem-ref device 'cu-device))))
        (:abort (release-cuda-context))))
    
    (defun release-cuda-context ()
      (symbol-macrolet ((mem-ref-context (cffi:mem-ref context 'cu-context)))
        ;; unload kernel manager
        (kernel-manager-unload *kernel-manager*)
        ;; destroy a CUDA context if created
        (when (and context (not (cffi:null-pointer-p mem-ref-context)))
          (cu-ctx-destroy mem-ref-context)
          (setf mem-ref-context (cffi:null-pointer)))
        ;; free a memory pointer to a CUDA context if allocated
        (when context
          (cffi:foreign-free context)
          (setf context nil))
        ;; free a memory area for a CUDA device if allocated
        (when device
          (cffi:foreign-free device)
          (setf device nil))))
    
    (defun synchronize-context ()
      (cu-ctx-synchronize)))
  