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))