Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-195-g0c9fe59
|
From: Akshay S. <ak...@us...> - 2013-01-27 09:09:18
|
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, tensor has been updated
via 0c9fe59c75989013c9154326a382abd22fc056f0 (commit)
from 23ae23fc820468a4dc5149850f7f85bd524ebd69 (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 0c9fe59c75989013c9154326a382abd22fc056f0
Author: Akshay Srinivasan <aks...@gm...>
Date: Sun Jan 27 01:03:01 2013 -0800
o Fixed callback issue. Callbacks are now declared once for each FFI.
o Added example to dlsode.lisp.
diff --git a/src/ffi/f77-ffi.lisp b/src/ffi/f77-ffi.lisp
index 301520e..1870a0d 100644
--- a/src/ffi/f77-ffi.lisp
+++ b/src/ffi/f77-ffi.lisp
@@ -59,7 +59,7 @@
;; Pass a pointer to the function.
(:callback :void)
(t (error 'unknown-token :token type
- :message "Don't know the given Fortran type."))))))
+ :message "Don't know the given Fortran type."))))))
(defun %f77.get-return-type (type)
"
@@ -68,7 +68,7 @@
(if (or (%f77.cast-as-array-p type) (%f77.callback-type-p type))
(error 'invalid-type :given type :expected '(not (or (%f77.cast-as-array-p type)
(%f77.callback-type-p type)))
- :message "A Fortran function cannot return the given type.")
+ :message "A Fortran function cannot return the given type.")
(%f77.cffi-type type)))
(definline %f77.output-p (style)
@@ -85,7 +85,7 @@
"
Get the input type to be passed to CFFI."
(assert (member style +ffi-styles+) nil 'unknown-token :token style
- :message "Don't know how to handle style.")
+ :message "Don't know how to handle style.")
(cond
;; Can't do much else if type is an array/complex or input is passed-by-value.
((or (%f77.callback-type-p type)
@@ -106,242 +106,248 @@
(let* ((aux-pars nil)
(new-pars
- (mapcar #'(lambda (decl)
- (destructuring-bind (name type &optional (style :input-reference)) decl
- (case type
- (:string
- ;; String lengths are appended to the function arguments,
- ;; passed by value.
- (nconsc aux-pars `((,(scat "LEN-" name) ,(%f77.cffi-type :integer))))
- `(,name ,(%f77.cffi-type :string)))
- (t
- `(,name ,(%f77.get-read-in-type type style))))))
- pars)))
+ (mapcar #'(lambda (decl)
+ (destructuring-bind (name type &optional (style :input-reference)) decl
+ (case type
+ (:string
+ ;; String lengths are appended to the function arguments,
+ ;; passed by value.
+ (nconsc aux-pars `((,(scat "LEN-" name) ,(%f77.cffi-type :integer))))
+ `(,name ,(%f77.cffi-type :string)))
+ (t
+ `(,name ,(%f77.get-read-in-type type style))))))
+ pars)))
`( ;; don't want documentation for direct interface, not useful
;; ,@doc
,@new-pars ,@aux-pars))))
;; Create a form specifying a simple Lisp function that calls the
-;; underlying Fortran routine of the same name.
-(defun %f77.def-fortran-interface (name return-type body hidden-var-name)
- (multiple-value-bind (doc pars)
- (parse-doc-&-parameters body)
- (let ((ffi-fn (make-fortran-ffi-name name))
- (return-vars nil)
- (array-vars nil)
- (ref-vars nil)
- (callback-code nil)
- ;;
- (defun-args nil)
- (defun-keyword-args nil)
- ;;
- (aux-args nil)
- ;;
- (ffi-args nil)
- (aux-ffi-args nil))
- (dolist (decl pars)
- (destructuring-bind (var type &optional style) decl
- (let ((ffi-var nil)
- (aux-var nil))
- (cond
- ;; Callbacks are tricky.
- ((%f77.callback-type-p type)
- (let* ((callback-name (gensym (symbol-name var)))
- (c-callback-code (%f77.def-fortran-callback var callback-name (second type) (cddr type))))
- (nconsc callback-code c-callback-code)
- (setq ffi-var `(cffi:callback ,callback-name))))
- ;; Can't really enforce "style" when given an array.
- ;; Complex numbers do not latch onto this case, they
- ;; are passed by value.
- ((%f77.array-p type)
- (setq ffi-var (scat "ADDR-" var))
- (nconsc array-vars `((,ffi-var ,var)))
- ;;
- (when-let (arg (getf type :inc))
- (nconsc defun-keyword-args
- `((,arg 0)))
- (nconc (car (last array-vars)) `(:inc-type ,(cadr type) :inc ,arg))))
- ;; Strings
- ((%f77.string-p type)
- (setq ffi-var var)
- (setq aux-var (scat "LEN-" var))
- (nconsc aux-args `((,aux-var (length (the string ,var))))))
- ;; Pass-by-value variables
- ((eq style :input-value)
- (setq ffi-var var))
- ;; Pass-by-reference variables
- (t
- (cond
- ;; Makes more sense to copy complex numbers into
- ;; arrays, rather than twiddling around with lisp
- ;; memory internals.
- ((member type '(:complex-single-float :complex-double-float))
- (setq ffi-var (scat "ADDR-REAL-CAST-" var))
- (nconsc ref-vars
- `((,ffi-var ,(second (%f77.cffi-type type)) :count 2 :initial-contents (list (realpart ,var) (imagpart ,var))))))
- (t
- (setq ffi-var (scat "REF-" var))
- (nconsc ref-vars
- `((,ffi-var ,(%f77.cffi-type type) :initial-element ,var)))))))
- ;; Output variables
- (when (and (%f77.output-p style) (not (eq type :string)))
- (nconsc return-vars
- `((,ffi-var ,var ,type))))
- ;; Arguments for the lisp wrapper
- (unless (eq var hidden-var-name)
- (nconsc defun-args
- `(,var)))
- ;; Arguments for the FFI function
- (nconsc ffi-args
- `(,ffi-var))
- ;; Auxillary arguments for FFI
- (unless (null aux-var)
- (nconsc aux-ffi-args
- `(,aux-var))))))
- ;;Complex returns through hidden variable.
- (unless (null hidden-var-name)
- (nconsc aux-args `((,hidden-var-name ,(ecase (second (first pars))
- (:complex-single-float #c(0e0 0e0))
- (:complex-double-float #c(0d0 0d0)))))))
- ;;Keyword argument list
- (unless (null defun-keyword-args)
- (setq defun-keyword-args (cons '&optional defun-keyword-args)))
- ;;Return the function definition
- (let ((retvar (gensym)))
- `(
- ,(recursive-append
- `(defun ,name ,(append defun-args defun-keyword-args)
- ,@doc)
+ ;; underlying Fortran routine of the same name.
+ (defun %f77.def-fortran-interface (name return-type body hidden-var-name)
+ (multiple-value-bind (doc pars)
+ (parse-doc-&-parameters body)
+ (let ((ffi-fn (make-fortran-ffi-name name))
+ (return-vars nil)
+ (array-vars nil)
+ (ref-vars nil)
+ (callback-code nil)
;;
- (unless (null aux-args)
- `(let (,@aux-args)))
- ;;Don't use with-foreign.. if ref-vars is nil
- (unless (null ref-vars)
- `(with-foreign-objects-stacked (,@ref-vars)))
- ;;Don't use with-vector-dat.. if array-vars is nil
- (unless (null array-vars)
- `(with-vector-data-addresses (,@array-vars)))
+ (defun-args nil)
+ (defun-keyword-args nil)
+ ;;
+ (aux-args nil)
+ ;;
+ (ffi-args nil)
+ (aux-ffi-args nil)
+ (callback-args nil))
+ (dolist (decl pars)
+ (destructuring-bind (var type &optional style) decl
+ (let ((ffi-var nil)
+ (aux-var nil))
+ (cond
+ ;; Callbacks are tricky.
+ ((%f77.callback-type-p type)
+ (let* ((callback-name (second type))
+ (field-gvar (intern (string+ "*" (symbol-name (gensym (symbol-name var))) "*")))
+ (c-callback-code (%f77.def-fortran-callback field-gvar callback-name (third type) (cdddr type))))
+ (nconsc callback-code `((defvar ,field-gvar nil) ,@c-callback-code))
+ (nconsc callback-args `((,field-gvar ,var)))
+ (setq ffi-var `(cffi:callback ,callback-name))))
+ ;; Can't really enforce "style" when given an array.
+ ;; Complex numbers do not latch onto this case, they
+ ;; are passed by value.
+ ((%f77.array-p type)
+ (setq ffi-var (scat "ADDR-" var))
+ (nconsc array-vars `((,ffi-var ,var)))
+ ;;
+ (when-let (arg (getf type :inc))
+ (nconsc defun-keyword-args
+ `((,arg 0)))
+ (nconc (car (last array-vars)) `(:inc-type ,(cadr type) :inc ,arg))))
+ ;; Strings
+ ((%f77.string-p type)
+ (setq ffi-var var)
+ (setq aux-var (scat "LEN-" var))
+ (nconsc aux-args `((,aux-var (length (the string ,var))))))
+ ;; Pass-by-value variables
+ ((eq style :input-value)
+ (setq ffi-var var))
+ ;; Pass-by-reference variables
+ (t
+ (cond
+ ;; Makes more sense to copy complex numbers into
+ ;; arrays, rather than twiddling around with lisp
+ ;; memory internals.
+ ((member type '(:complex-single-float :complex-double-float))
+ (setq ffi-var (scat "ADDR-REAL-CAST-" var))
+ (nconsc ref-vars
+ `((,ffi-var ,(second (%f77.cffi-type type)) :count 2 :initial-contents (list (realpart ,var) (imagpart ,var))))))
+ (t
+ (setq ffi-var (scat "REF-" var))
+ (nconsc ref-vars
+ `((,ffi-var ,(%f77.cffi-type type) :initial-element ,var)))))))
+ ;; Output variables
+ (when (and (%f77.output-p style) (not (eq type :string)))
+ (nconsc return-vars
+ `((,ffi-var ,var ,type))))
+ ;; Arguments for the lisp wrapper
+ (unless (eq var hidden-var-name)
+ (nconsc defun-args
+ `(,var)))
+ ;; Arguments for the FFI function
+ (nconsc ffi-args
+ `(,ffi-var))
+ ;; Auxillary arguments for FFI
+ (unless (null aux-var)
+ (nconsc aux-ffi-args
+ `(,aux-var))))))
+ ;;Complex returns through hidden variable.
+ (unless (null hidden-var-name)
+ (nconsc aux-args `((,hidden-var-name ,(ecase (second (first pars))
+ (:complex-single-float #c(0e0 0e0))
+ (:complex-double-float #c(0d0 0d0)))))))
+ ;;Keyword argument list
+ (unless (null defun-keyword-args)
+ (setq defun-keyword-args (cons '&optional defun-keyword-args)))
+ ;;Return the function definition
+ (let ((retvar (gensym)))
+ `(
;;Declare callbacks
- callback-code
- ;;Call the foreign-function
- `(let ((,retvar (,ffi-fn ,@ffi-args ,@aux-ffi-args)))
- ;;Ignore return if type is :void
- ,@(when (eq return-type :void)
- `((declare (ignore ,retvar))))
- ;; Copy values in reference pointers back to local
- ;; variables. Lisp has local scope; its safe to
- ;; modify variables in parameter lists.
- ,@(mapcar #'(lambda (decl)
- (destructuring-bind (ffi-var var type) decl
- (if (member type '(:complex-single-float :complex-double-float))
- `(setq ,var (complex (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 0)
- (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 1)))
- `(setq ,var (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type))))))
- (remove-if-not #'(lambda (x)
- (member (first x) ref-vars :key #'car))
- return-vars))
- (values
- ,@(unless (eq return-type :void)
- `(,retvar))
- ,@(mapcar #'second return-vars)))))))))
-
-;;TODO: Outputs are messed up inside the callback
-;;TODO: Define callbacks outside the function call and lexically bind functions inside the
-;; call. Callbacks allocate memory in some non-GC'ed part of the heap. Runs out of memory
-;; quite quickly.
-(defun %f77.def-fortran-callback (func callback-name return-type parm)
- (let* ((hack-return-type `,return-type)
- (hack-parm `(,@parm))
- (hidden-var-name nil))
- ;;
- (when (member hack-return-type '(:complex-single-float :complex-double-float))
- (setq hidden-var-name (gensym "HIDDEN-COMPLEX-RETURN-"))
- (setq hack-parm `((,hidden-var-name ,hack-return-type :output)
- ,@parm))
- (setq hack-return-type :void))
- ;;
- (let* ((new-pars nil)
- (aux-pars nil)
- (func-pars nil)
- (array-vars nil)
- (return-vars nil)
- (ref-vars nil))
- (dolist (decl hack-parm)
- (destructuring-bind (var type &optional (style :input)) decl
- (let ((ffi-var nil)
- (func-var nil))
- (cond
- ;; Callbacks are tricky.
- ((%f77.callback-type-p type)
- (setq ffi-var var)
- (setq func-var var))
- ;;
- ((%f77.array-p type)
- (setq ffi-var (scat "ADDR-" var))
- (setq func-var var)
- (nconsc array-vars `((,func-var (make-foreign-vector :pointer ,ffi-var :type ,(second (%f77.cffi-type type))
- :size ,(if-let (size (getf type :size))
- size
- 1))))))
+ ,@callback-code
+ ,(recursive-append
+ `(defun ,name ,(append defun-args defun-keyword-args)
+ ,@doc)
;;
- ((%f77.string-p type)
- (setq ffi-var var)
- (setq func-var var)
- (nconsc aux-pars
- `((,(scat "LEN-" var) ,(%f77.cffi-type :integer)))))
+ (unless (null aux-args)
+ `(let (,@aux-args)))
+ ;;Don't use with-foreign.. if ref-vars is nil
+ (unless (null ref-vars)
+ `(with-foreign-objects-stacked (,@ref-vars)))
+ ;;Don't use with-vector-dat.. if array-vars is nil
+ (unless (null array-vars)
+ `(with-vector-data-addresses (,@array-vars)))
+ ;;Point the the dummy global variables to the proper functions
+ (unless (null callback-args)
+ `(let (,@callback-args)))
+ ;;Call the foreign-function
+ `(let ((,retvar (,ffi-fn ,@ffi-args ,@aux-ffi-args)))
+ ;;Ignore return if type is :void
+ ,@(when (eq return-type :void)
+ `((declare (ignore ,retvar))))
+ ;; Copy values in reference pointers back to local
+ ;; variables. Lisp has local scope; its safe to
+ ;; modify variables in parameter lists.
+ ,@(mapcar #'(lambda (decl)
+ (destructuring-bind (ffi-var var type) decl
+ (if (member type '(:complex-single-float :complex-double-float))
+ `(setq ,var (complex (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 0)
+ (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 1)))
+ `(setq ,var (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type))))))
+ (remove-if-not #'(lambda (x)
+ (member (first x) ref-vars :key #'car))
+ return-vars))
+ (values
+ ,@(unless (eq return-type :void)
+ `(,retvar))
+ ,@(mapcar #'second return-vars)))))))))
+
+ ;;TODO: Outputs are messed up inside the callback
+ ;;TODO: Define callbacks outside the function call and lexically bind functions inside the
+ ;; call. Callbacks allocate memory in some non-GC'ed part of the heap. Runs out of memory
+ ;; quite quickly.
+ (defun %f77.def-fortran-callback (func callback-name return-type parm)
+ (let* ((hack-return-type `,return-type)
+ (hack-parm `(,@parm))
+ (hidden-var-name nil))
+ ;;
+ (when (member hack-return-type '(:complex-single-float :complex-double-float))
+ (setq hidden-var-name (gensym "HIDDEN-COMPLEX-RETURN-"))
+ (setq hack-parm `((,hidden-var-name ,hack-return-type :output)
+ ,@parm))
+ (setq hack-return-type :void))
+ ;;
+ (let* ((new-pars nil)
+ (aux-pars nil)
+ (func-pars nil)
+ (array-vars nil)
+ (return-vars nil)
+ (ref-vars nil))
+ (dolist (decl hack-parm)
+ (destructuring-bind (var type &optional (style :input)) decl
+ (let ((ffi-var nil)
+ (func-var nil))
+ (cond
+ ;; Callbacks are tricky.
+ ((%f77.callback-type-p type)
+ (setq ffi-var var)
+ (setq func-var var))
+ ;;
+ ((%f77.array-p type)
+ (setq ffi-var (scat "ADDR-" var))
+ (setq func-var var)
+ (nconsc array-vars `((,func-var (make-foreign-vector :pointer ,ffi-var :type ,(second (%f77.cffi-type type))
+ :size ,(if-let (size (getf type :size))
+ size
+ 1))))))
+ ;;
+ ((%f77.string-p type)
+ (setq ffi-var var)
+ (setq func-var var)
+ (nconsc aux-pars
+ `((,(scat "LEN-" var) ,(%f77.cffi-type :integer)))))
+ ;;
+ ((eq style :input-value)
+ (setq ffi-var var)
+ (setq func-var var))
+ ;; Pass-by-reference variables
+ (t
+ (cond
+ ((member type '(:complex-single-float :complex-double-float))
+ (setq ffi-var (scat "ADDR-REAL-CAST-" var))
+ (setq func-var var)
+ (nconsc ref-vars
+ `((,func-var (complex (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 0)
+ (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 1))))))
+ (t
+ (setq ffi-var (scat "REF-" var))
+ (setq func-var var)
+ (nconsc ref-vars
+ `((,func-var (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type)))))))))
;;
- ((eq style :input-value)
- (setq ffi-var var)
- (setq func-var var))
- ;; Pass-by-reference variables
- (t
- (cond
- ((member type '(:complex-single-float :complex-double-float))
- (setq ffi-var (scat "ADDR-REAL-CAST-" var))
- (setq func-var var)
- (nconsc ref-vars
- `((,func-var (complex (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 0)
- (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 1))))))
- (t
- (setq ffi-var (scat "REF-" var))
- (setq func-var var)
- (nconsc ref-vars
- `((,func-var (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type)))))))))
- ;;
- (nconsc new-pars `((,ffi-var ,(%f77.get-read-in-type type style))))
- (nconsc func-pars `(,func-var))
- (when (and (%f77.output-p style) (not (eq type :string)))
- (nconsc return-vars
- `((,func-var ,ffi-var ,type)))))))
-
- (let ((retvar (gensym)))
- `(
- ,(recursive-append
- `(cffi:defcallback ,callback-name ,(%f77.get-return-type hack-return-type)
+ (nconsc new-pars `((,ffi-var ,(%f77.get-read-in-type type style))))
+ (nconsc func-pars `(,func-var))
+ (when (and (%f77.output-p style) (not (eq type :string)))
+ (nconsc return-vars
+ `((,func-var ,ffi-var ,type)))))))
+
+ (let ((retvar (gensym)))
+ `(
+ ,(recursive-append
+ `(cffi:defcallback ,callback-name ,(%f77.get-return-type hack-return-type)
(,@new-pars ,@aux-pars))
- ;;
- (when ref-vars
- `(let (,@ref-vars)))
- ;;
- (when array-vars
- `(let (,@array-vars)))
- ;;
- `(multiple-value-bind (,retvar ,@(mapcar #'car return-vars)) (funcall ,func ,@func-pars)
- ,@(when (eq hack-return-type :void)
- `((declare (ignore ,retvar))))
- ,@(mapcar #'(lambda (decl)
- (destructuring-bind (func-var ffi-var type) decl
- (if (member type '(:complex-single-float :complex-double-float))
- `(setf (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 0) (realpart ,func-var)
- (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 1) (imagpart ,func-var))
- `(setf (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type)) ,func-var))))
- (remove-if-not #'(lambda (x)
- (member (first x) ref-vars :key #'car))
- return-vars))
- ,(if (eq hack-return-type :void)
- nil
- retvar))))))))
-)
+ ;;
+ (when ref-vars
+ `(let (,@ref-vars)))
+ ;;
+ (when array-vars
+ `(let (,@array-vars)))
+ ;;
+ `(multiple-value-bind (,retvar ,@(mapcar #'car return-vars)) (funcall ,func ,@func-pars)
+ ,@(when (eq hack-return-type :void)
+ `((declare (ignore ,retvar))))
+ ,@(mapcar #'(lambda (decl)
+ (destructuring-bind (func-var ffi-var type) decl
+ (if (member type '(:complex-single-float :complex-double-float))
+ `(setf (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 0) (realpart ,func-var)
+ (cffi:mem-aref ,ffi-var ,(second (%f77.cffi-type type)) 1) (imagpart ,func-var))
+ `(setf (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type)) ,func-var))))
+ (remove-if-not #'(lambda (x)
+ (member (first x) ref-vars :key #'car))
+ return-vars))
+ ,(if (eq hack-return-type :void)
+ nil
+ retvar))))))))
+ )
(defmacro def-fortran-routine (name-and-options return-type &rest body)
"
@@ -542,7 +548,7 @@
,@pars))
(setq hack-return-type :void)))
- `(progn
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(cffi:defcfun (,fortran-name ,lisp-name) ,(%f77.get-return-type hack-return-type)
,@(%f77.parse-fortran-parameters hack-body))
,@(%f77.def-fortran-interface name hack-return-type hack-body hidden-var-name)))))
diff --git a/src/packages/odepack/dlsode.lisp b/src/packages/odepack/dlsode.lisp
index 323c76e..a18b957 100644
--- a/src/packages/odepack/dlsode.lisp
+++ b/src/packages/odepack/dlsode.lisp
@@ -19,14 +19,14 @@
(neq :integer :input)
(y (* :double-float) :input-output))
-
(def-fortran-routine dlsode :void
"DLSODE in ODEPACK"
- (field (:callback :void
- (c-neq :integer :input)
- (c-t :double-float :input)
- (c-y (* :double-float :size c-neq) :input)
- (c-ydot (* :double-float :size c-neq) :output)))
+ (field (:callback dlsode-field-callback
+ :void
+ (c-neq :integer :input)
+ (c-t :double-float :input)
+ (c-y (* :double-float :size c-neq) :input)
+ (c-ydot (* :double-float :size c-neq) :output)))
(neq :integer :input)
(y (* :double-float) :input-output)
(ts :double-float :input-output)
@@ -41,14 +41,15 @@
(lrw :integer :input)
(iwork (* :integer) :input-output)
(liw :integer :input)
- (jacobian (:callback :void
- (c-neq :integer :input)
- (c-t :double-float :input)
- (c-y (* :double-float :size c-neq) :input)
- (c-upper-bandwidth :integer :input)
- (c-lower-bandwidth :integer :input)
- (c-pd (* :double-float :size (* c-neq c-neq)) :output)
- (c-nrowpd :integer :input)))
+ (jacobian (:callback dlsode-jacobian-callback
+ :void
+ (c-neq :integer :input)
+ (c-t :double-float :input)
+ (c-y (* :double-float :size c-neq) :input)
+ (c-upper-bandwidth :integer :input)
+ (c-lower-bandwidth :integer :input)
+ (c-pd (* :double-float :size (* c-neq c-neq)) :output)
+ (c-nrowpd :integer :input)))
(mf :integer :input))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -61,7 +62,7 @@
(ts (aref t-array 0))
(tout (aref t-array 0))
(itol 1)
- (atol (make-array 1 :element-type 'double-float :initial-element 1d-8))
+ (atol (make-array 1 :element-type 'double-float :initial-element 1d-12))
(rtol (make-array 1 :element-type 'double-float :initial-element 1d-12))
(itask 1)
(istate 1)
@@ -98,19 +99,29 @@
(fv-ref ydot 3) (/ (+ (* 2 (sin theta)) (* (cos theta) (sin theta) (expt thetadot 2))) (- (expt (cos theta) 2) 2))))))
(defun pcart-report (ts y)
- (declare (ignore ts y))
- #+nil
(format t "~A ~A ~A ~A ~A ~%" ts (aref y 0) (aref y 1) (aref y 2) (aref y 3)))
#+nil
(let ((y (make-array 2 :element-type 'double-float :initial-contents `(,(/ pi 2) 0d0))))
(lsode-evolve #'pend-field y #(0d0 1d0 2d0) #'pend-report))
+;; Should return
+;; 1.0d0 1.074911802207049d0 -0.975509986605856d0
+;; 2.0d0 -0.20563950412081608d0 -1.3992359518735706d0
+
+#+nil
(let ((y (make-array 4 :element-type 'double-float :initial-contents `(0d0 ,(/ pi 3) 0d0 0d0)))
- (ts (make-array 200 :element-type 'double-float :initial-contents (loop :for i :from 0 :below 200
+ (ts (make-array 11 :element-type 'double-float :initial-contents (loop :for i :from 0 :to 10
:collect (coerce i 'double-float)))))
(time (lsode-evolve #'pcart-field y ts #'pcart-report)))
-
;; Should return
-;; 1.0d0 1.074911802207049d0 -0.975509986605856d0
-;; 2.0d0 -0.20563950412081608d0 -1.3992359518735706d0
+;; 1.0 0.1794874587619304 0.5317592902679298 0.46247076075331184 -1.073122136936815
+;; 2.0 0.7546873547963733 -0.6988651690131225 0.3317944848774514 -0.8667875783856668
+;; 3.0 0.8622986451947015 -1.032477629437877 -0.04382530605214124 0.1709611368887168
+;; 4.0 0.5946940935220925 -0.32928104576674966 -0.6014830191620928 1.2712646406898929
+;; 5.0 0.06363367930511842 0.8312257489444103 -0.22610367475002707 0.6709599188446416
+;; 6.0 0.015513214905789278 0.9881309198657862 0.09468174702976984 -0.3441398956696562
+;; 7.0 0.38441646507049126 0.09734614673612564 0.6971343020352996 -1.4009010238635045
+;; 8.0 0.8340714151347116 -0.9308326125800139 0.14520534336799193 -0.4863145646496502
+;; 9.0 0.8288509626732954 -0.913548305194868 -0.15954504310515494 0.5222932357142753
+;; 10.0 0.36071471240686237 0.14510464752601557 -0.6851579582975589 1.3848698186034156
-----------------------------------------------------------------------
Summary of changes:
src/ffi/f77-ffi.lisp | 466 +++++++++++++++++++-------------------
src/packages/odepack/dlsode.lisp | 53 +++--
2 files changed, 268 insertions(+), 251 deletions(-)
hooks/post-receive
--
matlisp
|
