Update of /project/cl-gsl/cvsroot/cl-gsl
In directory common-lisp.net:/tmp/cvs-serv29878
Modified Files:
ffi.lisp
Log Message:
Added macros which allocate, bind, and free foreign structures.
Date: Mon Apr 4 02:44:15 2005
Author: edenny
Index: cl-gsl/ffi.lisp
diff -u cl-gsl/ffi.lisp:1.3 cl-gsl/ffi.lisp:1.4
--- cl-gsl/ffi.lisp:1.3 Tue Mar 15 04:15:20 2005
+++ cl-gsl/ffi.lisp Mon Apr 4 02:44:15 2005
@@ -56,7 +56,8 @@
;; ----------------------------------------------------------------------
-;; TODO: size_t may not always be unsigned long, could also be unsigned int.
+;; TODO: size_t may not always be unsigned long, could also be unsigned int
+;; on some systems?
(define-foreign-type size-t :unsigned-long)
(def-foreign-struct gsl-complex
@@ -192,56 +193,76 @@
;; typedef long double * gsl_complex_packed_array_long_double ;
;; typedef long double * gsl_complex_packed_long_double_ptr ;
-;; typedef struct
-;; {
-;; long double dat[2];
-;; }
-;; gsl_complex_long_double;
-
;; ----------------------------------------------------------------------
(defun gsl-complex->complex (z-ptr)
- ;; TODO: this seems to work with pointers and values
-;; (declare (gsl-complex-def z))
+ "Copies the value of the foreign object pointed to by Z-PTR to a lisp object
+of type (complex (double-float)). Returns the lisp object."
(let ((dat-array (uffi:get-slot-value z-ptr '(:array :double) 'cl-gsl::dat)))
(complex (uffi:deref-array dat-array :double 0)
(uffi:deref-array dat-array :double 1))))
(defun gsl-complex-float->complex (z-ptr)
+ "Copies the value of the foreign object pointed to by Z-PTR to a lisp object
+of type (complex (single-float)). Returns the lisp object."
(let ((dat-array (uffi:get-slot-value z-ptr '(:array :float) 'cl-gsl::dat)))
(complex (uffi:deref-array dat-array :float 0)
(uffi:deref-array dat-array :float 1))))
-;; FIXME: this returns a pointer to a gsl-complex. Is this correct?
-;; How do we free it?
-;; Replace with a with-complex->gsl-complex macro that cleans up after
-;; itself
-(defun complex->gsl-complex-ptr (z)
- (let* ((z-ptr (uffi:allocate-foreign-object 'gsl-complex))
- (dat-array (uffi:get-slot-value z-ptr '(:array :double) 'cl-gsl::dat)))
- (setf (uffi:deref-array dat-array :double 0) (realpart z))
- (setf (uffi:deref-array dat-array :double 1) (imagpart z))
- z-ptr))
-
-;; FIXME: see above
-(defun complex->gsl-complex-float-ptr (z)
- (let* ((z-ptr (uffi:allocate-foreign-object 'gsl-complex-float))
- (dat-array (uffi:get-slot-value z-ptr '(:array :float) 'cl-gsl::dat)))
- (setf (uffi:deref-array dat-array :float 0) (realpart z))
- (setf (uffi:deref-array dat-array :float 1) (imagpart z))
- z-ptr))
-
-
-;; TODO: generalize to all supported types?
-(defun lisp-vec->c-array (v)
- (declare (vector v))
- (let* ((len (length v))
- (c-ptr (uffi:allocate-foreign-object :double len)))
- (dotimes (i len)
- (setf (uffi:deref-array c-ptr :double i) (aref v i)))
- c-ptr))
-;; TODO: generalize to all supported types?
+(defmacro with-complex-double-float->gsl-complex-ptr ((c-ptr complex-val)
+ &body body)
+ "Copies the value of COMPLEX-VALUE, of type (complex (double-float)),
+to a newly created foreign object of type gsl_complex. C-PTR is a pointer
+to the foreign object. Returns the values of BODY and frees the memory
+allocated for the foreign object."
+ (let ((array (gensym)))
+ `(let* ((,c-ptr (uffi:allocate-foreign-object 'gsl-complex))
+ (,array (uffi:get-slot-value ,c-ptr
+ '(:array :double)
+ 'cl-gsl::dat)))
+ (unwind-protect
+ (progn
+ (setf (uffi:deref-array ,array :double 0) (realpart ,complex-val))
+ (setf (uffi:deref-array ,array :double 1) (imagpart ,complex-val))
+ ,@body)
+ (uffi:free-foreign-object ,c-ptr)))))
+
+
+(defmacro with-complex-single-float->gsl-complex-float-ptr ((c-ptr complex-val)
+ &body body)
+ "Copies the value of COMPLEX-VALUE, of type (complex (single-float)),
+to a newly created foreign object of type gsl_complex_float. C-PTR is a pointer
+to the foreign object. Returns the values of BODY and frees the memory
+allocated for the foreign object."
+ (let ((array (gensym)))
+ `(let* ((,c-ptr (uffi:allocate-foreign-object 'gsl-complex-float))
+ (,array (uffi:get-slot-value ,c-ptr
+ '(:array :float)
+ 'cl-gsl::dat)))
+ (unwind-protect
+ (progn
+ (setf (uffi:deref-array ,array :float 0) (realpart ,complex-val))
+ (setf (uffi:deref-array ,array :float 1) (imagpart ,complex-val))
+ ,@body)
+ (uffi:free-foreign-object ,c-ptr)))))
+
+
+(defmacro with-lisp-vec->c-array ((c-ptr lisp-vec) &body body)
+ (let ((len (gensym))
+ (i (gensym)))
+ `(progn
+ (let* ((,len (length ,lisp-vec))
+ (,c-ptr (uffi:allocate-foreign-object :double ,len)))
+ (unwind-protect
+ (progn
+ (dotimes (,i ,len)
+ (setf (uffi:deref-array ,c-ptr :double ,i)
+ (aref ,lisp-vec ,i)))
+ ,@body)
+ (uffi:free-foreign-object ,c-ptr))))))
+
+
(defun c-array->lisp-vec (c-ptr len)
(let ((lisp-vec (make-array len :element-type 'double-float)))
(dotimes (i len)
@@ -249,6 +270,9 @@
lisp-vec))
(defun complex-packed-array->lisp-vec (z-ptr len)
+ "Copies the complex values of a foreign array to a lisp array. Z-PTR is
+a pointer the the foreign array of length LEN. Returns a lisp array of
+complex elements, also of length LEN."
(declare (gsl-complex-packed-def z-ptr))
(let ((lisp-vec (make-array (/ len 2) :element-type 'complex)))
(dotimes (i (/ len 2))
