[lisplab-cvs] r213 - in trunk/src: matrix1 util vector1
jivestgarden at common-lisp.net
jivestgarden at common-lisp.net
Sat Apr 14 18:43:41 UTC 2012
Author: jivestgarden
Date: Sat Apr 14 11:43:40 2012
New Revision: 213
Log:
Added integer matrices. Untested.
Added:
trunk/src/matrix1/level1-ub8.lisp
trunk/src/vector1/vector1-idx.lisp
trunk/src/vector1/vector1-ub1.lisp
trunk/src/vector1/vector1-ub16.lisp
trunk/src/vector1/vector1-ub32.lisp
trunk/src/vector1/vector1-ub8.lisp
Modified:
trunk/src/util/level1-util.lisp
trunk/src/util/type.lisp
Added: trunk/src/matrix1/level1-ub8.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix1/level1-ub8.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -0,0 +1,69 @@
+;;; Lisplab, level1-ub8.lisp
+;;; General, unsigned-byte 8 matrices
+
+;;; Copyright (C) 2012 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-ub8 (structure-general vector-ub8 implementation-base)
+ ()
+ (:documentation "Matrix (rows x cols) with unsigned-byte 8."))
+
+(defmethod initialize-instance :after ((m matrix-ub8) &key dim (value 0))
+ (with-slots (rows cols size store) m
+ (setf rows (car dim)
+ cols (cadr dim)
+ size (* rows cols))
+ (unless store
+ (setf store (allocate-ub8-store size value)))))
+
+(defmethod make-matrix-class ((a (eql :ub8)) (b (eql :ge)) (c (eql :any)))
+ (find-class 'matrix-ub8))
+
+;;; All leve1 methods spcialized for dge
+
+(defmethod mref ((matrix matrix-ub8) row col)
+ (ref-ub8-store (slot-value matrix 'store) row col (slot-value matrix 'rows)))
+
+(defmethod (setf mref) (value (matrix matrix-ub8) row col)
+ (let ((val2 (mod value #xff)))
+ (declare (type (unsigned-byte 8) val2))
+ (setf (ref-ub8-store (slot-value matrix 'store)
+ row col (slot-value matrix 'rows))
+ val2)
+ val2))
+
+(defmethod print-object ((matrix matrix-ub8) stream)
+ (if (not *lisplab-print-size*)
+ (call-next-method)
+ (progn
+ (format stream "~&#mub8(" )
+ (print-matrix-contents matrix
+ :stream stream
+ :pr (if *lisplab-element-printer*
+ *lisplab-element-printer*
+ (lambda (x stream)
+ (format stream "~4d" x)))
+ :rmax (if (eq *lisplab-print-size* t)
+ (rows matrix)
+ *lisplab-print-size*)
+ :cmax (if (eq *lisplab-print-size* t)
+ (cols matrix)
+ *lisplab-print-size*)
+ :indent 6
+ :braket-p t)
+ (format stream ")" ))))
Modified: trunk/src/util/level1-util.lisp
==============================================================================
--- trunk/src/util/level1-util.lisp Fri Mar 30 10:52:30 2012 (r212)
+++ trunk/src/util/level1-util.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -82,6 +82,38 @@
(setf (aref store i) rv)))
store))
+;;; The unsigend-byte 1 store
+
+(defun allocate-ub1-store (size &optional (initial-element 0))
+ (let ((x (coerce initial-element '(unsigned-byte 1))))
+ (declare (type (unsigned-byte 1) x)
+ (type type-blas-idx size))
+ ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros
+ ;; is significantly faster than others!
+ (if (= x 0)
+ (make-array size
+ :element-type '(unsigned-byte 1)
+ :initial-element 0)
+ (make-array size
+ :element-type '(unsigned-byte 1)
+ :initial-element x))))
+
+;;; The unsigend-byte 8 store
+
+(defun allocate-idx-store (size &optional (initial-element 0))
+ (let ((x (coerce initial-element 'type-blas-idx)))
+ (declare (type type-blas-idx x)
+ (type type-blas-idx size))
+ ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros
+ ;; is significantly faster than others!
+ (if (= x 0)
+ (make-array size
+ :element-type 'type-blas-idx
+ :initial-element 0)
+ (make-array size
+ :element-type 'type-blas-idx
+ :initial-element x))))
+
;;; The unsigend-byte 8 store
(defun allocate-ub8-store (size &optional (initial-element 0))
@@ -96,4 +128,36 @@
:initial-element 0)
(make-array size
:element-type '(unsigned-byte 8)
+ :initial-element x))))
+
+;;; The unsigend-byte 16 store
+
+(defun allocate-ub16-store (size &optional (initial-element 0))
+ (let ((x (coerce initial-element '(unsigned-byte 16))))
+ (declare (type (unsigned-byte 16) x)
+ (type type-blas-idx size))
+ ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros
+ ;; is significantly faster than others!
+ (if (= x 0)
+ (make-array size
+ :element-type '(unsigned-byte 16)
+ :initial-element 0)
+ (make-array size
+ :element-type '(unsigned-byte 16)
+ :initial-element x))))
+
+;;; The unsigend-byte 32 store
+
+(defun allocate-ub32-store (size &optional (initial-element 0))
+ (let ((x (coerce initial-element '(unsigned-byte 32))))
+ (declare (type (unsigned-byte 32) x)
+ (type type-blas-idx size))
+ ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros
+ ;; is significantly faster than others!
+ (if (= x 0)
+ (make-array size
+ :element-type '(unsigned-byte 32)
+ :initial-element 0)
+ (make-array size
+ :element-type '(unsigned-byte 32)
:initial-element x))))
\ No newline at end of file
Modified: trunk/src/util/type.lisp
==============================================================================
--- trunk/src/util/type.lisp Fri Mar 30 10:52:30 2012 (r212)
+++ trunk/src/util/type.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -35,12 +35,20 @@
(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)
+#+(and :sbcl :x86)
+(deftype type-blas-idx () '(MOD #x1FFFFFFF))
+#+(and :sbcl :x86)
+(defconstant max-type-blas-idx #x1FFFFFFF)
+
+#+(and :sbcl :x86-64)
+(deftype type-blas-idx () '(MOD #xFFFFFFFFFFFFFFD))
+#+(and :sbcl :x86-64)
+(defconstant max-type-blas-idx #xFFFFFFFFFFFFFFD)
+
+#-:sbcl
+(deftype type-blas-idx () 'fixnum)
+#-:sbcl
+(deconstant max-type-blas-idx most-positive-fixnum)
(deftype type-idx-store ()
'(simple-array type-blas-idx (*)))
Added: trunk/src/vector1/vector1-idx.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector1/vector1-idx.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -0,0 +1,39 @@
+;;; Lisplab, vector1-idx.lisp
+;;; reference for finite size integer vector
+
+;;; Copyright (C) 2012 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)
+
+;;;; ub8 vectors
+
+(defclass vector-idx (vector-base element-idx)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store
+ :type type-idx-store)))
+
+(defmethod vref ((vector vector-idx) i)
+ (ref-idx-store (slot-value vector 'store) i 0 1))
+
+(defmethod (setf vref) (value (vector vector-idx) i)
+ (let ((val2 (mod value max-type-blas-idx)))
+ (declare (type type-blas-idx val2))
+ (setf (ref-idx-store (slot-value vector 'store) i 0 1)
+ val2)
+ val2))
+
Added: trunk/src/vector1/vector1-ub1.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector1/vector1-ub1.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -0,0 +1,41 @@
+;;; Lisplab, vector1-ub1.lisp
+;;; reference for finite size integer vector
+
+;;; Copyright (C) 2012 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.
+
+;;; Coluld cleaner with macros
+
+(in-package :lisplab)
+
+;;;; ub1 vectors
+
+(defclass vector-ub1 (vector-base element-ub1)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store
+ :type type-ub1-store)))
+
+(defmethod vref ((vector vector-ub1) i)
+ (ref-ub1-store (slot-value vector 'store) i 0 1))
+
+(defmethod (setf vref) (value (vector vector-ub1) i)
+ (let ((val2 (mod value 2)))
+ (declare (type (unsigned-byte 1) val2))
+ (setf (ref-ub1-store (slot-value vector 'store) i 0 1)
+ val2)
+ val2))
+
Added: trunk/src/vector1/vector1-ub16.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector1/vector1-ub16.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -0,0 +1,40 @@
+;;; Lisplab, vector1-ub16.lisp
+;;; reference for finite size integer vector
+
+;;; Copyright (C) 2012 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.
+
+;;; Coluld cleaner with macros
+
+(in-package :lisplab)
+
+;;;; ub16 vectors
+
+(defclass vector-ub16 (vector-base element-ub16)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store
+ :type type-ub16-store)))
+
+(defmethod vref ((vector vector-ub16) i)
+ (ref-ub16-store (slot-value vector 'store) i 0 1))
+
+(defmethod (setf vref) (value (vector vector-ub16) i)
+ (let ((val2 (mod value #xffff)))
+ (declare (type (unsigned-byte 16) val2))
+ (setf (ref-ub16-store (slot-value vector 'store) i 0 1)
+ val2)
+ val2))
Added: trunk/src/vector1/vector1-ub32.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector1/vector1-ub32.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -0,0 +1,40 @@
+;;; Lisplab, vector1-ub32.lisp
+;;; reference for finite size integer vector
+
+;;; Copyright (C) 2012 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.
+
+;;; Coluld cleaner with macros
+
+(in-package :lisplab)
+
+;;;; ub32 vectors
+
+(defclass vector-ub32 (vector-base element-ub32)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store
+ :type type-ub32-store)))
+
+(defmethod vref ((vector vector-ub32) i)
+ (ref-ub32-store (slot-value vector 'store) i 0 1))
+
+(defmethod (setf vref) (value (vector vector-ub32) i)
+ (let ((val2 (mod value #xffffffff)))
+ (declare (type (unsigned-byte 32) val2))
+ (setf (ref-ub32-store (slot-value vector 'store) i 0 1)
+ val2)
+ val2))
\ No newline at end of file
Added: trunk/src/vector1/vector1-ub8.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector1/vector1-ub8.lisp Sat Apr 14 11:43:40 2012 (r213)
@@ -0,0 +1,39 @@
+;;; Lisplab, vector1-ub8.lisp
+;;; reference for finite size integer vector
+
+;;; Copyright (C) 2012 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)
+
+;;;; ub8 vectors
+
+(defclass vector-ub8 (vector-base element-ub8)
+ ((store :initarg :store
+ :initform nil
+ :reader vector-store
+ :type type-ub8-store)))
+
+(defmethod vref ((vector vector-ub8) i)
+ (ref-ub8-store (slot-value vector 'store) i 0 1))
+
+(defmethod (setf vref) (value (vector vector-ub8) i)
+ (let ((val2 (mod value #xff)))
+ (declare (type (unsigned-byte 8) val2))
+ (setf (ref-ub8-store (slot-value vector 'store) i 0 1)
+ val2)
+ val2))
+
More information about the lisplab-cvs
mailing list