Commit 9bf385d1 authored by Liam Healy's avatar Liam Healy

Method #'cl-array for pointers (gsl-vector-c doubles)

Define '+foreign-pointer-class+ to be the class name for foreign
pointers, which will be assumed to be GSL vectors or matrix pointers.
Use in new method #'cl-array to return a CL array from a pure GSL
vector double pointer, such as is returned by several functions in
solve-minimize-fit.
parent 1243f6e7
;; Data using ffa
;; Liam Healy 2008-04-06 21:23:41EDT data-ffa.lisp
;; Time-stamp: <2008-08-23 17:42:15EDT data.lisp>
;; Time-stamp: <2008-08-23 23:09:12EDT data.lisp>
;; $Id$
(in-package :gsl)
......@@ -41,6 +41,8 @@
"A superclass for all data storage structures, such as vector, matrix,
etc."))
(export '(cl-array dimensions total-size element-type))
(defmethod print-object ((object gsl-data) stream)
(print-unreadable-object (object stream :type t)
(copy-c-to-cl object)
......@@ -306,9 +308,8 @@
;;; It is necessary to have access to elements from the GSL
;;; vector/matrix pointers for things like callback functions in
;;; solve-minimize-fit and in #'make-vector-from-gsl.
(defmfun maref ((pointer #.(class-name (class-of (cffi:null-pointer))))
index &optional index2)
;;; solve-minimize-fit and in #'cl-array method for pointers.
(defmfun maref ((pointer #.+foreign-pointer-class+) index &optional index2)
;; If passed a pointer, assume that it is a GSL vector or matrix,
;; depending on the number of indices. This is useful in the
;; callback functions for solve-minimize-fit.
......@@ -319,8 +320,7 @@
:c-return :double)
(defmfun (setf maref)
(value (pointer #.(class-name (class-of (cffi:null-pointer))))
index &optional index2)
(value (pointer #.+foreign-pointer-class+) index &optional index2)
;; If passed a pointer, assume that it is a GSL vector or matrix,
;; depending on the number of indices. This is useful in the
;; callback functions for solve-minimize-fit.
......
;; Vectors
;; Liam Healy 2008-04-13 09:39:02EDT vector-ffa.lisp
;; Time-stamp: <2008-08-23 17:51:33EDT vector.lisp>
;; Time-stamp: <2008-08-23 22:54:06EDT vector.lisp>
;; $Id$
(in-package :gsl)
......@@ -36,23 +36,13 @@
;;; data; because GSL is doing the mallocing, the data are not
;;; CL-accessible.
(defmfun free-vector (pointer)
"gsl_vector_free"
((pointer :pointer))
:index nil
:export nil
:c-return :void)
(defun make-vector-from-gsl (pointer)
(defmethod cl-array ((pointer #.+foreign-pointer-class+))
"Given a C pointer to a GSL vector, make the CL object."
(let* ((size (cffi:foreign-slot-value pointer 'gsl-vector-c 'size))
(array (make-array* size 'double-float)))
;; Copy over from the C side
(loop for i below size
do (setf (aref array i) (maref pointer i)))
;; Free the C/GSL vector
(free-vector pointer)
;; Return the CL array
array))
;;;;****************************************************************************
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-03-23 17:49:12EDT gsl-objects.lisp>
;; Time-stamp: <2008-08-23 22:51:33EDT gsl-objects.lisp>
;; $Id$
(in-package :gsl)
......@@ -118,49 +118,7 @@
(lambda (,symb)
`(,',set ,,symb ,,@(subseq (rest form) num-alloc-args))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;OBSOLETE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Old form
(defmacro letm-obsolete (bindings &body body)
"A macro to bind variables to GSL objects, possibly setting
initial values, and freeing them when done. The binding is as
in a let*; any bindings for non-GSL objects are done as in
a let*."
(let* (setters ; save setting forms
freers ; save freeing forms
assigns ; save global assignements
(*not-for-users* t))
;; Rewrite the bindings with allocators and push them on assigns
(dolist (b bindings)
(if (atom b)
(push b assigns)
(let ((defsymb (first b)) (defas (second b)))
(if (and (listp b) (listp defas)
(member (first defas) *letm-expanded-object*))
;; It is a GSL object
(destructuring-bind (allocator freer &optional setter assign)
(apply (first defas) (rest defas))
;; If there's a setting function, save the form
(when setter (push (funcall setter defsymb) setters))
;; Save the freeing form
(push `(,freer ,defsymb) freers)
;; Save the global assignments
(when assign (push (funcall assign) assigns))
;; Return the allocation form to be used in let
(push `(,defsymb ,allocator) assigns))
;; Not a GSL object, just define it with let
(push b assigns)))))
(if freers
;; There were GSL objects
`(let* (,@(reverse assigns))
;; put the body in an unwind-protect
(unwind-protect
(progn
,@(reverse setters) ; setting the objects
,@body)
,@freers)) ; freeing the objects
;; No GSL objects in the bindings, just make an ordinary let
`(let* (,@bindings) ,@body))))
;;; Pointer type
(defconstant +foreign-pointer-class+ (class-name (class-of (cffi:null-pointer)))
"The class in which foreign pointers fall. This will be assumed to be a
GSL vector or matrix.")
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment