Commit 78b25a17 authored by Liam Healy's avatar Liam Healy

New function #'make-foreign-array-from-gsl-pointer untested

New function #'make-foreign-array-from-gsl-pointer allows construction
of a foreign-array with the appropriate metadata when given the
mpointer.  It has not been tested.  Its main use will be in GSL
routines that create their own GSL vector (or matrix); previously
those were copied from the pointer, now they are just wrapped with the
appropriate GSLL object.  File renamed to "foreign-array.lisp" from
"marray.lisp".
parent bf01ac03
;; A "marray" is an array in both GSL and CL
;; A grid:foreign-array with added metadata for GSL.
;; Liam Healy 2008-04-06 21:23:41EDT
;; Time-stamp: <2010-06-26 23:04:25EDT marray.lisp>
;; Time-stamp: <2010-06-27 08:48:58EDT foreign-array.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -21,11 +21,9 @@
(in-package :gsl)
;;;;****************************************************************************
;;;; The class marray and its construction
;;;; Make the mpointer, block-pointer, total-size metadata
;;;;****************************************************************************
;;; Slots were mpointer, block-pointer, total-size
;;; We don't allocate or free the C array data, because that is
;;; handled by grid:foreign-array. We can use the GSL functions
;;; *_alloc_from_block because they will allocate only the structure,
......@@ -37,13 +35,16 @@
`(getf (foreign-metadata ,object) ,name))
(defun make-gsl-metadata (object)
;; Need to check that all allocations succeeded.
;; Don't do anything if mpointer has been assigned,
;; or this is a permutation or combination (they have their own methods).
"Make the necessary GSL metadata (mpointer and block-pointer)
for the given foreign array, and return the mpointer.
This should only be called by #'mpointer the first time
it is called on a particular foreign-array."
;; Don't do anything if mpointer has already been assigned.
(unless (metadata-slot object 'mpointer)
(when (zerop (total-size object))
(error "Object ~a has zero total dimension." object))
(let* ((blockptr (cffi:foreign-alloc 'gsl-block-c))
(let* ((blockptr (cffi:foreign-alloc 'gsl-block-c)) ; check this result
;; it is not clear what foreign-alloc does if the alloc fails.
(array-struct (alloc-from-block object blockptr)))
(setf (cffi:foreign-slot-value blockptr 'gsl-block-c 'size)
(grid:total-size object)
......@@ -60,11 +61,13 @@
(tg:finalize object
(lambda ()
(cffi:foreign-free blockptr)
(cffi:foreign-free array-struct))))))
(cffi:foreign-free array-struct))))
(metadata-slot object 'mpointer)))
(defmethod mpointer ((object grid:foreign-array))
(metadata-slot object 'mpointer)
(make-gsl-metadata object))
(or
(metadata-slot object 'mpointer)
(make-gsl-metadata object)))
;;;;****************************************************************************
;;;; Make data from either the dimensions provided or from the initial values
......@@ -86,7 +89,7 @@
keys)))
;;;;****************************************************************************
;;;; Copy to and from bare mpointers
;;;; Make from GSL mpointers
;;;;****************************************************************************
;; Some functions in solve-minimize-fit return a pointer to a GSL
......@@ -95,6 +98,28 @@
;; data even on native implementations; because GSL is doing the
;; mallocing, the data are not CL-accessible.
(defun make-foreign-array-from-mpointer
(mpointer &optional (element-type 'double-float) (category :vector))
"Make the foreign array when a GSL pointer to a
gsl-vector-c or gsl-matrix-c is given."
(let* ((cstruct
(case category
(:vector 'gsl-vector-c)
(:matrix 'gsl-matrix-c)
(t (error "Unrecognized category ~a" category))))
(c-pointer (cffi:foreign-slot-value mpointer cstruct 'data)))
(grid:make-grid
(case category
(:vector
`((foreign-array ,(cffi:foreign-slot-value mpointer cstruct size))
,element-type))
(:matrix
`((foreign-array
,(cffi:foreign-slot-value mpointer cstruct size0)
,(cffi:foreign-slot-value mpointer cstruct size1)))
,element-type))
:foreign-pointer c-pointer
:foreign-metadata mpointer)))
;;;;****************************************************************************
;;;; Convenient defaulting of defmfun arguments
......
;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <2009-12-27 10:05:32EST minimization-multi.lisp>
;; Time-stamp: <2010-06-27 08:39:24EDT minimization-multi.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -138,7 +138,7 @@
:definition :method
:callback-object minimizer
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The current best estimate of the location of the minimum.")
......@@ -148,7 +148,7 @@
:definition :method
:callback-object minimizer
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The current best estimate of the location of the minimum.")
......@@ -180,7 +180,7 @@
"gsl_multimin_fdfminimizer_gradient"
(((mpointer minimizer) :pointer))
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The current best estimate of the gradient for the minimizer.")
......
;; Nonlinear least squares fitting.
;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp
;; Time-stamp: <2010-04-25 22:13:58EDT nonlinear-least-squares.lisp>
;; Time-stamp: <2010-06-27 08:42:19EDT nonlinear-least-squares.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -119,7 +119,7 @@
(((mpointer solver) :pointer))
:definition :method
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The current best-fit parameters.")
......@@ -128,13 +128,13 @@
(((mpointer solver) :pointer))
:definition :method
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The current best-fit parameters.")
;;; Why doesn't GSL have functions to extract these values?
(defmethod function-value ((solver nonlinear-fdffit))
(copy
(make-foreign-array-from-mpointer
(cffi:foreign-slot-value (mpointer solver) 'gsl-fdffit-solver 'f)))
(defmethod last-step ((solver nonlinear-fdffit))
......
;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2009-12-27 10:05:32EST roots-multi.lisp>
;;; Time-stamp: <2010-06-27 08:44:26EDT roots-multi.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -147,7 +147,7 @@
:definition :method
:callback-object solver
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The current estimate of the root for the solver.")
......@@ -157,7 +157,7 @@
:definition :method
:callback-object solver
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation
"The current estimate of the root for the solver.")
......@@ -166,7 +166,7 @@
(((mpointer solver) :pointer))
:definition :method
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The function value f(x) at the current estimate x of the root for the solver.")
......@@ -175,7 +175,7 @@
(((mpointer solver) :pointer))
:definition :method
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The function value f(x) at the current estimate x of the root for the solver.")
......@@ -184,7 +184,7 @@
(((mpointer solver) :pointer))
:definition :method
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The last step dx taken by the solver.")
......@@ -193,7 +193,7 @@
(((mpointer solver) :pointer))
:definition :method
:c-return (crtn :pointer)
:return ((copy crtn))
:return ((make-foreign-array-from-mpointer crtn))
:documentation ; FDL
"The last step dx taken by the solver.")
......
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