From c01366d6cfe2a998c805e6a3e55785cee12c55c8 Mon Sep 17 00:00:00 2001 From: Liam Healy <lnp@healy.washington.dc.us> Date: Mon, 29 Dec 2008 17:45:01 -0500 Subject: [PATCH] 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. --- data/foreign-array.lisp | 25 ++++++++++++++++--------- gsll.asd | 6 +++--- init/mobject.lisp | 13 +++++++------ 3 files changed, 26 insertions(+), 18 deletions(-) diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp index 91285b1f..df72f914 100644 --- a/data/foreign-array.lisp +++ b/data/foreign-array.lisp @@ -1,6 +1,6 @@ ;; 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)))))) diff --git a/gsll.asd b/gsll.asd index 3398ec8c..4dfd81f7 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; 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) diff --git a/init/mobject.lisp b/init/mobject.lisp index f87a3971..a38d0fab 100644 --- a/init/mobject.lisp +++ b/init/mobject.lisp @@ -1,6 +1,6 @@ ;; 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) -- GitLab