diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp index 1d204b74a5c9b3c0b30ac3c79e7f3f200bec6a17..91285b1f503227be7ad50c6596cbdbd8025e2780 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 15:53:06EST foreign-array.lisp> +;; Time-stamp: <2008-12-28 21:39:02EST foreign-array.lisp> ;; $Id: $ (in-package :gsl) @@ -49,6 +49,12 @@ (setf cl-array ffa dimensions (array-dimensions ffa) total-size (array-total-size ffa))) + #-native + (let ((cptr (cffi:foreign-alloc + (cl-cffi (element-type object)) + :count (total-size object)))) + (setf (c-pointer object) cptr) + (tg:finalize object (lambda () (cffi:foreign-free cptr)))) #-native (setf (cl-invalid object) nil) (multiple-value-bind (oa index-offset) (find-original-array (cl-array object)) @@ -91,9 +97,9 @@ (copy-array-to-pointer (cl-array object) (c-pointer object) - (component-type (element-type object)) + (element-type object) 0 - (component-size object)) + (total-size object)) (setf (c-invalid object) nil))) ;;; Called right before maref @@ -104,9 +110,9 @@ (copy-array-from-pointer (cl-array object) (c-pointer object) - (component-type (element-type object)) + (element-type object) 0 - (component-size object)) + (total-size object)) (setf (cl-invalid object) nil))) #-native @@ -115,11 +121,9 @@ lisp-type to the memory area that starts at pointer, coercing the elements if necessary." (let ((cffi-type (component-type lisp-type))) - (loop - for pointer-index :from 0 - :below (if (subtypep lisp-type 'complex) (* 2 length) length) - :by (if (subtypep lisp-type 'complex) 2 1) + (loop :repeat length for array-index :from index-offset + for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1) do (if (subtypep lisp-type 'complex) (setf (cffi:mem-aref pointer cffi-type pointer-index) @@ -135,10 +139,8 @@ lisp-type from the memory area that starts at pointer, coercing the elements if necessary." (let ((cffi-type (component-type lisp-type))) - (loop - for pointer-index :from 0 - :below (if (subtypep lisp-type 'complex) (* 2 length) length) - :by (if (subtypep lisp-type 'complex) 2 1) + (loop :repeat length + for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1) for array-index :from index-offset do (setf (row-major-aref array array-index) diff --git a/floating-point/ieee-modes.lisp b/floating-point/ieee-modes.lisp index 521f77ccd8559f38a069dc092c020012f90184bf..a7f80a0fc6412e41c12a01a08665eaeae1fbb795 100644 --- a/floating-point/ieee-modes.lisp +++ b/floating-point/ieee-modes.lisp @@ -1,6 +1,6 @@ ;; IEEE 754 Modes and masks ;; Liam Healy 2008-01-29 21:35:50EST ieee-modes.lisp -;; Time-stamp: <2008-02-17 18:36:37EST ieee-modes.lisp> +;; Time-stamp: <2008-12-28 20:59:16EST ieee-modes.lisp> ;; $Id$ (in-package :gsl) @@ -30,3 +30,6 @@ ((cffi:foreign-enum-value 'ieee-mask exception-mask) :int)) :documentation "Set the IEEE 754 precision, rounding mode, and exception mask.") + +#+clisp +(setf sys::*inhibit-floating-point-underflow* t) diff --git a/init/mobject.lisp b/init/mobject.lisp index 237925ba6bba257ba5be5ff4939cb4f7280e3d0d..f87a3971e537296a290213887b7a9c34b8eb218b 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 18:25:33EST mobject.lisp> +;; Time-stamp: <2008-12-28 20:45:50EST mobject.lisp> ;; $Id$ ;;; GSL objects are represented in GSLL as and instance of a 'mobject. @@ -151,5 +151,7 @@ "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+)) object)