diff --git a/data/combination.lisp b/data/combination.lisp index 9de51372978906b10dc18d8cc5ed7f3e1ec82063..28e9cd73e676cd1516511ec9bbd5ae98a4c6dfcd 100644 --- a/data/combination.lisp +++ b/data/combination.lisp @@ -1,6 +1,6 @@ ;; Combinations ;; Liam Healy, Sun Mar 26 2006 - 11:51 -;; Time-stamp: <2009-06-06 09:53:02EDT combination.lisp> +;; Time-stamp: <2009-12-21 08:24:35EST combination.lisp> ;; $Id$ (in-package :gsl) @@ -11,7 +11,7 @@ ;;;; Combination structure and CL object ;;;;**************************************************************************** -(defclass combination (mobject foreign-array) +(defclass combination (mobject c-array:foreign-array) ((element-type :initform #+int64 '(unsigned-byte 64) diff --git a/data/copy-cl.lisp b/data/copy-cl.lisp index f476dd8e54b8244c6b72d87882cec4f821d65cb6..2329d09c9363e55a06176e3fdcf7a5d67ae5e9bb 100644 --- a/data/copy-cl.lisp +++ b/data/copy-cl.lisp @@ -1,6 +1,6 @@ ;; Copy marrays to/from CL arrays ;; Liam Healy 2009-02-11 19:28:44EST copy-cl.lisp -;; Time-stamp: <2009-02-11 23:00:07EST copy-cl.lisp> +;; Time-stamp: <2009-12-21 08:14:31EST copy-cl.lisp> ;; $Id: $ ;;; The function #'copy can be used to copy the contents to or from a @@ -65,7 +65,7 @@ (defmethod copy-to-destination ((source marray) (destclass (eql 'array))) (let ((destination - (make-ffa (element-type source) :dimensions (dimensions source)))) + (c-array:make-ffa (element-type source) :dimensions (dimensions source)))) (copy-to-destination source destination))) ;;; Copy to a named marray element-type, where the type is a symbol diff --git a/data/iterate.lisp b/data/iterate.lisp index fb999955a33da711450b1b8e30b680827a1f3953..79dc4bb298e72cd95b1245e7e31c693150189445 100644 --- a/data/iterate.lisp +++ b/data/iterate.lisp @@ -1,6 +1,6 @@ ;; Iterate ;; Norman Werner 2009-05-26 22:23:40EDT iterate.lisp -;; Time-stamp: <2009-06-05 09:00:48EDT iterate.lisp> +;; Time-stamp: <2009-12-21 09:04:18EST iterate.lisp> (in-package :iter) @@ -23,7 +23,7 @@ As an example try: :size-fn (lambda (marray) (check-type marray gsl:matrix) - (gsll:dim0 marray)) + (c-array:dim0 marray)) :element-type t :sequence-type t :element-doc-string "(copied) rows of a matrix" :index-doc-string "index of the rows in a matrix") @@ -36,7 +36,7 @@ As an example try: :size-fn (lambda (marray) (check-type marray gsl:matrix) - (gsll:dim1 marray)) + (c-array:dim1 marray)) :element-type t :sequence-type t :element-doc-string "(copied) columns of a matrix" :index-doc-string "index of the columns in a matrix") @@ -49,7 +49,7 @@ As an example try: :size-fn (lambda (vector) (check-type vector gsl:mvector) - (gsll:dim0 vector)) + (c-array:dim0 vector)) :element-type t :sequence-type t :element-doc-string "(copied) elements of a vector" :index-doc-string "index of elements in a vector") @@ -63,8 +63,8 @@ As an example try: (with ,m = ,matrix) (with ,row-index = 0) (with ,col-index = 0) - (with ,row-size = (gsl:dim0 ,m)) - (with ,col-size = (gsl:dim1 ,m)) + (with ,row-size = (c-array:dim0 ,m)) + (with ,col-size = (c-array:dim1 ,m)) (for ,element :next (if (>= ,row-index ,row-size) @@ -91,8 +91,8 @@ As an example try: (with ,m = ,matrix) (with ,row-index = 0) (with ,col-index = 0) - (with ,row-size = (gsll:dim0 ,m)) - (with ,col-size = (gsll:dim1 ,m)) + (with ,row-size = (c-array:dim0 ,m)) + (with ,col-size = (c-array:dim1 ,m)) (for ,indexes next (if (>= ,row-index ,row-size) (terminate) (if (>= ,col-index ,col-size) diff --git a/data/maref.lisp b/data/maref.lisp index 205553444176b41943dc69fdcf1c8b7c2cd6fa29..d026a257a4eaaeebb273bed3a2ada82d1b9e7a03 100644 --- a/data/maref.lisp +++ b/data/maref.lisp @@ -1,6 +1,6 @@ ;; Get/set array or elements: cl-array, maref ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp -;; Time-stamp: <2009-12-07 22:51:18EST maref.lisp> +;; Time-stamp: <2009-12-21 08:17:03EST maref.lisp> ;; $Id: $ (in-package :gsl) @@ -18,7 +18,7 @@ ;;; Both these functions take one of the following class arguments for ;;; the array: -;;; - a foreign-array +;;; - a c-array:foreign-array ;;; - a Common Lisp array ;;; - a pointer to a GSL vector or matrix structure @@ -28,11 +28,11 @@ (defgeneric cl-array (object &optional array-rank element-type) (:documentation - "The array as a CL native array. The object may be a foreign-array object, + "The array as a CL native array. The object may be a c-array:foreign-array object, a pointer to a GSL vector or matrix, or an ordinary CL array of one or two dimensions. Optional arguments array-rank and element-type are used only for pointers.") - (:method ((object foreign-array) &optional array-rank element-type) + (:method ((object c-array:foreign-array) &optional array-rank element-type) (declare (ignore array-rank element-type)) #-native (copy-c-to-cl object) (slot-value object 'cl-array)) @@ -47,9 +47,9 @@ (defgeneric maref (object index &optional index2 type) (:documentation - "An element of the data. The object may be a foreign-array object, a pointer to + "An element of the data. The object may be a c-array:foreign-array object, a pointer to a GSL vector or matrix, or an ordinary CL array of one or two dimensions.") - (:method ((object foreign-array) index &optional index2 type) + (:method ((object c-array:foreign-array) index &optional index2 type) (declare (ignore type)) #-native (copy-c-to-cl object) (if index2 @@ -67,10 +67,10 @@ (defgeneric (setf maref) (value object index &optional index2 type) (:documentation - "Set an element of the data. The object may be a foreign-array object, + "Set an element of the data. The object may be a c-array:foreign-array object, a pointer to a GSL vector or matrix, or an ordinary CL array of one or two dimensions.") - (:method (value (object foreign-array) index &optional index2 type) + (:method (value (object c-array:foreign-array) index &optional index2 type) (declare (ignore type)) (if index2 (setf (aref (slot-value object 'cl-array) index index2) value) diff --git a/data/marray.lisp b/data/marray.lisp index 34c2f3d7f3004545af0c8e7020636385646391ce..ccf3a35c3b5a93c21c2d9c9ffa5ec4491eda3238 100644 --- a/data/marray.lisp +++ b/data/marray.lisp @@ -1,6 +1,6 @@ ;; A "marray" is an array in both GSL and CL ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2009-12-07 22:46:41EST marray.lisp> +;; Time-stamp: <2009-12-21 08:32:09EST marray.lisp> (in-package :gsl) @@ -8,21 +8,21 @@ ;;;; The class marray and its construction ;;;;**************************************************************************** -(defclass marray (mobject foreign-array) +(defclass marray (mobject c-array:foreign-array) ((block-pointer :initarg :block-pointer :reader block-pointer) (total-size :reader size)) (:documentation "A superclass for arrays represented in GSL and CL.")) ;;; We don't allocate or free the C array data, because that is -;;; handled by foreign-array. We can use the GSL functions +;;; handled by c-array:foreign-array. We can use the GSL functions ;;; *_alloc_from_block because they will allocate only the structure, ;;; but we must use CFFI to allocate the block structure; otherwise ;;; GSL would try to allocate the C array. We do not use any of the ;;; GSL free functions because they would free the C array data. (defmethod initialize-instance :after ((object marray) &rest initargs) - (declare (ignore initargs)) ; required by &rest arg for foreign-array? + (declare (ignore initargs)) ; required by &rest arg for c-array:foreign-array? ;; Need to check that all allocations succeeded. ;; Don't do anything if mpointer has been assigned (shouldn't happen) ;; or this is a permutation or combination (they have their own methods). diff --git a/data/permutation.lisp b/data/permutation.lisp index 8030cb8d345d7edc9acdeb5f14c20db1ab9d50cc..8e3c7f1edd30e09c200d48f9c6ab8d93f1c67164 100644 --- a/data/permutation.lisp +++ b/data/permutation.lisp @@ -1,6 +1,6 @@ ;; Permutations ;; Liam Healy, Sun Mar 26 2006 - 11:51 -;; Time-stamp: <2009-11-14 10:52:43EST permutation.lisp> +;; Time-stamp: <2009-12-21 08:17:05EST permutation.lisp> ;; $Id$ (in-package :gsl) @@ -11,7 +11,7 @@ ;;;; Permutation structure and CL object ;;;;**************************************************************************** -(defclass permutation (mobject foreign-array) +(defclass permutation (mobject c-array:foreign-array) ((element-type :initform #+int64 '(unsigned-byte 64) diff --git a/data/foreign-array.lisp b/grid/foreign-array.lisp similarity index 96% rename from data/foreign-array.lisp rename to grid/foreign-array.lisp index 48b6771a1c7142823a8d812d63d769173c09b5e0..13dc3d06cb4b7be65c402925447ad30940882213 100644 --- a/data/foreign-array.lisp +++ b/grid/foreign-array.lisp @@ -1,15 +1,15 @@ -;; Foreign arrays (usually in C) +;; Foreign (C or C-compatible) arrays ;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp -;; Time-stamp: <2009-12-06 21:56:58EST foreign-array.lisp> -;; $Id: $ +;; Time-stamp: <2009-12-21 09:04:05EST foreign-array.lisp> -(in-package :gsl) +(in-package :c-array) ;;;;**************************************************************************** ;;;; Object and methods ;;;;**************************************************************************** -(export '(dimensions total-size element-type)) +(export + '(foreign-array cl-array dimensions total-size element-type element-size)) #-native (defgeneric (setf cl-invalid) (value object) ; do nothing diff --git a/data/foreign-friendly.lisp b/grid/foreign-friendly.lisp similarity index 95% rename from data/foreign-friendly.lisp rename to grid/foreign-friendly.lisp index 748b75f88db332d214a60f56019d6db729390433..34d821596d4527ef24693a1bd045d949501531a9 100644 --- a/data/foreign-friendly.lisp +++ b/grid/foreign-friendly.lisp @@ -1,20 +1,20 @@ ;; Use the foreign-friendly arrays package. ;; Liam Healy 2008-03-22 15:40:08EDT -;; Time-stamp: <2009-12-07 22:51:17EST foreign-friendly.lisp> -;; $Id$ +;; Time-stamp: <2009-12-21 08:34:21EST foreign-friendly.lisp> ;;; Foreign-friendly arrays (original implementation by Tamas Papp) ;;; http://www.princeton.edu/~tpapp/software.html ;;; The replacements here don't do coercions or checks ;;; on type as they are unnecessary, and handle complex types. -(in-package :gsl) +(in-package :c-array) + +(export '(make-ffa native-pointer-protect c-pointer)) ;;;;**************************************************************************** ;;;; Make arrays for possible foreign use ;;;;**************************************************************************** -(export 'make-ffa) (defun make-ffa (element-type &key dimensions (initial-element nil initial-element-p) @@ -23,9 +23,9 @@ "Make an array of one or two dimensions for possible use in foreign code. Syntax is similar to make-array, but note that element-type is mandatory and limited to certain types." - (assert (member element-type c-array:*array-element-types* :test 'equal) + (assert (member element-type *array-element-types* :test 'equal) (element-type) - "Specified element-type must be one of c-array:*array-element-types*.") + "Specified element-type must be one of *array-element-types*.") (let* ((initial-matrix (listp (first initial-contents))) (complex-initial-real (and initial-contents-p diff --git a/grid/pkgdcl.lisp b/grid/pkgdcl.lisp index 0ed9e128b4aab4b599ccbb3ccdc9c50454e2f815..36a6110f25525e188f54c913ac80f8b7e03294a4 100644 --- a/grid/pkgdcl.lisp +++ b/grid/pkgdcl.lisp @@ -1,8 +1,12 @@ ;; Declaration of package ;; Liam Healy 2009-12-06 19:41:09EST pkgdcl.lisp -;; Time-stamp: <2009-12-06 19:41:51EST pkgdcl.lisp> +;; Time-stamp: <2009-12-21 08:56:53EST pkgdcl.lisp> (in-package :cl-user) (defpackage c-array (:use :common-lisp :cffi)) + +#+sbcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (pushnew :native *features*)) diff --git a/gsll.asd b/gsll.asd index ded20826b86050dafbb12e2d9642ca6c560d1038..84ab95647e04b9bbcc7dea07308ce7790c820de6 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-12-20 22:50:14EST gsll.asd> +;; Time-stamp: <2009-12-21 08:45:28EST gsll.asd> (when (asdf:find-system :fsbv nil) (pushnew :fsbv *features*)) @@ -24,7 +24,9 @@ (:file "element-types" :depends-on ("pkgdcl")) (:file "symbol-type" :depends-on ("pkgdcl")) (:file "number-conversion" - :depends-on ("pkgdcl" "complex-types" "symbol-type")))) + :depends-on ("pkgdcl" "complex-types" "symbol-type")) + (:file "foreign-friendly" :depends-on ("pkgdcl")) + (:file "foreign-array" :depends-on ("pkgdcl" "foreign-friendly")))) (:module init :depends-on (grid) :components @@ -67,10 +69,8 @@ (:module data :depends-on (init grid) :components - ((:file "foreign-friendly") - (:file "foreign-array" :depends-on ("foreign-friendly")) - (cffi-grovel:grovel-file "array-structs") - (:file "marray" :depends-on ("foreign-array" "array-structs")) + ((cffi-grovel:grovel-file "array-structs") + (:file "marray" :depends-on ("array-structs")) (:file "vector" :depends-on ("marray" "array-structs")) (:file "matrix" :depends-on ("marray" "vector" "array-structs")) (:file "maref" :depends-on ("marray" "vector" "matrix")) diff --git a/init/defmfun-single.lisp b/init/defmfun-single.lisp index 0b087854911584a1f732749ecfb3e5a071646e74..938552806744b79f956a39478606b7810a32e384 100644 --- a/init/defmfun-single.lisp +++ b/init/defmfun-single.lisp @@ -1,6 +1,6 @@ ;; Helpers that define a single GSL function interface ;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp -;; Time-stamp: <2009-12-20 22:34:33EST defmfun-single.lisp> +;; Time-stamp: <2009-12-21 08:35:23EST defmfun-single.lisp> ;; $Id: $ (in-package :gsl) @@ -39,7 +39,7 @@ and protects it during execution of the body." (if array-symbols ;; http://www.sbcl.org/manual/Calling-Lisp-From-C.html - (native-pointer-protect array-symbols body) + (c-array:native-pointer-protect array-symbols body) body)) (define-condition obsolete-gsl-version (error) diff --git a/init/init.lisp b/init/init.lisp index 751e0729740b446936aac9143d030d563868ea8b..67f950feafd3f3aff8841aeb9895ae47ea65380a 100644 --- a/init/init.lisp +++ b/init/init.lisp @@ -1,11 +1,15 @@ ;; Load GSL ;; Liam Healy Sat Mar 4 2006 - 18:53 -;; Time-stamp: <2009-08-23 10:15:53EDT init.lisp> +;; Time-stamp: <2009-12-21 08:59:29EST init.lisp> ;; $Id$ (defpackage gsll (:nicknames :gsl) - (:use :common-lisp :cffi)) + (:use :common-lisp :cffi) + (:import-from + :c-array + #:cl-array #:dimensions #:total-size #:element-type #:dim0 #:dim1 + #:c-pointer)) (cffi:define-foreign-library libgslcblas (:darwin @@ -35,6 +39,3 @@ (cffi:use-foreign-library libgsl) -#+sbcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (pushnew :native *features*)) diff --git a/random/shuffling-sampling.lisp b/random/shuffling-sampling.lisp index d9be085f0da6d5e14381682604beab36e232d8e9..36bb22ef3a9298048a20dc52dcae2e9181f96c1d 100644 --- a/random/shuffling-sampling.lisp +++ b/random/shuffling-sampling.lisp @@ -1,6 +1,6 @@ ;; Shuffling and sampling ;; Liam Healy, Sat Dec 2 2006 - 18:40 -;; Time-stamp: <2009-05-24 23:13:40EDT shuffling-sampling.lisp> +;; Time-stamp: <2009-12-21 09:04:36EST shuffling-sampling.lisp> ;; $Id$ (in-package :gsl) @@ -12,7 +12,7 @@ &key base) "gsl_ran_shuffle" (((mpointer generator) :pointer) - ((c-pointer base) :pointer) ((dim0 base) sizet) ((element-size base) sizet)) + ((c-pointer base) :pointer) ((dim0 base) sizet) ((c-array:element-size base) sizet)) :definition :method :inputs (base) :outputs (base) @@ -36,7 +36,7 @@ "gsl_ran_choose" (((mpointer generator) :pointer) ((c-pointer destarr) :pointer) ((dim0 destarr) sizet) - ((c-pointer src) :pointer) ((dim0 src) sizet) ((element-size src) sizet)) + ((c-pointer src) :pointer) ((dim0 src) sizet) ((c-array:element-size src) sizet)) :definition :method :inputs (destarr src) :outputs (destarr) @@ -64,7 +64,7 @@ "gsl_ran_sample" (((mpointer generator) :pointer) ((c-pointer destarr) :pointer) ((dim0 destarr) sizet) - ((c-pointer src) :pointer) ((dim0 src) sizet) ((element-size src) sizet)) + ((c-pointer src) :pointer) ((dim0 src) sizet) ((c-array:element-size src) sizet)) :definition :method :inputs (destarr src) :outputs (destarr)