From e5d0cfa7ae42310923f8ea71c0f86172e258d0e0 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Sun, 27 Jun 2010 22:05:10 -0400 Subject: [PATCH] Reorder block allocation, replace marray class Set the contents of the block structure before using it in alloc-from-block. Replace the 'marray class with 'foreign-array. Quote foreign struct slots. Eliminate copy methods. Now simple operations like 'vector-reverse work. --- data/both.lisp | 15 ++++++----- data/foreign-array.lisp | 58 ++++++++++++++++++++--------------------- data/matrix.lisp | 12 +-------- data/vector.lisp | 10 +------ gsll.asd | 22 ++++++++-------- init/defmfun-array.lisp | 4 +-- init/init.lisp | 5 ++-- 7 files changed, 55 insertions(+), 71 deletions(-) diff --git a/data/both.lisp b/data/both.lisp index 49133350..72b50ee7 100644 --- a/data/both.lisp +++ b/data/both.lisp @@ -1,6 +1,6 @@ ;; Functions for both vectors and matrices. ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp -;; Time-stamp: <2010-06-27 18:03:26EDT both.lisp> +;; Time-stamp: <2010-06-27 21:31:00EDT both.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -28,7 +28,7 @@ ("gsl_" :category :type "_alloc_from_block") ((blockptr :pointer) (0 sizet) ; offset - ((size object) sizet) ; number of elements + ((total-size object) sizet) ; number of elements (1 sizet)) ; stride :definition :generic :c-return :pointer @@ -68,6 +68,8 @@ :c-return :void :documentation "Set all elements to 0.") +#| +;;; These will be handled by grid functions/CFFI; do we need to use GSL's routines? (defmfun grid:copy-to-destination ((source both) (destination both)) ("gsl_" :category :type "_memcpy") @@ -86,6 +88,7 @@ :inputs (source) :outputs (destination) :return (destination)) +|# (defmfun swap ((a both) (b both)) ("gsl_" :category :type "_swap") @@ -175,7 +178,7 @@ :documentation ; FDL "Add the scalar complex x to all the elements of array a.") -(defmethod elt+ ((x float) (a marray)) +(defmethod elt+ ((x float) (a foreign-array)) (elt+ a x)) (defmfun elt- ((a both) (b both)) @@ -190,7 +193,7 @@ "Subtract the elements of b from the elements of a. The two must have the same dimensions.") -(defmethod elt- ((a marray) (x float)) +(defmethod elt- ((a foreign-array) (x float)) (elt+ a (- x))) (defmfun elt* ((a vector) (b vector)) @@ -235,7 +238,7 @@ :outputs (a) :return (a)) -(defmethod elt/ ((a marray) (x number)) +(defmethod elt/ ((a foreign-array) (x number)) (elt* a (/ x))) (defmfun elt* ((a both) (x float)) @@ -262,7 +265,7 @@ :documentation ; FDL "Multiply the elements of a by the scalar complex factor x.") -(defmethod elt* ((x float) (a marray)) +(defmethod elt* ((x float) (a foreign-array)) (elt* a x)) ;;;;**************************************************************************** diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp index 55b4eb4b..e6e494f7 100644 --- a/data/foreign-array.lisp +++ b/data/foreign-array.lisp @@ -1,6 +1,6 @@ ;; A grid:foreign-array with added metadata for GSL. ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2010-06-27 18:27:37EDT foreign-array.lisp> +;; Time-stamp: <2010-06-27 21:49:36EDT foreign-array.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -32,7 +32,7 @@ ;;; GSL free functions because they would free the C array data. (defmacro metadata-slot (object name) - `(getf (foreign-metadata ,object) ,name)) + `(getf (slot-value ,object 'grid:foreign-metadata) ,name)) (defun make-gsl-metadata (object) "Make the necessary GSL metadata (mpointer and block-pointer) @@ -43,26 +43,26 @@ (unless (metadata-slot object 'mpointer) (when (zerop (total-size object)) (error "Object ~a has zero total dimension." object)) - (let* ((blockptr (cffi:foreign-alloc 'gsl-block-c)) ; check this result - ;; it is not clear what foreign-alloc does if the alloc fails. - (array-struct (alloc-from-block object blockptr))) + (let ((blockptr (cffi:foreign-alloc 'gsl-block-c))) (setf (cffi:foreign-slot-value blockptr 'gsl-block-c 'size) (grid:total-size object) (cffi:foreign-slot-value blockptr 'gsl-block-c 'data) (foreign-pointer object) - (metadata-slot object 'block-pointer) blockptr - (metadata-slot object 'mpointer) array-struct - ;; alloc-from-block automatically copies over the data pointer - ;; from the block to the vector/matrix; we must do that manually here - (cffi:foreign-slot-value - array-struct - (if (typep object 'matrix) 'gsl-matrix-c 'gsl-vector-c) 'data) - (foreign-pointer object)) - (tg:finalize object - (lambda () - (cffi:foreign-free blockptr) - (cffi:foreign-free array-struct)))) - (metadata-slot object 'mpointer))) + (metadata-slot object 'block-pointer) blockptr) + (let ((array-struct (alloc-from-block object blockptr))) + (setf + (metadata-slot object 'mpointer) array-struct + ;; alloc-from-block automatically copies over the data pointer + ;; from the block to the vector/matrix; we must do that manually here + (cffi:foreign-slot-value + array-struct + (if (typep object 'matrix) 'gsl-matrix-c 'gsl-vector-c) 'data) + (foreign-pointer object)) + (tg:finalize object + (lambda () + (cffi:foreign-free blockptr) + (cffi:foreign-free array-struct)))) + (metadata-slot object 'mpointer)))) (defmethod mpointer ((object grid:foreign-array)) (or @@ -76,17 +76,15 @@ ;;;;;;; There are >1400 calls to make-marray, write an emulation? ;;; This should probably be moved/renamed grid:make-foreign-array. (export 'make-marray) -(defun make-marray - (element-type &rest keys &key dimensions initial-contents - &allow-other-keys) +(defun make-marray (element-type &rest keys &key dimensions &allow-other-keys) "Make a GSLL array with the given element type, :dimensions, and :initial-contents, :initial-element or :data." (when (subtypep element-type 'grid:foreign-array) - (error "Can't take a class name here anymore, sorry.") - (apply - 'grid:make-grid - `((grid:foreign-array ,@dimensions) element-type) - keys))) + (error "Can't take a class name here anymore, sorry.")) + (apply + 'grid:make-grid + `((grid:foreign-array ,@dimensions) element-type) + keys)) (defun make-marray-or-default (default dimensions @@ -122,12 +120,12 @@ (grid:make-grid (case category (:vector - `((foreign-array ,(cffi:foreign-slot-value mpointer cstruct size)) + `((foreign-array ,(cffi:foreign-slot-value mpointer cstruct 'size)) ,element-type)) (:matrix `((foreign-array - ,(cffi:foreign-slot-value mpointer cstruct size0) - ,(cffi:foreign-slot-value mpointer cstruct size1))) - ,element-type)) + ,(cffi:foreign-slot-value mpointer cstruct 'size0) + ,(cffi:foreign-slot-value mpointer cstruct 'size1)) + ,element-type))) :foreign-pointer foreign-pointer :foreign-metadata mpointer))) diff --git a/data/matrix.lisp b/data/matrix.lisp index fee58c4c..e1d59ea2 100644 --- a/data/matrix.lisp +++ b/data/matrix.lisp @@ -1,6 +1,6 @@ ;; Matrices ;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp -;; Time-stamp: <2010-06-27 18:03:26EDT matrix.lisp> +;; Time-stamp: <2010-06-27 21:27:22EDT matrix.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -36,16 +36,6 @@ collect (loop for j below dim1 collect (maref pointer i j element-type))))) -(defmethod grid:copy-to-destination - ((object matrix) (pointer #.+foreign-pointer-class+)) - (foreign-pointer-method - pointer - (loop for i below (dim0 object) - do (loop for j below (dim1 object) - do - (setf (maref pointer i j (element-type object)) - (maref object i j)))))) - ;;;;**************************************************************************** ;;;; Mathematical ;;;;**************************************************************************** diff --git a/data/vector.lisp b/data/vector.lisp index d37fe787..18b7ebb2 100644 --- a/data/vector.lisp +++ b/data/vector.lisp @@ -1,6 +1,6 @@ ;; Vectors ;; Liam Healy 2008-04-13 09:39:02EDT vector.lisp -;; Time-stamp: <2010-06-27 18:03:25EDT vector.lisp> +;; Time-stamp: <2010-06-27 21:09:42EDT vector.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -32,14 +32,6 @@ (loop for i below (cffi:foreign-slot-value pointer struct-type 'size) collect (maref pointer i nil element-type))) -(defmethod grid:copy-to-destination - ((object mvector) (pointer #.+foreign-pointer-class+)) - (foreign-pointer-method - pointer - (loop for i below (dim0 object) - do (setf (maref pointer i nil (element-type object)) - (maref object i))))) - ;;;;**************************************************************************** ;;;; Function definitions ;;;;**************************************************************************** diff --git a/gsll.asd b/gsll.asd index 13f47de5..9d72962f 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2010-06-27 17:57:19EDT gsll.asd> +;; Time-stamp: <2010-06-27 21:22:11EDT gsll.asd> ;; ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -70,20 +70,20 @@ ((:file "mathematical") #+fsbv (:file "complex"))) - #+(or) (:module data :depends-on (init) :components ((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")) - (:file "both" :depends-on ("marray" "vector" "matrix")) - (:file "copy-cl") - (:file "array-tests" :depends-on ("both")) - (:file "permutation" :depends-on ("marray" "array-structs")) - (:file "combination" :depends-on ("marray" "array-structs")))) + (:file "foreign-array" :depends-on ("array-structs")) + (:file "vector" :depends-on ("foreign-array" "array-structs")) + (:file "matrix" :depends-on ("foreign-array" "vector" "array-structs")) + ;(:file "maref" :depends-on ("foreign-array" "vector" "matrix")) + (:file "both" :depends-on ("foreign-array" "vector" "matrix")) + ;(:file "copy-cl") + ;(:file "array-tests" :depends-on ("both")) + ;(:file "permutation" :depends-on ("foreign-array" "array-structs")) + ;(:file "combination" :depends-on ("foreign-array" "array-structs")) + )) #+(or) (:file "polynomial" :depends-on (init data)) #+(or) diff --git a/init/defmfun-array.lisp b/init/defmfun-array.lisp index ecd29c75..273feb8d 100644 --- a/init/defmfun-array.lisp +++ b/init/defmfun-array.lisp @@ -1,6 +1,6 @@ ;; Helpers for defining GSL functions on arrays ;; Liam Healy 2009-01-07 22:01:16EST defmfun-array.lisp -;; Time-stamp: <2010-06-27 18:03:21EDT defmfun-array.lisp> +;; Time-stamp: <2010-06-27 21:11:54EDT defmfun-array.lisp> ;; ;; Copyright 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -164,7 +164,7 @@ (:component-float-type (grid:number-class (grid:component-float-type element-type))) (otherwise - (data-class-name + (grid:data-class-name (if (and (eq (second arg) 'both) replace-both) replace-both (second arg)) diff --git a/init/init.lisp b/init/init.lisp index 33fb7301..77291c1d 100644 --- a/init/init.lisp +++ b/init/init.lisp @@ -1,6 +1,6 @@ ;; Load GSL ;; Liam Healy Sat Mar 4 2006 - 18:53 -;; Time-stamp: <2010-06-27 18:20:14EDT init.lisp> +;; Time-stamp: <2010-06-27 21:28:45EDT init.lisp> ;; ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -23,7 +23,8 @@ (:use :common-lisp :cffi) (:import-from :grid - #:cl-array #:dimensions #:total-size #:element-type #:dim0 #:dim1 + #:cl-array #:dimensions #:total-size #:element-type + #:foreign-array #:matrix #:dim0 #:dim1 ; #:copy #:clone ) (:shadowing-import-from :grid #:foreign-pointer) -- GitLab