Commit a9cf4a74 authored by Liam Healy's avatar Liam Healy

Move foreign-array and foreign-friendly to grid

Continuing the separation of definitions useful for any libraries
using C arrays, foreign-array.lisp and foreign-friendly.lisp have been
moved to the grid subdirectory and placed in the c-array package.
All tests pass on SBCL 64,
TOTAL: 1627 assertions passed, 6 failed, 0 execution errors.
parent ce261d71
;; 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)
......
;; 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
......
;; 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)
......
;; 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)
......
;; 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).
......
;; 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)
......
;; 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
......
;; 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
......
;; 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*))
;; 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"))
......
;; 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)
......
;; 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*))
;; 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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment