/[cl-gsl]/cl-gsl/ffi.lisp
ViewVC logotype

Diff of /cl-gsl/ffi.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by edenny, Tue Mar 15 03:15:20 2005 UTC revision 1.4 by edenny, Mon Apr 4 00:44:15 2005 UTC
# Line 56  Line 56 
56    
57  ;; ----------------------------------------------------------------------  ;; ----------------------------------------------------------------------
58    
59  ;; 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
60    ;; on some systems?
61  (define-foreign-type size-t :unsigned-long)  (define-foreign-type size-t :unsigned-long)
62    
63  (def-foreign-struct gsl-complex  (def-foreign-struct gsl-complex
# Line 192  Line 193 
193  ;; typedef long double *  gsl_complex_packed_array_long_double ;  ;; typedef long double *  gsl_complex_packed_array_long_double ;
194  ;; typedef long double *  gsl_complex_packed_long_double_ptr ;  ;; typedef long double *  gsl_complex_packed_long_double_ptr ;
195    
 ;; typedef struct  
 ;;   {  
 ;;     long double dat[2];  
 ;;   }  
 ;; gsl_complex_long_double;  
   
196  ;; ----------------------------------------------------------------------  ;; ----------------------------------------------------------------------
197    
198  (defun gsl-complex->complex (z-ptr)  (defun gsl-complex->complex (z-ptr)
199    ;; TODO: this seems to work with pointers and values    "Copies the value of the foreign object pointed to by Z-PTR to a lisp object
200  ;;  (declare (gsl-complex-def z))  of type (complex (double-float)). Returns the lisp object."
201    (let ((dat-array (uffi:get-slot-value z-ptr '(:array :double) 'cl-gsl::dat)))    (let ((dat-array (uffi:get-slot-value z-ptr '(:array :double) 'cl-gsl::dat)))
202      (complex (uffi:deref-array dat-array :double 0)      (complex (uffi:deref-array dat-array :double 0)
203               (uffi:deref-array dat-array :double 1))))               (uffi:deref-array dat-array :double 1))))
204    
205  (defun gsl-complex-float->complex (z-ptr)  (defun gsl-complex-float->complex (z-ptr)
206      "Copies the value of the foreign object pointed to by Z-PTR to a lisp object
207    of type (complex (single-float)). Returns the lisp object."
208    (let ((dat-array (uffi:get-slot-value z-ptr '(:array :float) 'cl-gsl::dat)))    (let ((dat-array (uffi:get-slot-value z-ptr '(:array :float) 'cl-gsl::dat)))
209      (complex (uffi:deref-array dat-array :float 0)      (complex (uffi:deref-array dat-array :float 0)
210               (uffi:deref-array dat-array :float 1))))               (uffi:deref-array dat-array :float 1))))
211    
 ;; 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))  
212    
213  ;; TODO: generalize to all supported types?  (defmacro with-complex-double-float->gsl-complex-ptr ((c-ptr complex-val)
214                                                          &body body)
215      "Copies the value of COMPLEX-VALUE, of type (complex (double-float)),
216    to a newly created foreign object of type gsl_complex. C-PTR is a pointer
217    to the foreign object. Returns the values of BODY and frees the memory
218    allocated for the foreign object."
219      (let ((array (gensym)))
220        `(let* ((,c-ptr (uffi:allocate-foreign-object 'gsl-complex))
221                (,array (uffi:get-slot-value ,c-ptr
222                                             '(:array :double)
223                                             'cl-gsl::dat)))
224           (unwind-protect
225                (progn
226                  (setf (uffi:deref-array ,array :double 0) (realpart ,complex-val))
227                  (setf (uffi:deref-array ,array :double 1) (imagpart ,complex-val))
228                  ,@body)
229             (uffi:free-foreign-object ,c-ptr)))))
230    
231    
232    (defmacro with-complex-single-float->gsl-complex-float-ptr ((c-ptr complex-val)
233                                                          &body body)
234      "Copies the value of COMPLEX-VALUE, of type (complex (single-float)),
235    to a newly created foreign object of type gsl_complex_float. C-PTR is a pointer
236    to the foreign object. Returns the values of BODY and frees the memory
237    allocated for the foreign object."
238      (let ((array (gensym)))
239        `(let* ((,c-ptr (uffi:allocate-foreign-object 'gsl-complex-float))
240                (,array (uffi:get-slot-value ,c-ptr
241                                             '(:array :float)
242                                             'cl-gsl::dat)))
243           (unwind-protect
244                (progn
245                  (setf (uffi:deref-array ,array :float 0) (realpart ,complex-val))
246                  (setf (uffi:deref-array ,array :float 1) (imagpart ,complex-val))
247                  ,@body)
248             (uffi:free-foreign-object ,c-ptr)))))
249    
250    
251    (defmacro with-lisp-vec->c-array ((c-ptr lisp-vec) &body body)
252      (let ((len (gensym))
253            (i (gensym)))
254        `(progn
255           (let* ((,len (length ,lisp-vec))
256                  (,c-ptr (uffi:allocate-foreign-object :double ,len)))
257             (unwind-protect
258                  (progn
259                    (dotimes (,i ,len)
260                      (setf (uffi:deref-array ,c-ptr :double ,i)
261                            (aref ,lisp-vec ,i)))
262                    ,@body)
263               (uffi:free-foreign-object ,c-ptr))))))
264    
265    
266  (defun c-array->lisp-vec (c-ptr len)  (defun c-array->lisp-vec (c-ptr len)
267    (let ((lisp-vec (make-array len :element-type 'double-float)))    (let ((lisp-vec (make-array len :element-type 'double-float)))
268      (dotimes (i len)      (dotimes (i len)
# Line 249  Line 270 
270      lisp-vec))      lisp-vec))
271    
272  (defun complex-packed-array->lisp-vec (z-ptr len)  (defun complex-packed-array->lisp-vec (z-ptr len)
273      "Copies the complex values of a foreign array to a lisp array. Z-PTR is
274    a pointer the the foreign array of length LEN. Returns a lisp array of
275    complex elements, also of length LEN."
276    (declare (gsl-complex-packed-def z-ptr))    (declare (gsl-complex-packed-def z-ptr))
277    (let ((lisp-vec (make-array (/ len 2) :element-type 'complex)))    (let ((lisp-vec (make-array (/ len 2) :element-type 'complex)))
278      (dotimes (i (/ len 2))      (dotimes (i (/ len 2))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5