diff --git a/data/both.lisp b/data/both.lisp index 59b119a15c8f6db9621a5265154fad13b271e2d6..9559ad1224c142a895693cc59b64a8fe30f9f287 100644 --- a/data/both.lisp +++ b/data/both.lisp @@ -1,6 +1,6 @@ ;; Functions for both vectors and matrices. ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp -;; Time-stamp: <2010-07-12 12:45:15EDT both.lisp> +;; Time-stamp: <2010-07-13 21:46:11EDT both.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -78,10 +78,16 @@ "Exchange the elements of a and b by copying. The two must have the same dimensions.") -;;; For matrix functions, there should be another index argument -(defmfun get-value ((class-name (eql vector)) mpointer index) +;;;;**************************************************************************** +;;;; Array elements; used in callbacks scalarsp=T only +;;;;**************************************************************************** +;;; Normal foreign array access is with grid:gref, but in order to +;;; avoid the overhead of instantiating a foreign-array object to +;;; access components, we use these functions. + +(defmfun get-value ((class-name (eql vector)) mpointer &rest indices) ("gsl_" :category :type "_get") - ((mpointer :pointer) (index sizet)) + ((mpointer :pointer) ((first indices) sizet)) :definition :generic :c-return :element-c-type :export nil @@ -89,10 +95,20 @@ "Get the single element of the GSL vector. This is used in callbacks.") +(defmfun get-value ((class-name (eql matrix)) mpointer &rest indices) + ("gsl_" :category :type "_get") + ((mpointer :pointer) ((first indices) sizet) ((second indices) sizet)) + :definition :methods + :c-return :element-c-type + :export nil + :documentation + "Get the single element of the GSL matrix. This is used + in callbacks.") + (defmfun (setf get-value) - (value (class-name (eql vector)) mpointer index) + (value (class-name (eql vector)) mpointer &rest indices) ("gsl_" :category :type "_set") - ((value :element-c-type) (mpointer :pointer) (index sizet)) + ((value :element-c-type) (mpointer :pointer) ((first indices) sizet)) :definition :generic :element-types #+fsbv t #-fsbv :no-complex :c-return :void @@ -102,6 +118,20 @@ "Set the single element of the GSL vector to the value. This is used in callbacks.") +(defmfun (setf get-value) + (value (class-name (eql matrix)) mpointer &rest indices) + ("gsl_" :category :type "_set") + ((value :element-c-type) (mpointer :pointer) + ((first indices) sizet) ((second indices) sizet)) + :definition :methods + :element-types #+fsbv t #-fsbv :no-complex + :c-return :void + :return (value) + :export nil + :documentation + "Set the single element of the GSL vector to the value. This is + used in callbacks.") + ;;;;**************************************************************************** ;;;; Elementwise arithmetic operations overwriting an array ;;;;**************************************************************************** diff --git a/init/forms.lisp b/init/forms.lisp index da7977321d93fec3d383582eceb2364f197eb6de..f72054e44a2d53a69ee0de1cf844d24175595398 100644 --- a/init/forms.lisp +++ b/init/forms.lisp @@ -1,6 +1,6 @@ ;; Lisp forms ;; Liam Healy 2009-03-07 15:49:25EST forms.lisp -;; Time-stamp: <2010-07-12 12:28:48EDT forms.lisp> +;; Time-stamp: <2010-07-13 22:32:44EDT forms.lisp> ;; ;; Copyright 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -24,7 +24,7 @@ ;;;; Arglists ;;;;**************************************************************************** -(defparameter *defmfun-llk* '(&optional &key &aux) +(defparameter *defmfun-llk* '(&optional &key &aux &rest) "Possible lambda-list keywords.") (defparameter *defmfun-optk* '(&optional &key) diff --git a/init/funcallable.lisp b/init/funcallable.lisp index 308c48706a17e1eeca21c1ec604c6a87125cc6e9..a24e66f4ae08e7f2387e45b6c729ac7b9e295eca 100644 --- a/init/funcallable.lisp +++ b/init/funcallable.lisp @@ -1,6 +1,6 @@ ;; Generate a lambda that calls the user function; will be called by callback. ;; Liam Healy -;; Time-stamp: <2010-07-13 21:05:37EDT funcallable.lisp> +;; Time-stamp: <2010-07-13 21:59:01EDT funcallable.lisp> ;; ;; Copyright 2009, 2010 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -76,7 +76,8 @@ ,ptr ',(parse-callback-argspec argspec 'dimensions) ',(grid:cffi-cl (parse-callback-argspec argspec 'element-type)) - nil)))) + nil)) + ((nil) ptr))) ;;;;**************************************************************************** ;;;; Reference foreign elements and make multiple-value-bind form @@ -93,7 +94,9 @@ (length (value-from-dimensions argspec dimension-values)) (grid:cffi-cl (parse-callback-argspec argspec 'element-type))) ,foreign-variable-name - ,linear-index) + ,@(affi::delinearize-index + (affi:make-affi (value-from-dimensions argspec dimension-values)) + linear-index)) `(cffi:mem-aref ,foreign-variable-name ',(parse-callback-argspec argspec 'element-type) diff --git a/tests/combination.lisp b/tests/combination.lisp index 0958580f3c1126bdba9cdfc28969884b73639cc7..d767ec03b28b6be8d547d64a864e4e00327fe0e1 100644 --- a/tests/combination.lisp +++ b/tests/combination.lisp @@ -52,6 +52,5 @@ (LOOP FOR I FROM 0 TO 4 APPEND (LET ((COMB (MAKE-COMBINATION 4 I))) (INIT-FIRST COMB) - (LOOP COLLECT (COPY-SEQ (GRID:COPY-TO COMB)) WHILE + (LOOP COLLECT (grid:contents comb) WHILE (COMBINATION-NEXT COMB))))))) - diff --git a/tests/lu.lisp b/tests/lu.lisp index e96bb178944bcbe800a5245cc4fc6547741d1975..2fd3573c78065b3c40cd4993f06f87fcdd32f400 100644 --- a/tests/lu.lisp +++ b/tests/lu.lisp @@ -139,4 +139,4 @@ (INVERT-MATRIX (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :DIMENSIONS '(2 2) :INITIAL-CONTENTS - '(1.0d0 2.0d0 3.0d0 4.0d0))))))) + '((1.0d0 2.0d0) (3.0d0 4.0d0)))))))) diff --git a/tests/row.lisp b/tests/row.lisp index d59e66ccc87d4bdca205dc687048721b3df84cec..abda2bbb8deafbe8ddf34699e71e14d32cc86a46 100644 --- a/tests/row.lisp +++ b/tests/row.lisp @@ -79,7 +79,7 @@ (LET ((M1 (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 8) - :INITIAL-CONTETS + :INITIAL-CONTENTS '((-64 -68 71) (-91 52 -10) (73 -5 123)))) @@ -131,7 +131,7 @@ (LET ((M1 (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTETS + :INITIAL-CONTENTS '((-64 -68 71) (-91 52 -10) (73 -5 123))))