Skip to content
Snippets Groups Projects
Commit c01366d6 authored by Liam Healy's avatar Liam Healy
Browse files

Better support for non-native implementations

Testing with Clozure reveals more details on the stack overflow
problem than what CLISP reveals.  This is fixed by using #'slot-value
instead of #'cl-array in  #'copy-c-to-cl and #'copy-cl-to-c.
Non-complex arrays were not handled correctly in
#'copy-array-from-pointer; fixed.  There is a dependency of
permutation and combination on the definition of #'data-class-name
through defmfun.  Test results:
CCL: TOTAL: 1143 assertions passed, 52 failed, 3 execution errors.
CLISP: TOTAL: 996 assertions passed, 149 failed, 11 execution errors.
SBCL: TOTAL: 1208 assertions passed, 0 failed, 0 execution errors.
(But only the second time it's run in SLIME.)
Variable *print-contents* to disable printing of marray contents in
print-object; this is helpful for debugging.
parent b3c65d75
No related branches found
No related tags found
No related merge requests found
;; Foreign arrays (usually in C)
;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp
;; Time-stamp: <2008-12-28 21:39:02EST foreign-array.lisp>
;; Time-stamp: <2008-12-29 14:34:24EST foreign-array.lisp>
;; $Id: $
(in-package :gsl)
......@@ -63,10 +63,16 @@
(* index-offset
(cffi:foreign-type-size (cl-cffi (element-type object))))))))
(defparameter *print-contents* t
"Print the contents of the foreign-array.")
(defmethod print-object ((object foreign-array) stream)
(print-unreadable-object (object stream :type t)
#-native (copy-c-to-cl object)
(princ (cl-array object) stream)))
(if *print-contents*
(progn
#-native (copy-c-to-cl object)
(princ (cl-array object) stream))
(format stream "dimensions ~a" (dimensions object)))))
(defun dim0 (object)
"The first dimension of the object."
......@@ -95,7 +101,7 @@
"Copy the CL array to the C array."
(when (c-invalid object)
(copy-array-to-pointer
(cl-array object)
(slot-value object 'cl-array)
(c-pointer object)
(element-type object)
0
......@@ -108,7 +114,7 @@
"Copy the C array to the CL array."
(when (cl-invalid object)
(copy-array-from-pointer
(cl-array object)
(slot-value object 'cl-array)
(c-pointer object)
(element-type object)
0
......@@ -144,7 +150,8 @@
for array-index :from index-offset
do
(setf (row-major-aref array array-index)
(complex
(cffi:mem-aref pointer cffi-type pointer-index)
(cffi:mem-aref pointer cffi-type (1+ pointer-index)))))))
(if (subtypep lisp-type 'complex)
(complex
(cffi:mem-aref pointer cffi-type pointer-index)
(cffi:mem-aref pointer cffi-type (1+ pointer-index)))
(cffi:mem-aref pointer cffi-type pointer-index))))))
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2008-12-28 16:46:47EST gsll.asd>
;; Time-stamp: <2008-12-29 13:35:30EST gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -40,8 +40,8 @@
(:file "maref" :depends-on (marray vector matrix))
(:file "both" :depends-on (marray vector matrix))
(:file "array-tests" :depends-on (both))
(:file "permutation" :depends-on (foreign-array))
(:file "combination" :depends-on (foreign-array))))
(:file "permutation" :depends-on (marray))
(:file "combination" :depends-on (marray))))
(:file "polynomial" :depends-on (init data))
(:module special-functions
:depends-on (init)
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-12-28 20:45:50EST mobject.lisp>
;; Time-stamp: <2008-12-29 17:37:25EST mobject.lisp>
;; $Id$
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
......@@ -136,9 +136,11 @@
(:documentation "The name given to the GSL object."))
;;; Pointer type
(defconstant +foreign-pointer-class+ (class-name (class-of (cffi:null-pointer)))
"The class in which foreign pointers fall. This will be assumed to be a
GSL vector or matrix.")
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +foreign-pointer-class+ (class-name (class-of (cffi:null-pointer)))
"The class in which foreign pointers fall.")
(defconstant +foreign-pointer-type+ (type-of (cffi:null-pointer))
"The type of foreign pointers."))
;;; Some functions in solve-minimize-fit return a pointer to a GSL
;;; vector with double-floats. This function will return a contents
......@@ -151,7 +153,6 @@
"Create a contents list from the GSL object of type struct-type
referenced by pointer."))
;;; CLISP bug? doesn't know about +foreign-pointer-class+ defined above
#-clisp
(defmethod mpointer ((object #.+foreign-pointer-class+))
(check-type object #.+foreign-pointer-type+)
object)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment