Changeset 37 for trunk

Timestamp:

03/16/08 02:25:01 (8 months ago)

Author:

lhealy

Message:

The functions #'sort-vector-smallest-index and
#'sort-vector-largest-index now work on 64-bit platforms. It was
necessary to change the API in order to do this: instead of taking a
GSL vector fixnum as the first argument, they now take either a
positive integer, or a CL vector. This is because it appears to be
very difficult to find a GSL vector type that matches a C array of
size_ts. Thus, the GSLL policy of using only GSL vectors and not raw
C vectors needs to be altered. However, now the GSLL policy of not
requiring an object to be passed as an argument if it is used only
for returning values is fulfilled.

Location:

trunk

Files:

• documentation/documentation.html (modified) (3 diffs)
• init/interface.lisp (modified) (5 diffs)
• sorting.lisp (modified) (8 diffs)

trunk/documentation/documentation.html

@@ -119 +119 @@
  properly, unless CFFI and the CL platform provide C stream
  compatibility.
-<li>Some <a href="Sorting.html">sorting</a> functions fail on amd64 platforms,
- perhaps because of lack of unsigned integer vectors.
 <li><a href="BLAS-Support.html">BLAS</a> is completed, but with only very
  limited testing.
@@ -141 +139 @@
 <ul>
 <li>CLISP shows three "foreign callout errors". Remedy unknown.
-<li>Sorting shows two failures on amd64 platforms.  This is possibly
-because of the use of integer vectors to store unsigned integer
-vectors.
 <li>There are several regression failures that are apparently due to
 changes in GSL between versions 1.8 and 1.10.  These are:
@@ -156 +151 @@
 <!-- hhmts start -->
     <small>
-       Time-stamp: <2008-03-09 22:21:24EDT documentation.html>
+       Time-stamp: <2008-03-15 21:59:58EDT documentation.html>
        </small>
 <!-- hhmts end -->

trunk/init/interface.lisp

@@ -1 +1 @@
 ;; Macros to interface GSL functions.
 ;; Liam Healy 
-;; Time-stamp: <2008-03-02 21:43:02EST interface.lisp>
+;; Time-stamp: <2008-03-15 21:51:07EDT interface.lisp>
 ;; $Id$
 
@@ -150 +150 @@
 ;;; after        After method.
 ;;; enumeration  The name of the enumeration return.
+;;; global     Bind variable(s) in a let* enclosing the whole body.
 (defmacro defmfun
     (name arglist gsl-name c-arguments
@@ -155 +156 @@
      (return nil return-supplied-p)
      (type :function) (index t) (export (not (eq type :method)))
-     null-pointer-info documentation invalidate after enumeration)
+     null-pointer-info documentation invalidate after enumeration
+     global)
   (let* ((cargs (substitute '(mode sf-mode) :mode c-arguments))
          (carg-symbs
@@ -171 +173 @@
           (if (listp c-return) (st-symbol c-return) (make-symbol "CRETURN")))
          (allocated                  ; Foreign objects to be allocated
-          (remove-if (lambda (s) (member s arglist-symbs)) carg-symbs))
+          (remove-if
+           (lambda (s) (or (member s arglist-symbs) (member s global :key #'first)))
+           carg-symbs))
          (allocated-decl
           (mapcar
@@ -185 +189 @@
       (,(if (eq type :function) 'defun 'defmethod)
        ,name
-       ,(if (member :mode c-arguments)
-            `(,@clargs &optional (mode :double-prec))
-            `(,@clargs))
+       ,(let ((noaux
+               (if (member :mode c-arguments)
+                   `(,@clargs &optional (mode :double-prec))
+                   `(,@clargs))))
+             (if global
+                 (append noaux (cons '&aux global))
+                 noaux))
        ,(declaration-form clargs-types)
        ,@(when documentation (list documentation))

trunk/sorting.lisp

@@ -1 +1 @@
 ;; Sorting
 ;; Liam Healy, Fri Apr 14 2006 - 20:20
-;; Time-stamp: <2008-03-09 21:42:24EDT sorting.lisp>
+;; Time-stamp: <2008-03-15 22:09:56EDT sorting.lisp>
 ;; $Id$
 
@@ -8 +8 @@
 ;;; #'heapsort has just a cursory port, use CL's #'sort.
 ;;; Raw C array functions not ported, not policy.
-
-;;; Errors:
-;;; sort-vector-smallest-index and sort-vector-largest-index
-;;; do not work on amd64/SBCL, and should be defined in terms of
-;;; vector-unsigned-fixnum anyway
 
 ;;;;****************************************************************************
@@ -93 +88 @@
   :invalidate (dest))
 
-;;; p should be gsl-vector-unsigned-fixnum, if that can be made to
-;;; work (see vector.lisp).
 (export 'sort-vector-smallest-index)
-(defgeneric sort-vector-smallest-index (p vector)
-  (:documentation                       ; FDL
-   "The indices of the smallest elements of the vector stored
-   in the array p."))
+(defgeneric sort-vector-smallest-index (indices vector)
+  (:documentation
+   "The indices of the smallest elements of the vector stored,
+    returned as a CL vector of element type fixnum.  If
+    indices is a positive initeger, a vector will be
+    allocated and returned.  If it is a CL vector,
+    it will be filled with the indices."))
 
 (defmfun-vdsf sort-vector-smallest-index
-    ((p vector-fixnum) (v vector))
+    (indices (v vector))
   "gsl_sort_vector_smallest_index"
-  (((gsl-array p) :pointer) ((dim0 p) size)
-   ((pointer v) gsl-vector-c))
-  :c-return :void
-  :invalidate (p))
+  ((p (size number)) (number size) ((pointer v) :pointer))
+  :type :method
+  :global ((number (if (numberp indices) indices (length indices))))
+  :c-return :void
+  :return
+  ((let* ((vector
+           (if (numberp indices)
+               (make-array (list indices) :element-type 'fixnum)
+               indices)))
+     (dotimes (i number vector)
+       (setf (aref vector i) (scref p i))))))
 
 (export 'sort-vector-largest)
@@ -125 +128 @@
 ;;; p should be gsl-vector-unsigned-fixnum, if that can be made to
 ;;; work (see vector.lisp).
-(defgeneric sort-vector-largest-index (p vector)
-  (:documentation                       ; FDL
-   "The indices of the largest elements of the vector stored
-   in the array p."))
-
-(defmfun-vdsf sort-vector-largest-index
-    ((p vector-fixnum) (v vector))
+(defgeneric sort-vector-largest-index (indices vector)
+  (:documentation               
+   "The indices of the largest elements of the vector stored,
+    returned as a CL vector of element type fixnum.  If
+    indices is a positive initeger, a vector will be
+    allocated and returned.  If it is a CL vector,
+    it will be filled with the indices."))
+
+(defmfun-vdsf sort-vector-largest-index (indices (v vector))
   "gsl_sort_vector_largest_index"
-  (((gsl-array p) :pointer) ((dim0 p) size)
-   ((pointer v) gsl-vector-c))
-  :c-return :void
-  :invalidate (p))
+  ((p (size number)) (number size) ((pointer v) :pointer))
+  :type :method
+  :global ((number (if (numberp indices) indices (length indices))))
+  :c-return :void
+  :return
+  ((let* ((vector
+           (if (numberp indices)
+               (make-array (list indices) :element-type 'fixnum)
+               indices)))
+     (dotimes (i number vector)
+       (setf (aref vector i) (scref p i))))))
 
 ;;;;****************************************************************************
@@ -155 +167 @@
    (sort-vector-smallest smallest vec)
    (data smallest))
- (letm ((vec (vector-double-float #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
-        (smallest (vector-fixnum 3)))
-   (sort-vector-smallest-index smallest vec)
-   (data smallest))
+ (letm ((vec (vector-double-float #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
+   (sort-vector-smallest-index 3 vec))
  (letm ((vec (vector-double-float #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
         (largest (vector-double-float 3)))
    (sort-vector-largest largest vec)
    (data largest))
- (letm ((vec (vector-double-float #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
-        (largest (vector-fixnum 3)))
-   (sort-vector-largest-index largest vec)
-   (data largest)))
+ (letm ((vec (vector-double-float #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
+   (sort-vector-largest-index 3 vec)))
 |#
 
+
 (LISP-UNIT:DEFINE-TEST SORTING
   (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
    (LIST #(-3.21d0 -2.0d0 1.0d0 7.1d0 12.8d0))
    (MULTIPLE-VALUE-LIST
-    (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
+    (LETM
+        ((VEC
+          (VECTOR-DOUBLE-FLOAT
+           #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
       (SORT-VECTOR VEC) (DATA VEC))))
   (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
@@ -179 +191 @@
    (MULTIPLE-VALUE-LIST
     (LETM ((PERM (PERMUTATION 5))
-         (VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
+           (VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
       (SORT-VECTOR-INDEX PERM VEC)
       (DATA PERM))))
@@ -186 +198 @@
    (MULTIPLE-VALUE-LIST
     (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
-         (SMALLEST (VECTOR-DOUBLE-FLOAT 3)))
+           (SMALLEST (VECTOR-DOUBLE-FLOAT 3)))
       (SORT-VECTOR-SMALLEST SMALLEST VEC)
       (DATA SMALLEST))))
@@ -192 +204 @@
    (LIST #(3 1 4))
    (MULTIPLE-VALUE-LIST
+    (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
+      (SORT-VECTOR-SMALLEST-INDEX 3 VEC))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST #(12.8d0 7.1d0 1.0d0))
+   (MULTIPLE-VALUE-LIST
     (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
-         (SMALLEST (VECTOR-FIXNUM 3)))
-      (SORT-VECTOR-SMALLEST-INDEX
-       SMALLEST VEC)
-      (DATA SMALLEST))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
-   (LIST #(12.8d0 7.1d0 1.0d0))
-   (MULTIPLE-VALUE-LIST
-    (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
-         (LARGEST (VECTOR-DOUBLE-FLOAT 3)))
+           (LARGEST (VECTOR-DOUBLE-FLOAT 3)))
       (SORT-VECTOR-LARGEST LARGEST VEC) (DATA LARGEST))))
   (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
    (LIST #(2 0 4))
    (MULTIPLE-VALUE-LIST
-    (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0)))
-         (LARGEST (VECTOR-FIXNUM 3)))
-      (SORT-VECTOR-LARGEST-INDEX LARGEST VEC)
-      (DATA LARGEST)))))
+    (LETM ((VEC (VECTOR-DOUBLE-FLOAT #(7.1d0 -2.0d0 12.8d0 -3.21d0 1.0d0))))
+      (SORT-VECTOR-LARGEST-INDEX 3 VEC)))))