Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add macros for auto-dereferencing buffers on unwind.

  • Loading branch information...
commit 52520e1b97316c68b43e5071858ff9f89886cc5b 1 parent d5122e8
@angavrilov authored
Showing with 25 additions and 10 deletions.
  1. +16 −0 core/buffers.lisp
  2. +9 −10 test/buffers.lisp
View
16 core/buffers.lisp
@@ -35,6 +35,7 @@
(def (generic e) deref-buffer (buffer)
(:documentation "Decrease the reference count on the buffer. Returns post-value of buffer-refcnt.")
(:method ((buffer t)) t)
+ (:method :around ((buffer null)) nil)
(:method :around ((buffer t))
(let ((cnt (buffer-refcnt buffer)))
(if (and (numberp cnt) (> cnt 0))
@@ -43,6 +44,21 @@
(if (> cnt 1) (1- cnt) nil))
cnt))))
+(def (macro e) with-deref-buffer ((var buffer-expr) &body code)
+ (with-unique-names (tmp)
+ `(let (,tmp)
+ (unwind-protect
+ (let ((,var (setf ,tmp ,buffer-expr)))
+ ,@code)
+ (deref-buffer ,tmp)))))
+
+(def (macro e) with-deref-buffers (bindings &body code)
+ (if (null (cdr bindings))
+ `(with-deref-buffer ,(car bindings) ,@code)
+ `(with-deref-buffer ,(car bindings)
+ (with-deref-buffers ,(cdr bindings)
+ ,@code))))
+
(def (generic e) buffer-displace (buffer &key
offset byte-offset ; Offset in elements of the original
element-type foreign-type ; May not always be supported
View
19 test/buffers.lisp
@@ -128,16 +128,15 @@
(defvar *foreign-arr4*)
(def fixture foreign-arrs
- (setf *foreign-arr1* (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
- (setf *foreign-arr2* (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
- (setf *foreign-arr3* (make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
- (setf *foreign-arr4* (make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
- (unwind-protect
- (-body-)
- (deref-buffer *foreign-arr1*)
- (deref-buffer *foreign-arr2*)
- (deref-buffer *foreign-arr3*)
- (deref-buffer *foreign-arr4*)))
+ (with-deref-buffers ((*foreign-arr1*
+ (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
+ (*foreign-arr2*
+ (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
+ (*foreign-arr3*
+ (make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
+ (*foreign-arr4*
+ (make-foreign-array 25 :element-type 'single-float :initial-element 0.0)))
+ (-body-)))
(def test test/buffers/foreign ()
(with-fixture foreign-arrs
Please sign in to comment.
Something went wrong with that request. Please try again.