[cl-gsl-cvs] CVS update: cl-gsl/ffi.lisp

[cl-gsl-cvs at common-lisp.net]

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))
+              , at 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))
+              , at 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)))
+                , at 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))