Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-139-g3d2b1c4
|
From: Akshay S. <ak...@us...> - 2012-07-22 17:03:49
|
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 3d2b1c49901f857eff0b30ebecaeb251d35e1755 (commit)
via aa67585771f77454b95fa7b16767ef3a6ff03923 (commit)
via 00e53dd09b3cc988dcd4e6e82934ff78bcb83501 (commit)
via 1ab6cec8e17077b9533560c9a5bc010e95818a04 (commit)
via b6be337cd4bfc4e869cc13317e36244517fb95a8 (commit)
via 4022a66033df8820d07bb2abd81b9a355274bd71 (commit)
via 77cde81e39386e147ac35c488d1f7c581d7bd9b8 (commit)
via c73c3a034c2a655afb2edd38ed6f0dcef6050b3d (commit)
via c2b5936d4d517cf0a7ee3e8d4a5d9b683249076c (commit)
from d18665bf3b836e17d2ff75065b384b5ff07059e3 (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 3d2b1c49901f857eff0b30ebecaeb251d35e1755
Author: Akshay Srinivasan <aks...@gm...>
Date: Sun Jul 22 22:28:13 2012 +0530
o Renamed non-exported functions in f77-ffi.lisp to avoid name clobbering (working on the C-FFI, see).
o Added some documentation to some exotic macros in utilities.lisp
diff --git a/matlisp.asd b/matlisp.asd
index 9c6076b..be38acc 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -77,7 +77,7 @@
:components ((:file "ffi-cffi")
(:file "ffi-cffi-implementation-specific")
(:file "foreign-vector")
- (:file "fortran-ffi"
+ (:file "f77-ffi"
:depends-on ("ffi-cffi"
"ffi-cffi-implementation-specific"
"foreign-vector"))
diff --git a/packages.lisp b/packages.lisp
index 8767417..b295a79 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -77,7 +77,7 @@
#:when-let #:if-let #:if-ret #:with-gensyms #:let-rec
#:mlet* #:make-array-allocator #:let-typed
#:nconsc #:define-constant
- #:macrofy
+ #:macrofy #:looped-mapcar
;;
#:inlining #:definline
#:with-optimization #:quickly #:very-quickly #:slowly #:quickly-if))
diff --git a/src/ffi/f77-ffi.lisp b/src/ffi/c-ffi.lisp
similarity index 95%
copy from src/ffi/f77-ffi.lisp
copy to src/ffi/c-ffi.lisp
index 9c5491f..7a6fba9 100644
--- a/src/ffi/f77-ffi.lisp
+++ b/src/ffi/c-ffi.lisp
@@ -1,46 +1,44 @@
;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Package: :fortran-ffi-accessors; Base: 10 -*-
-;; Allowed types:
-;; :single-float :double-float
-;; :complex-single-float :complex-double-float
-;; :integer :long
-
-;; Callbacks : (:function <output-type> {(params)})
-
-;;TODO add declarations to generated wrappers.
(in-package #:matlisp-ffi)
-;: Don't blame us, a lot of useful code
-;; is written in that stilted language.
-(define-constant +f77-types+
- '(:single-float :double-float
- :complex-single-float :complex-double-float
- :integer :long
- :string
- :callback))
+(defmacro defccomplex (name base-type)
+ `(cffi:defcstruct ,name
+ (real ,base-type)
+ (imag ,base-type)))
+
+(defccomplex c-complex-double :double)
+(defccomplex c-complex-float :float)
;; Get the equivalent CFFI type.
;; If the type is an array, get the type of the array element type.
-(defun f77->cffi-type (type)
+(defun c->cffi-type (type)
"Convert the given Fortran FFI type into a type understood by CFFI."
(cond
((and (listp type) (eq (first type) '*))
- `(:pointer ,@(f77->cffi-type (second type))))
+ `(:pointer ,(c->cffi-type
+ (case (second type)
+ ;;CDR coding ?
+ (:complex-single-float :single-float)
+ (:complex-double-float :double-float)
+ (t (second type))))))
((callback-type-p type)
- `(:pointer ,@(f77->cffi-type :callback)))
+ `(:pointer ,(c->cffi-type :callback)))
((eq type :complex-single-float)
- `(:pointer ,@(f77->cffi-type :single-float)))
+ `(:struct c-complex-float))
((eq type :complex-double-float)
- `(:pointer ,@(f77->cffi-type :double-float)))
- (t `(,(ecase type
- (:void :void)
- (:integer :int)
- (:long :long)
- (:single-float :float)
- (:double-float :double)
- (:string :string)
- ;; Pass a pointer to the function.
- (:callback :void))))))
+ `(:struct c-complex-double))
+ (t (case type
+ (:void :void)
+ (:integer :int)
+ (:long :long)
+ (:single-float 'c-complex-float)
+ (:double-float 'c-complex-double)
+ (:string :string)
+ ;; Pass a pointer to the function.
+ (:callback :void)
+ ;;We assume the type is known to CFFI.
+ (t type)))))
;; Check if given type is a string
(declaim (inline string-p))
@@ -552,3 +550,4 @@
,(if (eq hack-return-type :void)
nil
retvar))))))))
+
diff --git a/src/ffi/f77-ffi.lisp b/src/ffi/f77-ffi.lisp
index 9c5491f..d68b04b 100644
--- a/src/ffi/f77-ffi.lisp
+++ b/src/ffi/f77-ffi.lisp
@@ -10,100 +10,96 @@
(in-package #:matlisp-ffi)
-;: Don't blame us, a lot of useful code
-;; is written in that stilted language.
-(define-constant +f77-types+
- '(:single-float :double-float
- :complex-single-float :complex-double-float
- :integer :long
- :string
- :callback))
-;; Get the equivalent CFFI type.
-;; If the type is an array, get the type of the array element type.
-(defun f77->cffi-type (type)
- "Convert the given Fortran FFI type into a type understood by CFFI."
- (cond
- ((and (listp type) (eq (first type) '*))
- `(:pointer ,@(f77->cffi-type (second type))))
- ((callback-type-p type)
- `(:pointer ,@(f77->cffi-type :callback)))
- ((eq type :complex-single-float)
- `(:pointer ,@(f77->cffi-type :single-float)))
- ((eq type :complex-double-float)
- `(:pointer ,@(f77->cffi-type :double-float)))
- (t `(,(ecase type
- (:void :void)
- (:integer :int)
- (:long :long)
- (:single-float :float)
- (:double-float :double)
- (:string :string)
- ;; Pass a pointer to the function.
- (:callback :void))))))
-
-;; Check if given type is a string
-(declaim (inline string-p))
-(defun string-p (type)
+(definline %f77.string-p (type)
+ "
+ Checks if the given type is a string."
(eq type :string))
-;; Check if given type is an array
-(declaim (inline array-p))
-(defun array-p (type)
+(definline %f77.array-p (type)
+ "
+ Checks if the given type is an array."
(and (listp type) (eq (car type) '*)))
-;; Check if the given type is - or has to be passed as - an array.
-(defun cast-as-array-p (type)
- (or (if (listp type)
- (eq (car type) '*))
+(definline %f77.cast-as-array-p (type)
+ "
+ Checks if the given type is - or has to be passed as - an array."
+ (or (when (listp type)
+ (eq (car type) '*))
(eq type :complex-single-float)
(eq type :complex-double-float)))
;; Check if the given type is a callback.
-(declaim (inline callback-type-p))
-(defun callback-type-p (type)
+(definline %f77.callback-type-p (type)
+ "
+ Checks if the given type is a callback"
(and (listp type) (eq (first type) :callback)))
-;; Fortran functions return-by-values.
-(defun get-return-type (type)
- (if (or (cast-as-array-p type) (callback-type-p type))
- (error "Cannot have a Fortran function output the type: ~S directly." type)
- (f77->cffi-type type)))
+;; Get the equivalent CFFI type.
+;; If the type is an array, get the type of the array element type.
+(defun %f77.cffi-type (type)
+ "Convert the given matlisp-ffi type into one understood by CFFI."
+ (cond
+ ((and (listp type) (eq (first type) '*))
+ `(:pointer ,(%f77.cffi-type (second type))))
+ ((%f77.callback-type-p type)
+ `(:pointer ,(%f77.cffi-type :callback)))
+ ((eq type :complex-single-float)
+ `(:pointer ,(%f77.cffi-type :single-float)))
+ ((eq type :complex-double-float)
+ `(:pointer ,(%f77.cffi-type :double-float)))
+ (t (ecase type
+ (:void :void)
+ (:integer :int)
+ (:character :char)
+ (:long :long)
+ (:single-float :float)
+ (:double-float :double)
+ (:string :string)
+ ;; Pass a pointer to the function.
+ (:callback :void)
+ (t (error 'unknown-token :token type
+ :message "Don't know the given Fortran type."))))))
+
+(defun %f77.get-return-type (type)
+ "
+ Return type understood by CFFI. Note that unlike arguments fortran
+ functions return-by-value."
+ (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.")
+ (%f77.cffi-type type)))
-;; If output
-(declaim (inline output-p))
-(defun output-p (style)
+(definline %f77.output-p (style)
+ "
+ Checks if style implies output."
(member style '(:output :input-output :workspace-output)))
-;; If input
-(declaim (inline input-p))
-(defun input-p (style)
- (member style '(:input :input-value :workspace)))
+(definline %f77.input-p (style)
+ "
+ Checks if style implies input."
+ (member style '(:input :input-value :input-reference :workspace)))
-;; CFFI doesn't nearly have as nice an FFI as SBCL/CMUCL.
-(defun get-read-in-type (type &optional (style :input))
- (unless (member style +ffi-styles+)
- (error "Don't know how to handle style ~A." style))
+(defun %f77.get-read-in-type (type &optional (style :input))
+ "
+ 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.")
(cond
;; Can't do much else if type is an array/complex or input is passed-by-value.
- ((or (callback-type-p type) (cast-as-array-p type) (eq style :input-value))
- (f77->cffi-type type))
+ ((or (%f77.callback-type-p type)
+ (%f77.cast-as-array-p type)
+ (eq style :input-value))
+ (%f77.cffi-type type))
;; else pass-by-reference
(t
- `(:pointer ,@(f77->cffi-type type)))))
-
-;; Separte the body of code into documentation and parameter lists.
-(defun parse-doc-&-parameters (body &optional header footer)
- (if (stringp (first body))
- (values `(,(%cat% header (first body) footer)) (rest body))
- (values (if (or header footer)
- (%cat% header "" footer)
- nil)
- body)))
-
-;; Parse fortran parameters and convert parameters to native C90 types (and
-;; add additional function parameters)
-(defun parse-fortran-parameters (body)
+ `(:pointer ,(%f77.cffi-type type)))))
+
+(defun %f77.parse-fortran-parameters (body)
+ "
+ Parse fortran parameters and convert parameters to native C90 types (and
+ add additional function parameters)."
(multiple-value-bind (doc pars)
(parse-doc-&-parameters body)
(declare (ignore doc))
@@ -111,200 +107,199 @@
(let* ((aux-pars nil)
(new-pars
(mapcar #'(lambda (decl)
- (destructuring-bind (name type &optional (style :input))
- 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)))
+ (nconsc aux-pars `((,(scat "LEN-" name) ,(%f77.cffi-type :integer))))
+ `(,name ,(%f77.cffi-type :string)))
(t
- `(,name ,@(get-read-in-type type style))))))
+ `(,name ,(%f77.get-read-in-type type style))))))
pars)))
`( ;; don't want documentation for direct interface, not useful
;; ,@doc
,@new-pars ,@aux-pars))))
-;;
-;; DEF-FORTRAN-ROUTINE
-;;
-;; An external Fortran routine definition form (DEF-FORTRAN-ROUTINE
-;; MY-FUN ...) creates two functions:
-;;
-;; 1. a raw FFI (foreign function interface),
-;; 2. an easier to use lisp interface to the raw interface.
-;;
-;; The documentation given here relates in the most part to the
-;; simplified lisp interface.
-;;
-;; Example:
-;; ========
-;; libblas.a contains the fortran subroutine DCOPY(N,X,INCX,Y,INCY)
-;; which copies the vector Y of N double-float's to the vector X.
-;; The function name in libblas.a is \"dcopy_\" (by Fortran convention).
-;;
-;; (DEF-FORTRAN-ROUTINE DCOPY :void
-;; (N :integer :input)
-;; (X (* :double-float) :output)
-;; (INCX :integer :input)
-;; (Y (* :double-float) :input)
-;; (INCY :integer :input))
-;;
-;; will expand into:
-;;
-;; (CFFI:DEFCFUN ("dcopy_" FORTRAN-DCOPY) :VOID
-;; (N :POINTER :INT)
-;; (DX :POINTER :DOUBLE)
-;; (INCX :POINTER :INT)
-;; (DY :POINTER :DOUBLE)
-;; (INCY :POINTER :INT))
-;;
-;; and
-;;
-;; (DEFUN DCOPY (N,X,INCX,Y,INCY)
-;; ...
-;;
-;; In turn, the lisp function DCOPY calls FORTRAN-DCOPY which calls
-;; the Fortran function "dcopy_" in libblas.a.
-;;
-;; Arguments:
-;; ==========
-;;
-;;
-;; NAME Name of the lisp interface function that will be created.
-;; The name of the raw FFI will be derived from NAME via
-;; the function MAKE-FFI-NAME. The name of foreign function
-;; (presumable a Fortran Function in an external library)
-;; will be derived from NAME via MAKE-FORTRAN-NAME.
-;;
-;; RETURN-TYPE
-;; The type of data that will be returned by the external
-;; (presumably Fortran) function.
-;;
-;; (MEMBER RETURN-TYPE '(:VOID :INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
-;; :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT))
-;;
-;; See GET-READ-OUT-TYPE.
-;;
-;; BODY A list of parameter forms. A parameter form is:
-;;
-;; (VARIABLE TYPE &optional (STYLE :INPUT))
-;;
-;; The VARIABLE is the name of a parameter accepted by the
-;; external (presumably Fortran) routine. TYPE is the type of
-;; VARIABLE. The recognized TYPE's are:
-;;
-;; TYPE Corresponds to Fortran Declaration
-;; ---- ----------------------------------
-;; :STRING CHARACTER*(*)
-;; :INTEGER INTEGER
-;; :SINGLE-FLOAT REAL
-;; :DOUBLE-FLOAT DOUBLE PRECISION
-;; :COMPLEX-SINGLE-FLOAT COMPLEX
-;; :COMPLEX-DOUBLE-FLOAT COMPLEX*16
-;; (* X) An array of type X.
-;; (:CALLBACK args) A description of a function or subroutine
-;;
-;; (MEMBER X '(:INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
-;; :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT)
-;;
-;;
-;; The STYLE (default :INPUT) defines how VARIABLE is treated.
-;; This is by far the most difficult quantity to learn. To
-;; begin with:
-;;
-;;
-;; (OR (MEMBER STYLE '(:INPUT :OUTPUT :INPUT-OUTPUT))
-;; (MEMBER STYLE '(:IN :COPY :IN-OUT :OUT)))
-;;
-;; TYPE STYLE Description
-;; ---- ----- -----------
-;; X :INPUT Value will be used but not modified.
-;;
-;; :OUTPUT Input value not used (but some value must be given),
-;; a value is returned as one of the values lisp
-;; function NAME. Similar to the :IN-OUT style
-;; of DEF-ALIEN-ROUTINE.
-;; :INPUT-OUTPUT Input value may be used, a value is returned
-;; as one of the values from the lisp function
-;; NAME.
-;;
-;; ** Note: In all 3 cases above the input VARIABLE will not be destroyed
-;; or modified directly, a copy is taken and a pointer of that
-;; copy is passed to the (presumably Fortran) external routine.
-;;
-;; (OR (* X) :INPUT Array entries are used but not modified.
-;; :STRING) :OUTPUT Array entries need not be initialized on input,
-;; but will be *modified*. In addition, the array
-;; will be returned via the Lisp command VALUES
-;; from the lisp function NAME.
-;;
-;; :INPUT-OUTPUT Like :OUTPUT but initial values on entry may be used.
-;;
-;; The keyword :WORKSPACE is a nickname for :INPUT. The
-;; keywords :INPUT-OR-OUTPUT, :WORKSPACE-OUTPUT,
-;; :WORKSPACE-OR-OUTPUT are nicknames for :OUTPUT.
-;;
-;; This is complicated. Suggestions are encouraged to
-;; interface a *functional language* to a *pass-by-reference
-;; language*.
-;;
-;; CALLBACKS
-;;
-;; A callback here means a function (or subroutine) that is passed into the Fortran
-;; routine which calls it as needed to compute something.
-;;
-;; The syntax of :CALLBACK is similar to the DEF-FORTRAN-ROUTINE:
-;;
-;; (name (:CALLBACK return-type
-;; {arg-description}))
-;;
-;; The RETURN-TYPE is the same as for DEF-FORTRAN-ROUTINE. The arg description is the
-;; same syntax as list of parameter forms for DEF-FORTRAN-ROUTINE. However, if the type
-;; is a pointer type (like (* :double-float)), then a required keyword option must be
-;; specified:
-;;
-;; (name (* type :size size) &optional style)
-;;
-;; The size specifies the total length of the Fortran array. This array is treated as a
-;; one dimentionsal vector and should be accessed using the function FV-REF, which is
-;; analogous to AREF. The SIZE parameter can be any Lisp form and can refer to any of the
-;; arguments to the Fortran routine.
-;;
-;; For example, a fortran routine can have the callback
-;;
-;; (def-fortran-routine foo :void
-;; (m (* :integer) :input)
-;; (fsub (:callback :void
-;; (x :double-float :input)
-;; (z (* :double-float :size (aref m 0)) :input)
-;; (f (* :double-float :size (aref m 0)) :output)))))
-;;
-;; This means that the arrays Z and F in FSUB have a dimension of (AREF M 0), the first
-;; element of the vector M. The function FSUB can be written in Lisp as
-;;
-;; (defun fsub (x z f)
-;; (setf (fv-ref f 0) (* x x (fv-ref z 3))))
-;;
-;; Further Notes:
-;; ===============
-;;
-;; Some Fortran routines use Fortran character strings in the
-;; parameter list. The definition here is suitable for Solaris
-;; where the Fortran character string is converted to a C-style null
-;; terminated string, AND an extra hidden parameter that is appended
-;; to the parameter list to hold the length of the string.
-;;
-;; If your Fortran does this differently, you'll have to change this
-;; definition accordingly!
-
-;; Call defcfun to define the foreign function.
-;; Also creates a nice lisp helper function.
-(defmacro def-fortran-routine (func-name return-type &rest body)
- (multiple-value-bind (fortran-name name) (if (listp func-name)
- (values (car func-name) (cadr func-name))
- (values (make-fortran-name func-name) func-name))
+(defmacro def-fortran-routine (name-and-options return-type &rest body)
+ "
+ DEF-FORTRAN-ROUTINE
+
+ An external Fortran routine definition form (DEF-FORTRAN-ROUTINE
+ MY-FUN ...) creates two functions:
+
+ 1. a raw FFI (foreign function interface),
+ 2. an easier to use lisp interface to the raw interface.
+
+ The documentation given here relates in the most part to the
+ simplified lisp interface.
+
+ Example:
+ ========
+ libblas.a contains the fortran subroutine DCOPY(N,X,INCX,Y,INCY)
+ which copies the vector Y of N double-float's to the vector X.
+ The function name in libblas.a is \"dcopy_\" (by Fortran convention).
+
+ (DEF-FORTRAN-ROUTINE DCOPY :void
+ (N :integer :input)
+ (X (* :double-float) :output)
+ (INCX :integer :input)
+ (Y (* :double-float) :input)
+ (INCY :integer :input))
+
+ will expand into:
+
+ (CFFI:DEFCFUN (\"dcopy_\" FORTRAN-DCOPY) :VOID
+ (N :POINTER :INT)
+ (DX :POINTER :DOUBLE)
+ (INCX :POINTER :INT)
+ (DY :POINTER :DOUBLE)
+ (INCY :POINTER :INT))
+
+ and
+
+ (DEFUN DCOPY (N,X,INCX,Y,INCY)
+ ...
+
+ In turn, the lisp function DCOPY calls FORTRAN-DCOPY which calls
+ the Fortran function \"dcopy_\" in libblas.a.
+
+ Arguments:
+ ==========
+
+
+ NAME Name of the lisp interface function that will be created.
+ The name of the raw FFI will be derived from NAME via
+ the function MAKE-FFI-NAME. The name of foreign function
+ (presumable a Fortran Function in an external library)
+ will be derived from NAME via MAKE-FORTRAN-NAME.
+
+ RETURN-TYPE
+ The type of data that will be returned by the external
+ (presumably Fortran) function.
+
+ (MEMBER RETURN-TYPE '(:VOID :INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
+ :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT))
+
+ See GET-READ-OUT-TYPE.
+
+ BODY A list of parameter forms. A parameter form is:
+
+ (VARIABLE TYPE &optional (STYLE :INPUT))
+
+ The VARIABLE is the name of a parameter accepted by the
+ external (presumably Fortran) routine. TYPE is the type of
+ VARIABLE. The recognized TYPE's are:
+
+ TYPE Corresponds to Fortran Declaration
+ ---- ----------------------------------
+ :STRING CHARACTER*(*)
+ :INTEGER INTEGER
+ :SINGLE-FLOAT REAL
+ :DOUBLE-FLOAT DOUBLE PRECISION
+ :COMPLEX-SINGLE-FLOAT COMPLEX
+ :COMPLEX-DOUBLE-FLOAT COMPLEX*16
+ (* X) An array of type X.
+ (:CALLBACK args) A description of a function or subroutine
+
+ (MEMBER X '(:INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
+ :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT)
+
+
+ The STYLE (default :INPUT) defines how VARIABLE is treated.
+ This is by far the most difficult quantity to learn. To
+ begin with:
+
+
+ (OR (MEMBER STYLE '(:INPUT :OUTPUT :INPUT-OUTPUT))
+ (MEMBER STYLE '(:IN :COPY :IN-OUT :OUT)))
+
+ TYPE STYLE Description
+ ---- ----- -----------
+ X :INPUT Value will be used but not modified.
+
+ :OUTPUT Input value not used (but some value must be given),
+ a value is returned as one of the values lisp
+ function NAME. Similar to the :IN-OUT style
+ of DEF-ALIEN-ROUTINE.
+ :INPUT-OUTPUT Input value may be used, a value is returned
+ as one of the values from the lisp function
+ NAME.
+
+ ** Note: In all 3 cases above the input VARIABLE will not be destroyed
+ or modified directly, a copy is taken and a pointer of that
+ copy is passed to the (presumably Fortran) external routine.
+
+ (OR (* X) :INPUT Array entries are used but not modified.
+ :STRING) :OUTPUT Array entries need not be initialized on input,
+ but will be *modified*. In addition, the array
+ will be returned via the Lisp command VALUES
+ from the lisp function NAME.
+
+ :INPUT-OUTPUT Like :OUTPUT but initial values on entry may be used.
+
+ The keyword :WORKSPACE is a nickname for :INPUT. The
+ keywords :INPUT-OR-OUTPUT, :WORKSPACE-OUTPUT,
+ :WORKSPACE-OR-OUTPUT are nicknames for :OUTPUT.
+
+ This is complicated. Suggestions are encouraged to
+ interface a *functional language* to a *pass-by-reference
+ language*.
+
+ CALLBACKS
+
+ A callback here means a function (or subroutine) that is passed into the Fortran
+ routine which calls it as needed to compute something.
+
+ The syntax of :CALLBACK is similar to the DEF-FORTRAN-ROUTINE:
+
+ (name (:CALLBACK return-type
+ {arg-description}))
+
+ The RETURN-TYPE is the same as for DEF-FORTRAN-ROUTINE. The arg description is the
+ same syntax as list of parameter forms for DEF-FORTRAN-ROUTINE. However, if the type
+ is a pointer type (like (* :double-float)), then a required keyword option must be
+ specified:
+
+ (name (* type :size size) &optional style)
+
+ The size specifies the total length of the Fortran array. This array is treated as a
+ one dimentionsal vector and should be accessed using the function FV-REF, which is
+ analogous to AREF. The SIZE parameter can be any Lisp form and can refer to any of the
+ arguments to the Fortran routine.
+
+ For example, a fortran routine can have the callback
+
+ (def-fortran-routine foo :void
+ (m (* :integer) :input)
+ (fsub (:callback :void
+ (x :double-float :input)
+ (z (* :double-float :size (aref m 0)) :input)
+ (f (* :double-float :size (aref m 0)) :output)))))
+
+ This means that the arrays Z and F in FSUB have a dimension of (AREF M 0), the first
+ element of the vector M. The function FSUB can be written in Lisp as
+
+ (defun fsub (x z f)
+ (setf (fv-ref f 0) (* x x (fv-ref z 3))))
+
+ Further Notes:
+ ===============
+
+ Some Fortran routines use Fortran character strings in the
+ parameter list. The definition here is suitable for Solaris
+ where the Fortran character string is converted to a C-style null
+ terminated string, AND an extra hidden parameter that is appended
+ to the parameter list to hold the length of the string.
+
+ If your Fortran does this differently, you'll have to change this
+ definition accordingly!
+
+ Call defcfun to define the foreign function.
+ Also creates a nice lisp helper function."
+ (multiple-value-bind (fortran-name name) (if (listp name-and-options)
+ (values (car name-and-options) (cadr name-and-options))
+ (values (make-fortran-name name-and-options) name-and-options))
(let* ((lisp-name (make-fortran-ffi-name `,name))
(hack-return-type `,return-type)
(hack-body `(,@body))
@@ -326,18 +321,13 @@
(setq hack-return-type :void)))
`(progn
- ;; Removing 'inlines' It seems that CMUCL has a problem with
- ;; inlines of FFI's when a lisp image is saved. Until the
- ;; matter is clarified we leave out 'inline's
-
- ;; (declaim (inline ,lisp-name)) ;sbcl 0.8.5 has problems with
- (cffi:defcfun (,fortran-name ,lisp-name) ,@(get-return-type hack-return-type)
- ,@(parse-fortran-parameters hack-body))
- ,@(def-fortran-interface name hack-return-type hack-body hidden-var-name)))))
+ (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)))))
;; Create a form specifying a simple Lisp function that calls the
;; underlying Fortran routine of the same name.
-(defun def-fortran-interface (name return-type body hidden-var-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))
@@ -359,15 +349,15 @@
(aux-var nil))
(cond
;; Callbacks are tricky.
- ((callback-type-p type)
+ ((%f77.callback-type-p type)
(let* ((callback-name (gensym (symbol-name var)))
- (c-callback-code (def-fortran-callback var callback-name (second type) (cddr type))))
+ (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.
- ((array-p type)
+ ((%f77.array-p type)
(setq ffi-var (scat "ADDR-" var))
(nconsc array-vars `((,ffi-var ,var)))
;;
@@ -376,7 +366,7 @@
`((,arg 0)))
(nconc (car (last array-vars)) `(:inc-type ,(cadr type) :inc ,arg))))
;; Strings
- ((string-p type)
+ ((%f77.string-p type)
(setq ffi-var var)
(setq aux-var (scat "LEN-" var))
(nconsc aux-args `((,aux-var (length (the string ,var))))))
@@ -392,13 +382,13 @@
((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))))))
+ `((,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)))))))
+ `((,ffi-var ,(%f77.cffi-type type) :initial-element ,var)))))))
;; Output variables
- (when (and (output-p style) (not (eq type :string)))
+ (when (and (%f77.output-p style) (not (eq type :string)))
(nconsc return-vars
`((,ffi-var ,var ,type))))
;; Arguments for the lisp wrapper
@@ -448,9 +438,9 @@
,@(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))))))
+ `(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))
@@ -459,8 +449,133 @@
`(,retvar))
,@(mapcar #'second return-vars)))))))))
+#+nil
+(defun def-fortran-interface-func (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 (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 (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 (mapcar #'(lambda (decl)
+ ())
+ defun-keyword-args)
+ ,@doc)
+ ;;
+ (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)))
+ ;;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))))))))))
-(defun def-fortran-callback (func callback-name return-type parm)
+;;TODO: Outputs are messed up inside the callback
+(defun %f77.def-fortran-callback (func callback-name return-type parm)
(let* ((hack-return-type `,return-type)
(hack-parm `(,@parm))
(hidden-var-name nil))
@@ -483,23 +598,23 @@
(func-var nil))
(cond
;; Callbacks are tricky.
- ((callback-type-p type)
+ ((%f77.callback-type-p type)
(setq ffi-var var)
(setq func-var var))
;;
- ((array-p type)
+ ((%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))
+ (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))))))
;;
- ((string-p type)
+ ((%f77.string-p type)
(setq ffi-var var)
(setq func-var var)
(nconsc aux-pars
- `((,(scat "LEN-" var) ,@(f77->cffi-type :integer)))))
+ `((,(scat "LEN-" var) ,(%f77.cffi-type :integer)))))
;;
((eq style :input-value)
(setq ffi-var var)
@@ -511,24 +626,24 @@
(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))))))
+ `((,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)))))))))
+ `((,func-var (cffi:mem-aref ,ffi-var ,(%f77.cffi-type type)))))))))
;;
- (nconsc new-pars `((,ffi-var ,@(get-read-in-type type style))))
+ (nconsc new-pars `((,ffi-var ,(%f77.get-read-in-type type style))))
(nconsc func-pars `(,func-var))
- (when (and (output-p style) (not (eq type :string)))
+ (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 ,@(get-return-type hack-return-type)
+ `(cffi:defcallback ,callback-name ,(%f77.get-return-type hack-return-type)
(,@new-pars ,@aux-pars))
;;
(when ref-vars
@@ -543,9 +658,9 @@
,@(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))))
+ `(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))
diff --git a/src/ffi/ffi-cffi.lisp b/src/ffi/ffi-cffi.lisp
index da73d9c..9597bc2 100644
--- a/src/ffi/ffi-cffi.lisp
+++ b/src/ffi/ffi-cffi.lisp
@@ -11,8 +11,25 @@
(in-package #:matlisp-ffi)
(define-constant +ffi-styles+
- '(:input :input-reference :input-value :workspace
- :input-output :output :workspace-output))
+ '(:input :input-reference :input-value
+ :input-output :output :workspace-output
+ :workspace))
+
+(define-constant +ffi-types+
+ '(:single-float :double-float
+ :complex-single-float :complex-double-float
+ :integer :long
+ :string :character
+ :callback))
+
+;; Separte the body of code into documentation and parameter lists.
+(defun parse-doc-&-parameters (body &optional header footer)
+ (if (stringp (first body))
+ (values `(,(%cat% header (first body) footer)) (rest body))
+ (values (if (or header footer)
+ (%cat% header "" footer)
+ nil)
+ body)))
;; Create objects on the heap and run some stuff.
(defmacro with-foreign-objects-heaped (declarations &rest body)
diff --git a/src/level-2/gemv.lisp b/src/level-2/gemv.lisp
index 43b9e10..7fffe5e 100644
--- a/src/level-2/gemv.lisp
+++ b/src/level-2/gemv.lisp
@@ -228,4 +228,4 @@
#'make-complex-tensor
#'make-real-tensor)
(list (ecase job (:n (nrows A)) (:t (ncols A)))))))
- (gemv! alpha A x beta result job)))
+ (gemv! alpha A x 0 result job)))
diff --git a/src/packages/odepack/dlsode.lisp b/src/packages/odepack/dlsode.lisp
index a284d50..0d2c975 100644
--- a/src/packages/odepack/dlsode.lisp
+++ b/src/packages/odepack/dlsode.lisp
@@ -85,9 +85,10 @@
(defun pend-report (ts y)
(format t "~A ~A ~A ~%" ts (aref y 0) (aref y 1)))
-(defvar y (make-array 2 :element-type 'double-float :initial-contents `(,(/ pi 2) 0d0)))
+#+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))
-;; (lsode-evolve #'pend-field y #(0d0 1d0 2d0) #'pend-report)
;; Should return
;; 1.0d0 1.074911802207049d0 -0.975509986605856d0
;; 2.0d0 -0.20563950412081608d0 -1.3992359518735706d0
diff --git a/src/utilities.lisp b/src/utilities.lisp
index e2e74c4..4a631aa 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -233,22 +233,37 @@
(bin-append (car lsts) (apply #'recursive-append (cdr lsts))))))
(defun unquote-args (lst args)
+ "
+ Makes list suitable for use inside macros (sort-of).
+ Example:
+ > (unquote-args '(+ x y z) '(x y))
+ (LIST '+ X Y 'Z)
+
+ DO NOT use backquotes!
+ "
(labels ((replace-atoms (lst ret)
- (if (null lst) (reverse ret)
- (let ((fst (car lst)))
- (replace-atoms (cdr lst)
- (cond
- ((atom fst)
- (if (member fst args)
- (cons fst ret)
- (append `(',fst) ret)))
- ((consp fst)
- (cons (replace-lst fst nil) ret)))))))
+ (cond
+ ((null lst) (reverse ret))
+ ((atom lst)
+ (let ((ret (reverse ret)))
+ (rplacd (last ret) lst)
+ ret))
+ ((consp lst)
+ (replace-atoms (cdr lst) (let ((fst (car lst)))
+ (cond
+ ((atom fst)
+ (if (member fst args)
+ (cons fst ret)
+ (append `(',fst) ret)))
+ ((consp fst)
+ (cons (replace-lst fst nil) ret))))))))
(replace-lst (lst acc)
(cond
((null lst) acc)
((consp lst)
- (cons 'list (replace-atoms lst nil)))
+ (if (eq (car lst) 'quote)
+ lst
+ (cons 'list (replace-atoms lst nil))))
((atom lst) lst))))
(replace-lst lst nil)))
@@ -262,10 +277,79 @@
(rec x nil)))
(defmacro macrofy (lambda-func)
+ "
+ Macrofies a lambda function, for use later inside macros (or for symbolic math ?).
+ Example:
+ > (macroexpand-1 `(macrofy (lambda (x y z) (+ (sin x) y (apply #'cos (list z))))))
+ (LAMBDA (X Y Z)
+ (LIST '+ (LIST 'SIN X) Y (LIST 'APPLY (LIST 'FUNCTION 'COS) (LIST 'LIST Z))))
+ T
+ > (funcall (macrofy (lambda (x y z) (+ (sin x) y (apply #'cos (list z))))) 'a 'b 'c)
+ (+ (SIN A) B (APPLY #'COS (LIST C)))
+
+ DO NOT USE backquotes in the lambda function!
+ "
(destructuring-bind (labd args &rest body) lambda-func
(assert (eq labd 'lambda))
`(lambda ,args ,@(cdr (unquote-args body args)))))
+(defmacro looped-mapcar ((func lst) &rest body)
+ "
+ A macro to use when caught between the efficiency of imperative looping, and
+ the elegance of mapcar (in a dozen places).
+
+ Collects references to func and replaces them with a varible inside a loop.
+ Note that although we traverse through the list only once, the collected lists
+ aren't freed until the macro is closed.
+
+ Example:
+ > (macroexpand-1
+ `(looped-mapcar (lmap '(1 2 3 4 5 6 7 8 9 10))
+ (cons (lmap #'even) (lmap #'(lambda (x) (+ x 1))))))
+ (LET ((#:|lst1118| '(1 2 3 4 5 6 7 8 9 10)))
+ (LOOP FOR #:|ele1117| IN #:|lst1118|
+ COLLECT (FUNCALL #'(LAMBDA (X) (+ X 1))
+ #:|ele1117|) INTO #:|collect1116|
+ COLLECT (FUNCALL #'EVEN #:|ele1117|) INTO #:|collect1115|
+ FINALLY (RETURN (PROGN (CONS #:|collect1115| #:|collect1116|)))))
+ "
+ (let ((ret nil))
+ (labels ((collect-funcs (code tf-code)
+ (cond
+ ((null code)
+ (reverse tf-code))
+ ((atom code)
+ (let ((ret (reverse tf-code)))
+ (rplacd (last ret) code)
+ ret))
+ ((consp code)
+ (let ((carcode (car code)))
+ (cond
+ ((and (consp carcode)
+ (eq (first carcode) func))
+ (assert (null (cddr carcode)) nil 'invalid-arguments
+ :message "The mapper only takes one argument.")
+ (let ((col-sym (gensym "collect")))
+ (push `(,col-sym ,(second carcode)) ret)
+ (collect-funcs (cdr code) (cons col-sym tf-code))))
+ ((consp carcode)
+ (collect-funcs (cdr code) (cons (collect-funcs carcode nil) tf-code)))
+ (t
+ (collect-funcs (cdr code) (cons carcode tf-code)))))))))
+ (let ((tf-code (collect-funcs body nil))
+ (ele-sym (gensym "ele"))
+ (lst-sym (gensym "lst")))
+ (if (null ret)
+ `(progn
+ ,@tf-code)
+ `(let ((,lst-sym ,lst))
+ (loop for ,ele-sym in ,lst-sym
+ ,@(loop for decl in ret
+ append `(collect (funcall ,(second decl) ,ele-sym) into ,(first decl)))
+ finally (return
+ (progn
+ ,@tf-code)))))))))
+
(declaim (inline string+))
(defun string+ (&rest strings)
(apply #'concatenate (cons 'string strings)))
commit aa67585771f77454b95fa7b16767ef3a6ff03923
Author: Akshay Srinivasan <aks...@gm...>
Date: Sun Jul 22 13:37:52 2012 +0530
o renamed: fortran-ffi.lisp -> f77-ffi.lisp
diff --git a/src/ffi/fortran-ffi.lisp b/src/ffi/f77-ffi.lisp
similarity index 99%
rename from src/ffi/fortran-ffi.lisp
rename to src/ffi/f77-ffi.lisp
index 7e048ca..9c5491f 100644
--- a/src/ffi/fortran-ffi.lisp
+++ b/src/ffi/f77-ffi.lisp
@@ -552,4 +552,3 @@
,(if (eq hack-return-type :void)
nil
retvar))))))))
-
commit 00e53dd09b3cc988dcd4e6e82934ff78bcb83501
Author: Akshay Srinivasan <aks...@gm...>
Date: Sun Jul 22 13:35:42 2012 +0530
o Moved Fortran-FFI macros into a separate file.
diff --git a/matlisp.asd b/matlisp.asd
index 8d442d0..9c6076b 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -77,6 +77,10 @@
:components ((:file "ffi-cffi")
(:file "ffi-cffi-implementation-specific")
(:file "foreign-vector")
+ (:file "fortran-ffi"
+ :depends-on ("ffi-cffi"
+ "ffi-cffi-implementation-specific"
+ "foreign-vector"))
))
(:module "foreign-core"
:pathname "foreign-core"
diff --git a/src/ffi/ffi-cffi.lisp b/src/ffi/ffi-cffi.lisp
index 8f57fa9..da73d9c 100644
--- a/src/ffi/ffi-cffi.lisp
+++ b/src/ffi/ffi-cffi.lisp
@@ -10,14 +10,9 @@
(in-package #:matlisp-ffi)
-(define-constant +ffi-types+ '(:single-float :double-float
- :complex-single-float :complex-double-float
- :integer :long
- :string
- :callback))
-
-(define-constant +ffi-styles+ '(:input :input-value :workspace
- :input-output :output :workspace-output))
+(define-constant +ffi-styles+
+ '(:input :input-reference :input-value :workspace
+ :input-output :output :workspace-output))
;; Create objects on the heap and run some stuff.
(defmacro with-foreign-objects-heaped (declarations &rest body)
@@ -105,540 +100,6 @@
`(,@wfo-body
,@body))))
-;; Get the equivalent CFFI type.
-;; If the type is an array, get the type of the array element type.
-(defun ->cffi-type (type)
- "Convert the given Fortran FFI type into a type understood by CFFI."
- (cond
- ((and (listp type) (eq (first type) '*))
- `(:pointer ,@(->cffi-type (second type))))
- ((callback-type-p type)
- `(:pointer ,@(->cffi-type :callback)))
- ((eq type :complex-single-float)
- `(:pointer ,@(->cffi-type :single-float)))
- ((eq type :complex-double-float)
- `(:pointer ,@(->cffi-type :double-float)))
- (t `(,(ecase type
- (:void :void)
- (:integer :int)
- (:long :long)
- (:single-float :float)
- (:double-float :double)
- (:string :string)
- ;; Pass a pointer to the function.
- (:callback :void))))))
-
-;; Check if given type is a string
-(declaim (inline string-p))
-(defun string-p (type)
- (eq type :string))
-
-;; Check if given type is an array
-(declaim (inline array-p))
-(defun array-p (type)
- (and (listp type) (eq (car type) '*)))
-
-;; Check if the given type is - or has to be passed as - an array.
-(defun cast-as-array-p (type)
- (or (if (listp type)
- (eq (car type) '*))
- (eq type :complex-single-float)
- (eq type :complex-double-float)))
-
-;; Check if the given type is a callback.
-(declaim (inline callback-type-p))
-(defun callback-type-p (type)
- (and (listp type) (eq (first type) :callback)))
-
-;; Fortran functions return-by-values.
-(defun get-return-type (type)
- (if (or (cast-as-array-p type) (callback-type-p type))
- (error "Cannot have a Fortran function output the type: ~S directly." type)
- (->cffi-type type)))
-
-;; If output
-(declaim (inline output-p))
-(defun output-p (style)
- (member style '(:output :input-output :workspace-output)))
-
-;; If input
-(declaim (inline input-p))
-(defun input-p (style)
- (member style '(:input :input-value :workspace)))
-
-;; CFFI doesn't nearly have as nice an FFI as SBCL/CMUCL.
-(defun get-read-in-type (type &optional (style :input))
- (unless (member style +ffi-styles+)
- (error "Don't know how to handle style ~A." style))
- (cond
- ;; Can't do much else if type is an array/complex or input is passed-by-value.
- ((or (callback-type-p type) (cast-as-array-p type) (eq style :input-value))
- (->cffi-type type))
- ;; else pass-by-reference
- (t
- `(:pointer ,@(->cffi-type type)))))
-
-;; Separte the body of code into documentation and parameter lists.
-(defun parse-doc-&-parameters (body &optional header footer)
- (if (stringp (first body))
- (values `(,(%cat% header (first body) footer)) (rest body))
- (values (if (or header footer)
- (%cat% header "" footer)
- nil)
- body)))
-
-;; Parse fortran parameters and convert parameters to native C90 types (and
-;; add additional function parameters)
-(defun parse-fortran-parameters (body)
- (multiple-value-bind (doc pars)
- (parse-doc-&-parameters body)
- (declare (ignore doc))
-
- (let* ((aux-pars nil)
- (new-pars
- (mapcar #'(lambda (decl)
- (destructuring-bind (name type &optional (style :input))
- decl
- (case type
- (:string
- ;; String lengths are appended to the function arguments,
- ;; passed by value.
- (nconsc aux-pars `((,(scat "LEN-" name) ,@(->cffi-type :integer))))
- `(,name ,@(->cffi-type :string)))
- (t
- `(,name ,@(get-read-in-type type style))))))
- pars)))
- `( ;; don't want documentation for direct interface, not useful
- ;; ,@doc
- ,@new-pars ,@aux-pars))))
-
-;;
-;; DEF-FORTRAN-ROUTINE
-;;
-;; An external Fortran routine definition form (DEF-FORTRAN-ROUTINE
-;; MY-FUN ...) creates two functions:
-;;
-;; 1. a raw FFI (foreign function interface),
-;; 2. an easier to use lisp interface to the raw interface.
-;;
-;; The documentation given here relates in the most part to the
-;; simplified lisp interface.
-;;
-;; Example:
-;; ========
-;; libblas.a contains the fortran subroutine DCOPY(N,X,INCX,Y,INCY)
-;; which copies the vector Y of N double-float's to the vector X.
-;; The function name in libblas.a is \"dcopy_\" (by Fortran convention).
-;;
-;; (DEF-FORTRAN-ROUTINE DCOPY :void
-;; (N :integer :input)
-;; (X (* :double-float) :output)
-;; (INCX :integer :input)
-;; (Y (* :double-float) :input)
-;; (INCY :integer :input))
-;;
-;; will expand into:
-;;
-;; (CFFI:DEFCFUN ("dcopy_" FORTRAN-DCOPY) :VOID
-;; (N :POINTER :INT)
-;; (DX :POINTER :DOUBLE)
-;; (INCX :POINTER :INT)
-;; (DY :POINTER :DOUBLE)
-;; (INCY :POINTER :INT))
-;;
-;; and
-;;
-;; (DEFUN DCOPY (N,X,INCX,Y,INCY)
-;; ...
-;;
-;; In turn, the lisp function DCOPY calls FORTRAN-DCOPY which calls
-;; the Fortran function "dcopy_" in libblas.a.
-;;
-;; Arguments:
-;; ==========
-;;
-;;
-;; NAME Name of the lisp interface function that will be created.
-;; The name of the raw FFI will be derived from NAME via
-;; the function MAKE-FFI-NAME. The name of foreign function
-;; (presumable a Fortran Function in an external library)
-;; will be derived from NAME via MAKE-FORTRAN-NAME.
-;;
-;; RETURN-TYPE
-;; The type of data that will be returned by the external
-;; (presumably Fortran) function.
-;;
-;; (MEMBER RETURN-TYPE '(:VOID :INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
-;; :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT))
-;;
-;; See GET-READ-OUT-TYPE.
-;;
-;; BODY A list of parameter forms. A parameter form is:
-;;
-;; (VARIABLE TYPE &optional (STYLE :INPUT))
-;;
-;; The VARIABLE is the name of a parameter accepted by the
-;; external (presumably Fortran) routine. TYPE is the type of
-;; VARIABLE. The recognized TYPE's are:
-;;
-;; TYPE Corresponds to Fortran Declaration
-;; ---- ----------------------------------
-;; :STRING CHARACTER*(*)
-;; :INTEGER INTEGER
-;; :SINGLE-FLOAT REAL
-;; :DOUBLE-FLOAT DOUBLE PRECISION
-;; :COMPLEX-SINGLE-FLOAT COMPLEX
-;; :COMPLEX-DOUBLE-FLOAT COMPLEX*16
-;; (* X) An array of type X.
-;; (:CALLBACK args) A description of a function or subroutine
-;;
-;; (MEMBER X '(:INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
-;; :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT)
-;;
-;;
-;; The STYLE (default :INPUT) defines how VARIABLE is treated.
-;; This is by far the most difficult quantity to learn. To
-;; begin with:
-;;
-;;
-;; (OR (MEMBER STYLE '(:INPUT :OUTPUT :INPUT-OUTPUT))
-;; (MEMBER STYLE '(:IN :COPY :IN-OUT :OUT)))
-;;
-;; TYPE STYLE Description
-;; ---- ----- -----------
-;; X :INPUT Value will be used but not modified.
-;;
-;; :OUTPUT Input value not used (but some value must be given),
-;; a value is returned as one of the values lisp
-;; function NAME. Similar to the :IN-OUT style
-;; of DEF-ALIEN-ROUTINE.
-;; :INPUT-OUTPUT Input value may be used, a value is returned
-;; as one of the values from the lisp function
-;; NAME.
-;;
-;; ** Note: In all 3 cases above the input VARIABLE will not be destroyed
-;; or modified directly, a copy is taken and a pointer of that
-;; copy is passed to the (presumably Fortran) external routine.
-;;
-;; (OR (* X) :INPUT Array entries are used but not modified.
-;; :STRING) :OUTPUT Array entries need not be initialized on input,
-;; but will be *modified*. In addition, the array
-;; will be returned via the Lisp command VALUES
-;; from the lisp function NAME.
-;;
-;; :INPUT-OUTPUT Like :OUTPUT but initial values on entry may be used.
-;;
-;; The keyword :WORKSPACE is a nickname for :INPUT. The
-;; keywords :INPUT-OR-OUTPUT, :WORKSPACE-OUTPUT,
-;; :WORKSPACE-OR-OUTPUT are nicknames for :OUTPUT.
-;;
-;; This is complicated. Suggestions are encouraged to
-;; interface a *functional language* to a *pass-by-reference
-;; language*.
-;;
-;; CALLBACKS
-;;
-;; A callback here means a function (or subroutine) that is passed into the Fortran
-;; routine which calls it as needed to compute something.
-;;
-;; The syntax of :CALLBACK is similar to the DEF-FORTRAN-ROUTINE:
-;;
-;; (name (:CALLBACK return-type
-;; {arg-description}))
-;;
-;; The RETURN-TYPE is the same as for DEF-FORTRAN-ROUTINE. The arg description is the
-;; same syntax as list of parameter forms for DEF-FORTRAN-ROUTINE. However, if the type
-;; is a pointer type (like (* :double-float)), then a required keyword option must be
-;; specified:
-;;
-;; (name (* type :size size) &optional style)
-;;
-;; The size specifies the total length of the Fortran array. This array is treated as a
-;; one dimentionsal vector and should be accessed using the function FV-REF, which is
-;; analogous to AREF. The SIZE parameter can be any Lisp form and can refer to any of the
-;; arguments to the Fortran routine.
-;;
-;; For example, a fortran routine can have the callback
-;;
-;; (def-fortran-routine foo :void
-;; (m (* :integer) :input)
-;; (fsub (:callback :void
-;; (x :double-float :input)
-;; (z (* :double-float :size (aref m 0)) :input)
-;; (f (* :double-float :size (aref m 0)) :output)))))
-;;
-;; This means that the arrays Z and F in FSUB have a dimension of (AREF M 0), the first
-;; element of the vector M. The function FSUB can be written in Lisp as
-;;
-;; (defun fsub (x z f)
-;; (setf (fv-ref f 0) (* x x (fv-ref z 3))))
-;;
-;; Further Notes:
-;; ===============
-;;
-;; Some Fortran routines use Fortran character strings in the
-;; parameter list. The definition here is suitable for Solaris
-;; where the Fortran character string is converted to a C-style null
-;; terminated string, AND an extra hidden parameter that is appended
-;; to the parameter list to hold the length of the string.
-;;
-;; If your Fortran does this differently, you'll have to change this
-;; definition accordingly!
-
-;; Call defcfun to define the foreign function.
-;; Also creates a nice lisp helper function.
-(defmacro def-fortran-routine (func-name return-type &rest body)
- (multiple-value-bind (fortran-name name) (if (listp func-name)
- (values (car func-name) (cadr func-name))
- (values (make-fortran-name func-name) func-name))
- (let* ((lisp-name (make-fortran-ffi-name `,name))
- (hack-return-type `,return-type)
- (hack-body `(,@body))
- (hidden-var-name nil))
- ;;
- (multiple-value-bind (doc pars)
- (parse-doc-&-parameters `(,@body))
- (when (member hack-return-type '(:complex-single-float :complex-double-float))
- ;; The return type is complex. Since this is a "structure",
- ;; Fortran inserts a "hidden" first parameter before all
- ;; others. This is used to store the resulting complex
- ;; number. Then there is no "return" value, so set the return
- ;; type to :void.
- ;;
- (setq hidden-var-name (gensym "HIDDEN-COMPLEX-RETURN-"))
- (setq hack-body `(,@doc
- (,hidden-var-name ,hack-return-type :output)
- ,@pars))
- (setq hack-return-type :void)))
-
- `(progn
- ;; Removing 'inlines' It seems that CMUCL has a problem with
- ;; inlines of FFI's when a lisp image is saved. Until the
- ;; matter is clarified we leave out 'inline's
-
- ;; (declaim (inline ,lisp-name)) ;sbcl 0.8.5 has problems with
- (cffi:defcfun (,fortran-name ,lisp-name) ,@(get-return-type hack-return-type)
- ,@(parse-fortran-parameters hack-body))
- ,@(def-fortran-interface name hack-return-type hack-body hidden-var-name)))))
-
-;; Create a form specifying a simple Lisp function that calls the
-;; underlying Fortran routine of the same name.
-(defun 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.
- ((callback-type-p type)
- (let* ((callback-name (gensym (symbol-name var)))
- (c-callback-code (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.
- ((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
- ((s...
[truncated message content] |
