[Matlisp-commit] [matlisp-git]matlisp branch matlisp-cffi updated. 2012-02-23-80-g21d8ce7

[Raymond T. <rt...@us...>]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".

The branch, matlisp-cffi has been updated
       via  21d8ce7bad4335a01727786b8114af348c31d3c9 (commit)
      from  45e57ae1f888c8c271a91d42b9231b99bd55691e (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 21d8ce7bad4335a01727786b8114af348c31d3c9
Author: Raymond Toy <toy...@gm...>
Date:   Fri Mar 30 19:36:29 2012 -0700

    Add WITH-FORTRAN-MATRICES to make it a little easier to deal with
    Fortran arrays in callback functions.

diff --git a/src/utilities.lisp b/src/utilities.lisp
index 5bf4237..bbd8ad2 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -225,4 +225,80 @@ else run else-body"
    (unless (< -1 n ss)
      (error "Index N out of bounds."))
    (setf (cffi:mem-aref sap sty n) value)))
+
+
+;;; Rudimentary support for making it a bit easier to deal with Fortran
+;;; arrays in callbacks.
+
+;; If the Array dimensions are (d1, d2, d3, ...)
+;;
+;; Then x(n1, n2, n3, ...) means the index is, essentially,
+;;
+;; n1 + d1*(n2 + d2*(n3 + d3*(n4 + d4*(n5))))
 ;;
+;; Return an expression that computes the column major index given the
+;; indices (a list) and a list of the bounds on each dimension.  Each
+;; bound is a list of the upper and lower bounds for each dimension.
+;; For example, for the Fortran array declared as x(3:10, -4:2), the
+;; bounds would be written as ((3 10) (-4 2)).  If the lower bound is
+;; the default of 1, you can omit the lower bound.
+(defun col-major-index (indices dims)
+  ;; Return a form that computes the column major index of a Fortran array.
+  (flet ((get-offset (n bound)
+	   (let ((lo (first bound)))
+	     (if (and (numberp lo) (zerop lo))
+		 n
+		 `(the fixnum (- (the fixnum ,n) (the fixnum ,lo))))))
+	 (get-size (bound)
+	   (destructuring-bind (lo hi)
+	       bound
+	     (cond ((numberp lo)
+		    (cond ((numberp hi)
+			   (1+ (- hi lo)))
+			  ((= lo 1)
+			   hi)
+			  (t
+			   `(- ,hi ,(- lo 1)))))
+		   (t
+		    `(the fixnum (- ,hi (the fixnum (- (the fixnum ,lo) 1)))))))))
+    (let* ((rev-idx (reverse indices))
+	   (rev-dim (reverse dims))
+	   (idx (get-offset (first rev-idx) (first rev-dim))))
+      (do ((d (rest rev-dim) (rest d))
+	   (n (rest rev-idx) (rest n)))
+	  ((endp d)
+	   idx)
+	(setf idx `(the fixnum (+ ,(get-offset (first n) (first d))
+				  (the fixnum (* ,(get-size (first d)) ,idx)))))))))
+
+(defmacro with-fortran-matrix ((name fv &rest dims) &body body)
+  (let ((indices (gensym (symbol-name '#:indices-))))
+    `(macrolet ((,name (&rest ,indices)
+		  `(fv-ref ,',fv ,(col-major-index ,indices ',dims))))
+       ,@body)))
+
+;; WITH-FORTRAN-MATRICES is a convenience macro for accessing Fortran
+;; arrays that have been passed in as parameters of a callback.
+;;
+;; For example, Fortran callback function that might be
+;;
+;;   subroutine sub(z, f)
+;;   real z(4), df(2, 4)
+;;   df(1,4) = 3*z(2)
+;;   end
+;;
+;; This can be written in a Lisp call back as
+;;
+;;   (defun fsub (z-arg f-arg)
+;;     (with-fortran-matrices ((z z-arg (1 4))
+;;                             (f f-arg ((1 2) (1 4))))
+;;       (setf (f 1 4) (* 3 (z 2)))))
+;;
+
+(defmacro with-fortran-matrices ((&rest array-list) &body body)
+  (if (cdr array-list)
+      `(with-fortran-matrix ,(car array-list)
+	 (with-fortran-matrices ,(cdr array-list)
+	   ,@body))
+      `(with-fortran-matrix ,(car array-list)
+	 ,@body)))
\ No newline at end of file

-----------------------------------------------------------------------

Summary of changes:
 src/utilities.lisp |   76 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 76 insertions(+), 0 deletions(-)


hooks/post-receive
-- 
matlisp