[lisplab-cvs] r186 - in trunk/src: fft matrix1 util vector1
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sun Oct 24 08:49:57 UTC 2010
Author: jivestgarden
Date: Sun Oct 24 04:49:56 2010
New Revision: 186
Log:
Cleaning + matrix slices
Added:
trunk/src/util/ref.lisp
trunk/src/util/type.lisp
trunk/src/vector1/level1-matrix-slice.lisp
Modified:
trunk/src/fft/level3-fft-zge.lisp
trunk/src/matrix1/level1-classes.lisp
trunk/src/util/ext-store-operators.lisp
trunk/src/util/level1-util.lisp
trunk/src/vector1/level1-vector.lisp
Modified: trunk/src/fft/level3-fft-zge.lisp
==============================================================================
--- trunk/src/fft/level3-fft-zge.lisp (original)
+++ trunk/src/fft/level3-fft-zge.lisp Sun Oct 24 04:49:56 2010
@@ -97,54 +97,6 @@
(fft-radix-2-blas-complex-store! :r (vector-store x) (cols x) i (rows x)))
x)
-(declaim (ftype (function
- (type-blas-store
- type-blas-idx
- type-blas-idx
- type-blas-idx)
- (complex double-float))
- ref-blas-complex-store2))
-
-(declaim (ftype (function
- ((complex double-float)
- type-blas-store
- type-blas-idx
- type-blas-idx
- type-blas-idx
- )
- (complex double-float))
- (setf ref-blas-complex-store2)))
-
-(declaim (inline ref-blas-complex-store2 (setf ref-blas-complex-store2)))
-
-(defun ref-blas-complex-store2 (store i start step)
- "Accessor for the complex blas store"
- (declare (type-blas-idx i start step)
- (type-blas-store store))
- (let* ((idx (truly-the type-blas-idx
- (* 2 (+ (truly-the type-blas-idx (* step i))
- start))))
- (val (complex (aref store idx)
- (aref store (1+ idx)))))
- (declare (type type-blas-idx idx)
- (type (complex double-float) val))
- val))
-
-(defun (setf ref-blas-complex-store2) (value store i start step)
- (declare (type-blas-idx i start step)
- (type-blas-store store)
- ((complex double-float) value) )
- (let ((idx (truly-the type-blas-idx
- (* 2
- (truly-the type-blas-idx
- (+
- (truly-the type-blas-idx (* step i))
- start))))))
- (declare (type-blas-idx idx))
- (setf (aref store idx) (realpart value)
- (aref store (1+ idx)) (imagpart value))
- value))
-
(defun fft-radix-2-blas-complex-store! (direction x n start step)
"Destrutive, radix 2 fast fourier transform. Direction is either :f for
forward or :r for reverse transform. Input must be a
Modified: trunk/src/matrix1/level1-classes.lisp
==============================================================================
--- trunk/src/matrix1/level1-classes.lisp (original)
+++ trunk/src/matrix1/level1-classes.lisp Sun Oct 24 04:49:56 2010
@@ -189,9 +189,7 @@
(cols :initarg :cols
:initform 0
:reader cols
- :type type-blas-idx)
- (size :reader size
- :type type-blas-idx)))
+ :type type-blas-idx)))
(defclass structure-square (structure-base)
((structure-class-name :allocation :class
Modified: trunk/src/util/ext-store-operators.lisp
==============================================================================
--- trunk/src/util/ext-store-operators.lisp (original)
+++ trunk/src/util/ext-store-operators.lisp Sun Oct 24 04:49:56 2010
@@ -58,6 +58,7 @@
;;; number only + and - (*, / and expt mix the real and complex parts)
+
(declaim (inline double-float-simple-array-ref-ext))
(declaim (ftype (function
(type-blas-store
@@ -69,10 +70,7 @@
(defun double-float-simple-array-ref-ext (a i off step)
(declare (type type-blas-idx i off step)
(type type-blas-store a))
- (aref a (truly-the type-blas-idx
- (+ off
- (truly-the type-blas-idx
- (* i step))))))
+ (aref a (column-major-idx off i step)))
(declaim (inline (setf double-float-simple-array-ref-ext)))
(declaim (ftype (function
@@ -87,10 +85,7 @@
(declare (type type-blas-idx i off step)
(type double-float value)
(type type-blas-store a))
- (setf (aref a (truly-the type-blas-idx
- (+ off
- (truly-the type-blas-idx
- (* i step)))))
+ (setf (aref a (column-major-idx off i step))
value)
value)
Modified: trunk/src/util/level1-util.lisp
==============================================================================
--- trunk/src/util/level1-util.lisp (original)
+++ trunk/src/util/level1-util.lisp Sun Oct 24 04:49:56 2010
@@ -30,77 +30,6 @@
(in-package :lisplab)
-;;; Things that are common both for real and complex stores
-
-(deftype type-blas-store ()
- '(simple-array double-float (*)))
-
-#+(and :sbcl :x86) (deftype type-blas-idx ()
- '(MOD #x1FFFFFFF))
-#+(and :sbcl :x86-64) (deftype type-blas-idx ()
- '(MOD #xFFFFFFFFFFFFFFD))
-#-:sbcl (deftype type-blas-idx ()
- 'fixnum)
-
-(declaim (inline column-major-idx))
-
-(declaim (ftype (function
- (type-blas-idx
- type-blas-idx
- type-blas-idx)
- type-blas-idx)
- column-major-idx))
-
-(defun column-major-idx (i j rows)
- (truly-the type-blas-idx (+ i (truly-the type-blas-idx (* j rows)))))
-
-(defun copy-matrix-stores (a b)
- (let ((len (length a)))
- (declare (type type-blas-store a b)
- (type type-blas-idx len))
- (dotimes (i len)
- (setf (aref b i) (aref a i))))
- b)
-
-;;;; The real store
-
-(declaim (inline ref-blas-real-store (setf ref-blas-real-store)))
-
-(declaim (ftype (function
- (type-blas-store
- type-blas-idx
- type-blas-idx
- type-blas-idx)
- double-float)
- ref-blas-real-store))
-
-(defun ref-blas-real-store (store row col rows)
- "Matrix accessor for the real blas store"
- (aref (truly-the type-blas-store store)
- (truly-the type-blas-idx
- (column-major-idx (truly-the type-blas-idx row)
- (truly-the type-blas-idx col)
- rows))))
-
-(declaim (ftype (function
- (double-float
- type-blas-store
- type-blas-idx
- type-blas-idx
- type-blas-idx
- )
- double-float)
- (setf ref-blas-real-store)))
-
-(defun (setf ref-blas-real-store) (value store row col rows)
- (setf (aref (truly-the type-blas-store store)
- (truly-the type-blas-idx
- (column-major-idx (truly-the type-blas-idx row)
- (truly-the type-blas-idx col)
- rows)))
- value)
- value)
-
(defun allocate-real-store (size &optional (initial-element 0d0))
;; All matrix double and complex double constructors
;; should call this one
@@ -153,71 +82,4 @@
(setf (aref store i) rv)))
store))
-(declaim (inline ref-blas-complex-store (setf ref-blas-complex-store)))
-
-(declaim (ftype (function
- (type-blas-store
- type-blas-idx
- type-blas-idx
- type-blas-idx)
- (complex double-float))
- ref-blas-complex-store))
-
-(defun ref-blas-complex-store (store row col rows)
- "Matrix accessor for the complet blas store"
- (let ((idx (truly-the type-blas-idx
- (* 2 (column-major-idx (truly-the type-blas-idx row)
- (truly-the type-blas-idx col)
- rows)))))
- (declare (type-blas-idx idx))
- (complex (aref store idx)
- (aref store (1+ idx)))))
-
-(declaim (ftype (function
- ((complex double-float)
- type-blas-store
- type-blas-idx
- type-blas-idx
- type-blas-idx
- )
- (complex double-float))
- (setf ref-blas-complex-store)))
-
-(defun (setf ref-blas-complex-store) (value store row col rows)
- (let ((idx (truly-the type-blas-idx
- (* 2 (column-major-idx (truly-the type-blas-idx row)
- (truly-the type-blas-idx col)
- rows)))))
- (declare (type-blas-idx idx))
- (setf (aref store idx) (realpart value)
- (aref store (1+ idx)) (imagpart value))
- value))
-
-(declaim (ftype (function
- (type-blas-store
- type-blas-idx)
- (complex double-float))
- vref-blas-complex-store))
-
-(defun vref-blas-complex-store (store idx)
- "Matrix accessor for the complex blas store"
- (let ((idx2 (truly-the type-blas-idx (* 2 idx))))
- (declare (type-blas-idx idx2))
- (complex (aref store idx2)
- (aref store (1+ idx2)))))
-
-(declaim (ftype (function
- ((complex double-float)
- type-blas-store
- type-blas-idx
- )
- (complex double-float))
- (setf vref-blas-complex-store)))
-
-(defun (setf vref-blas-complex-store) (value store idx)
- (let ((idx2 (truly-the type-blas-idx (* 2 idx))))
- (declare (type-blas-idx idx2))
- (setf (aref store idx2) (realpart value)
- (aref store (1+ idx2)) (imagpart value))
- value))
Added: trunk/src/util/ref.lisp
==============================================================================
--- (empty file)
+++ trunk/src/util/ref.lisp Sun Oct 24 04:49:56 2010
@@ -0,0 +1,211 @@
+;;; Lisplab, ref.lisp
+;;; Array reference functions.
+;;; Note, most other files depends on this one !
+;;;
+;;; Copyright (C) 2010 Joern Inge Vestgaarden
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+;;; TODO: change name of this to something about blas store
+;;;
+;;; This file contains manipulations of simple double-float arrays
+;;; and should be called by the spesialized matrix methods.
+;;; The purpose of this layer is that it can be used by
+;;; many classes such as matrix-base-dge and matrix-base-ddi, etc.
+;;;
+;;; The content of this file must be highly optimized
+;;; and should not depend anything exept Common Lisp itself.
+
+(in-package :lisplab)
+
+(declaim (inline column-major-idx))
+
+(declaim (ftype (function
+ (type-blas-idx
+ type-blas-idx
+ type-blas-idx)
+ type-blas-idx)
+ column-major-idx))
+
+(defun column-major-idx (i j rows)
+ (truly-the type-blas-idx (+ i (truly-the type-blas-idx (* j rows)))))
+
+(defun copy-matrix-stores (a b)
+ (let ((len (length a)))
+ (declare (type type-blas-store a b)
+ (type type-blas-idx len))
+ (dotimes (i len)
+ (setf (aref b i) (aref a i))))
+ b)
+
+;;;; The real store
+
+(declaim (inline ref-blas-real-store (setf ref-blas-real-store)))
+
+(declaim (ftype (function
+ (type-blas-store
+ type-blas-idx
+ type-blas-idx
+ type-blas-idx)
+ double-float)
+ ref-blas-real-store))
+
+(defun ref-blas-real-store (store row col rows)
+ "Matrix accessor for the real blas store"
+ (aref (truly-the type-blas-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows))))
+
+(declaim (ftype (function
+ (double-float
+ type-blas-store
+ type-blas-idx
+ type-blas-idx
+ type-blas-idx
+ )
+ double-float)
+ (setf ref-blas-real-store)))
+
+(defun (setf ref-blas-real-store) (value store row col rows)
+ (setf (aref (truly-the type-blas-store store)
+ (truly-the type-blas-idx
+ (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))
+ value)
+ value)
+
+(declaim (inline ref-blas-complex-store (setf ref-blas-complex-store)))
+
+(declaim (ftype (function
+ (type-blas-store
+ type-blas-idx
+ type-blas-idx
+ type-blas-idx)
+ (complex double-float))
+ ref-blas-complex-store))
+
+(defun ref-blas-complex-store (store row col rows)
+ "Matrix accessor for the complet blas store"
+ (let ((idx (truly-the type-blas-idx
+ (* 2 (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))))
+ (declare (type-blas-idx idx))
+ (complex (aref store idx)
+ (aref store (1+ idx)))))
+
+(declaim (ftype (function
+ ((complex double-float)
+ type-blas-store
+ type-blas-idx
+ type-blas-idx
+ type-blas-idx
+ )
+ (complex double-float))
+ (setf ref-blas-complex-store)))
+
+(defun (setf ref-blas-complex-store) (value store row col rows)
+ (let ((idx (truly-the type-blas-idx
+ (* 2 (column-major-idx (truly-the type-blas-idx row)
+ (truly-the type-blas-idx col)
+ rows)))))
+ (declare (type-blas-idx idx))
+ (setf (aref store idx) (realpart value)
+ (aref store (1+ idx)) (imagpart value))
+ value))
+
+(declaim (ftype (function
+ (type-blas-store
+ type-blas-idx)
+ (complex double-float))
+ vref-blas-complex-store))
+
+(defun vref-blas-complex-store (store idx)
+ "Matrix accessor for the complex blas store"
+ (let ((idx2 (truly-the type-blas-idx (* 2 idx))))
+ (declare (type-blas-idx idx2))
+ (complex (aref store idx2)
+ (aref store (1+ idx2)))))
+
+(declaim (ftype (function
+ ((complex double-float)
+ type-blas-store
+ type-blas-idx
+ )
+ (complex double-float))
+ (setf vref-blas-complex-store)))
+
+(defun (setf vref-blas-complex-store) (value store idx)
+ (let ((idx2 (truly-the type-blas-idx (* 2 idx))))
+ (declare (type-blas-idx idx2))
+ (setf (aref store idx2) (realpart value)
+ (aref store (1+ idx2)) (imagpart value))
+ value))
+
+
+;;; Alternative references used by fft
+
+(declaim (ftype (function
+ (type-blas-store
+ type-blas-idx
+ type-blas-idx
+ type-blas-idx)
+ (complex double-float))
+ ref-blas-complex-store2))
+
+(declaim (inline ref-blas-complex-store2))
+
+(defun ref-blas-complex-store2 (store i start step)
+ "Accessor for the complex blas store"
+ (declare (type-blas-idx i start step)
+ (type-blas-store store))
+ (let* ((idx (truly-the type-blas-idx
+ (* 2 (+ (truly-the type-blas-idx (* step i))
+ start))))
+ (val (complex (aref store idx)
+ (aref store (1+ idx)))))
+ (declare (type type-blas-idx idx)
+ (type (complex double-float) val))
+ val))
+
+(declaim (inline ref-blas-complex-store2 (setf ref-blas-complex-store2)))
+
+(declaim (ftype (function
+ ((complex double-float)
+ type-blas-store
+ type-blas-idx
+ type-blas-idx
+ type-blas-idx
+ )
+ (complex double-float))
+ (setf ref-blas-complex-store2)))
+
+(defun (setf ref-blas-complex-store2) (value store i start step)
+ (declare (type-blas-idx i start step)
+ (type-blas-store store)
+ ((complex double-float) value) )
+ (let ((idx (truly-the type-blas-idx
+ (* 2
+ (truly-the type-blas-idx
+ (+
+ (truly-the type-blas-idx (* step i))
+ start))))))
+ (declare (type-blas-idx idx))
+ (setf (aref store idx) (realpart value)
+ (aref store (1+ idx)) (imagpart value))
+ value))
Added: trunk/src/util/type.lisp
==============================================================================
--- (empty file)
+++ trunk/src/util/type.lisp Sun Oct 24 04:49:56 2010
@@ -0,0 +1,43 @@
+;;; Lisplab, type.lisp
+;;; Type definition for double float arrays and vector index
+;;; Note, most other files depends on this one !
+;;;
+;;; Copyright (C) 2010 Joern Inge Vestgaarden
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+;;; TODO: change name of this to something about blas store
+;;;
+;;; This file contains manipulations of simple double-float arrays
+;;; and should be called by the spesialized matrix methods.
+;;; The purpose of this layer is that it can be used by
+;;; many classes such as matrix-base-dge and matrix-base-ddi, etc.
+;;;
+;;; The content of this file must be highly optimized
+;;; and should not depend anything exept Common Lisp itself.
+
+(in-package :lisplab)
+
+;;; Things that are common both for real and complex stores
+
+(deftype type-blas-store ()
+ '(simple-array double-float (*)))
+
+#+(and :sbcl :x86) (deftype type-blas-idx ()
+ '(MOD #x1FFFFFFF))
+#+(and :sbcl :x86-64) (deftype type-blas-idx ()
+ '(MOD #xFFFFFFFFFFFFFFD))
+#-:sbcl (deftype type-blas-idx ()
+ 'fixnum)
Added: trunk/src/vector1/level1-matrix-slice.lisp
==============================================================================
--- (empty file)
+++ trunk/src/vector1/level1-matrix-slice.lisp Sun Oct 24 04:49:56 2010
@@ -0,0 +1,61 @@
+;;; Lisplab, level1-matrix-slice.lisp
+;;; Vectors that are slice of matrices, i.e. row or column vectors.
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+(in-package :lisplab)
+
+(defclass matrix-slice-base (vector-base)
+ ((off :initarg :off :initform 0)
+ (step :initarg :step :initform 0)
+ (size :initarg :size :initform 0)))
+
+(defclass matrix-slice-any (matrix-slice-base)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store)))
+
+(defclass matrix-slice-dge (matrix-slice-base)
+ ((store :initarg :store
+ :initform nil
+ :reader type-blas-store)))
+
+;;; Untyped matrix slices
+
+(defmethod vref ((vector matrix-slice-any) idx)
+ (with-slots (store off step size) vector
+ (aref store (column-major-idx off idx step))))
+
+(defmethod (setf vref) (value (vector matrix-slice-any) idx)
+ (with-slots (store off step size) vector
+ (setf (aref store (column-major-idx off idx step))
+ value))
+ value)
+
+;;; Double float matrix slices
+
+(defmethod vref ((vector matrix-slice-dge) idx)
+ (with-slots (store off step size) vector
+ (declare (type type-blas-store store))
+ (aref store (column-major-idx off idx step))))
+
+(defmethod (setf vref) (value (vector matrix-slice-dge) idx)
+ (with-slots (store off step size) vector
+ (declare (type type-blas-store store))
+ (setf (aref store (column-major-idx off idx step))
+ value))
+ value)
\ No newline at end of file
Modified: trunk/src/vector1/level1-vector.lisp
==============================================================================
--- trunk/src/vector1/level1-vector.lisp (original)
+++ trunk/src/vector1/level1-vector.lisp Sun Oct 24 04:49:56 2010
@@ -26,7 +26,10 @@
(in-package :lisplab)
(defclass vector-base ()
- ((size :initform 0 :initarg size :accessor size)))
+ ((size :initarg :size
+ :initform 0
+ :reader size
+ :type type-blas-idx)))
(defclass vector-any (vector-base element-base)
((store :initarg :store
More information about the lisplab-cvs
mailing list