[lisplab-cvs] r216 - in trunk/src: matrix1 matrix2 util vector2
jivestgarden at common-lisp.net
jivestgarden at common-lisp.net
Sun Apr 15 13:58:54 UTC 2012
Author: jivestgarden
Date: Sun Apr 15 06:58:53 2012
New Revision: 216
Log:
More integer matrix stuff
Added:
trunk/src/matrix1/matrix1-ub1.lisp
trunk/src/matrix1/matrix1-ub16.lisp
trunk/src/matrix1/matrix1-ub32.lisp
trunk/src/matrix2/matrix2-integer-constructors.lisp
trunk/src/util/integer-store-functions.lisp
trunk/src/vector2/vector2-integer-functions.lisp
Added: trunk/src/matrix1/matrix1-ub1.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix1/matrix1-ub1.lisp Sun Apr 15 06:58:53 2012 (r216)
@@ -0,0 +1,69 @@
+;;; Lisplab, level1-ub8.lisp
+;;; General, unsigned-byte 1 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-ub1 (structure-general vector-ub1 implementation-base)
+ ()
+ (:documentation "Matrix (rows x cols) with unsigned-byte 1."))
+
+(defmethod initialize-instance :after ((m matrix-ub1) &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-ub1-store size value)))))
+
+(defmethod make-matrix-class ((a (eql :ub1)) (b (eql :ge)) (c (eql :any)))
+ (find-class 'matrix-ub1))
+
+;;; All leve1 methods spcialized for dge
+
+(defmethod mref ((matrix matrix-ub1) row col)
+ (ref-ub1-store (slot-value matrix 'store) row col (slot-value matrix 'rows)))
+
+(defmethod (setf mref) (value (matrix matrix-ub1) row col)
+ (let ((val2 (mod value 2)))
+ (declare (type (unsigned-byte 1) val2))
+ (setf (ref-ub1-store (slot-value matrix 'store)
+ row col (slot-value matrix 'rows))
+ val2)
+ val2))
+
+(defmethod print-object ((matrix matrix-ub1) stream)
+ (if (not *lisplab-print-size*)
+ (call-next-method)
+ (progn
+ (format stream "~&#mub1(" )
+ (print-matrix-contents matrix
+ :stream stream
+ :pr (if *lisplab-element-printer*
+ *lisplab-element-printer*
+ (lambda (x stream)
+ (format stream "~1d" 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 ")" ))))
Added: trunk/src/matrix1/matrix1-ub16.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix1/matrix1-ub16.lisp Sun Apr 15 06:58:53 2012 (r216)
@@ -0,0 +1,69 @@
+;;; Lisplab, level1-ub16.lisp
+;;; General, unsigned-byte 16 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-ub16 (structure-general vector-ub16 implementation-base)
+ ()
+ (:documentation "Matrix (rows x cols) with unsigned-byte 16."))
+
+(defmethod initialize-instance :after ((m matrix-ub16) &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-ub16-store size value)))))
+
+(defmethod make-matrix-class ((a (eql :ub16)) (b (eql :ge)) (c (eql :any)))
+ (find-class 'matrix-ub16))
+
+;;; All leve1 methods spcialized for dge
+
+(defmethod mref ((matrix matrix-ub16) row col)
+ (ref-ub16-store (slot-value matrix 'store) row col (slot-value matrix 'rows)))
+
+(defmethod (setf mref) (value (matrix matrix-ub16) row col)
+ (let ((val2 (mod value #xffff)))
+ (declare (type (unsigned-byte 16) val2))
+ (setf (ref-ub16-store (slot-value matrix 'store)
+ row col (slot-value matrix 'rows))
+ val2)
+ val2))
+
+(defmethod print-object ((matrix matrix-ub16) stream)
+ (if (not *lisplab-print-size*)
+ (call-next-method)
+ (progn
+ (format stream "~&#mub16(" )
+ (print-matrix-contents matrix
+ :stream stream
+ :pr (if *lisplab-element-printer*
+ *lisplab-element-printer*
+ (lambda (x stream)
+ (format stream "~6d" 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 7
+ :braket-p t)
+ (format stream ")" ))))
Added: trunk/src/matrix1/matrix1-ub32.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix1/matrix1-ub32.lisp Sun Apr 15 06:58:53 2012 (r216)
@@ -0,0 +1,69 @@
+;;; Lisplab, level1-ub32.lisp
+;;; General, unsigned-byte 32 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-ub32 (structure-general vector-ub32 implementation-base)
+ ()
+ (:documentation "Matrix (rows x cols) with unsigned-byte 32."))
+
+(defmethod initialize-instance :after ((m matrix-ub32) &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-ub32-store size value)))))
+
+(defmethod make-matrix-class ((a (eql :ub32)) (b (eql :ge)) (c (eql :any)))
+ (find-class 'matrix-ub32))
+
+;;; All leve1 methods spcialized for dge
+
+(defmethod mref ((matrix matrix-ub32) row col)
+ (ref-ub32-store (slot-value matrix 'store) row col (slot-value matrix 'rows)))
+
+(defmethod (setf mref) (value (matrix matrix-ub32) row col)
+ (let ((val2 (mod value #xffffffff)))
+ (declare (type (unsigned-byte 32) val2))
+ (setf (ref-ub32-store (slot-value matrix 'store)
+ row col (slot-value matrix 'rows))
+ val2)
+ val2))
+
+(defmethod print-object ((matrix matrix-ub32) stream)
+ (if (not *lisplab-print-size*)
+ (call-next-method)
+ (progn
+ (format stream "~&#mub32(" )
+ (print-matrix-contents matrix
+ :stream stream
+ :pr (if *lisplab-element-printer*
+ *lisplab-element-printer*
+ (lambda (x stream)
+ (format stream "~10d" 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 7
+ :braket-p t)
+ (format stream ")" ))))
Added: trunk/src/matrix2/matrix2-integer-constructors.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix2/matrix2-integer-constructors.lisp Sun Apr 15 06:58:53 2012 (r216)
@@ -0,0 +1,96 @@
+;;; Lisplab, matrix2-integer-constructors.lisp
+;;; Level2 constructors for integer 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)
+
+(defun ub1new (value rows cols)
+ (mnew 'matrix-ub1 value rows cols))
+
+(defun ub1mat (x)
+ (mmat 'matrix-ub1 x))
+
+(defun ub1row (&rest args)
+ (apply #'mrow 'matrix-ub1 args))
+
+(defun ub1col (&rest args)
+ (apply #'mcol 'matrix-ub1 args))
+
+(defun ub1rand (rows cols)
+ (mmap 'matrix-ub1
+ (lambda (x)
+ (declare (ignore x))
+ (random #xff))
+ (ub1new 0 rows cols)))
+
+(defun ub8new (value rows cols)
+ (mnew 'matrix-ub8 value rows cols))
+
+(defun ub8mat (x)
+ (mmat 'matrix-ub8 x))
+
+(defun ub8row (&rest args)
+ (apply #'mrow 'matrix-ub8 args))
+
+(defun ub8col (&rest args)
+ (apply #'mcol 'matrix-ub8 args))
+
+(defun ub8rand (rows cols)
+ (mmap 'matrix-ub8
+ (lambda (x)
+ (declare (ignore x))
+ (random #xff))
+ (ub8new 0 rows cols)))
+
+(defun ub16new (value rows cols)
+ (mnew 'matrix-ub16 value rows cols))
+
+(defun ub16mat (x)
+ (mmat 'matrix-ub16 x))
+
+(defun ub16row (&rest args)
+ (apply #'mrow 'matrix-ub16 args))
+
+(defun ub16col (&rest args)
+ (apply #'mcol 'matrix-ub16 args))
+
+(defun ub16rand (rows cols)
+ (mmap 'matrix-ub16
+ (lambda (x)
+ (declare (ignore x))
+ (random #xffff))
+ (ub16new 0 rows cols)))
+
+(defun ub32new (value rows cols)
+ (mnew 'matrix-ub32 value rows cols))
+
+(defun ub32mat (x)
+ (mmat 'matrix-ub32 x))
+
+(defun ub32row (&rest args)
+ (apply #'mrow 'matrix-ub32 args))
+
+(defun ub32col (&rest args)
+ (apply #'mcol 'matrix-ub32 args))
+
+(defun ub32rand (rows cols)
+ (mmap 'matrix-ub32
+ (lambda (x)
+ (declare (ignore x))
+ (random #xffffffff))
+ (ub32new 0 rows cols)))
Added: trunk/src/util/integer-store-functions.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/util/integer-store-functions.lisp Sun Apr 15 06:58:53 2012 (r216)
@@ -0,0 +1,76 @@
+;;; Lisplab, integer-store-functions.lisp
+;;; Level2, functions and operations for integer stores
+
+;;; 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)
+
+(defmacro defun-umat-op (name opname store-type mod-size)
+ (let ((a (gensym))
+ (out (gensym))
+ (i (gensym)))
+ `(defun ,name (,a ,out)
+ (declare (type ,store-type ,a ,out))
+ (dotimes (,i (length ,a))
+ (setf (aref ,out ,i)
+ (mod (,opname (aref ,a ,i))
+ ,mod-size)))
+ (values))))
+
+(defun-umat-op ub8-not lognot type-ub8-store #xff)
+
+(defmacro defun-umat-umat-fun (name funname store-type mod-size)
+ (let ((a (gensym))
+ (b (gensym))
+ (out (gensym))
+ (i (gensym)))
+ `(defun ,name (,a ,b ,out)
+ (declare (type ,store-type ,a ,b ,out))
+ (dotimes (,i (length ,a))
+ (setf (aref ,out ,i)
+ (mod (,funname (aref ,a ,i)
+ (aref ,b ,i))
+ ,mod-size)))
+ (values))))
+
+(defun-umat-umat-fun ub8-ub8-and logand type-ub8-store #xff)
+(defun-umat-umat-fun ub8-ub8-nand lognand type-ub8-store #xff)
+(defun-umat-umat-fun ub8-ub8-or logior type-ub8-store #xff)
+(defun-umat-umat-fun ub8-ub8-nor lognor type-ub8-store #xff)
+(defun-umat-umat-fun ub8-ub8-xor logxor type-ub8-store #xff)
+
+(defmacro defun-umat-int-fun (name funname store-type elm-type mod-size)
+ (let ((a (gensym))
+ (b (gensym))
+ (out (gensym))
+ (i (gensym)))
+ `(defun ,name (,a ,b ,out)
+ (declare (type integer ,b))
+ (let ((,b (mod ,b ,mod-size)))
+ (declare (type ,store-type ,a ,out)
+ (type ,elm-type ,b))
+ (dotimes (,i (length ,a))
+ (setf (aref ,out ,i)
+ (mod (,funname (aref ,a ,i) ,b)
+ ,mod-size)))
+ (values)))))
+
+(defun-umat-int-fun ub8-int-and logand type-ub8-store (unsigned-byte 8) #xff)
+(defun-umat-int-fun ub8-int-nand lognand type-ub8-store (unsigned-byte 8) #xff)
+(defun-umat-int-fun ub8-int-or logior type-ub8-store (unsigned-byte 8) #xff)
+(defun-umat-int-fun ub8-int-nor lognor type-ub8-store (unsigned-byte 8) #xff)
+(defun-umat-int-fun ub8-int-xor logxor type-ub8-store (unsigned-byte 8) #xff)
Added: trunk/src/vector2/vector2-integer-functions.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector2/vector2-integer-functions.lisp Sun Apr 15 06:58:53 2012 (r216)
@@ -0,0 +1,98 @@
+;;; Lisplab, vector2-integer-functions.lisp
+;;; Level2 integer functions
+
+;;; 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)
+
+(defmacro def-unsigned-integer-methods (matrix-type)
+ (let ((a (gensym "a"))
+ (b (gensym "b"))
+ (c (gensym "c")))
+ `(progn
+ (defmethod .not ((,a ,matrix-type))
+ (let ((,b (mcreate ,a)))
+ (ub8-not (vector-store ,a) (vector-store ,b))
+ ,b))
+
+ (defmethod .and ((,a ,matrix-type) (,b ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-ub8-and (vector-store ,a) (vector-store ,b) (vector-store ,c))
+ ,c))
+ (defmethod .and ((,a ,matrix-type) (,b integer))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-and (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+ (defmethod .and ((,b integer) (,a ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-and (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+
+ (defmethod .nand ((,a ,matrix-type) (,b ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-ub8-nand (vector-store ,a) (vector-store ,b) (vector-store ,c))
+ ,c))
+ (defmethod .nand ((,a ,matrix-type) (,b integer))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-nand (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+ (defmethod .nand ((,b integer) (,a ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-nand (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+
+ (defmethod .or ((,a ,matrix-type) (,b ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-ub8-or (vector-store ,a) (vector-store ,b) (vector-store ,c))
+ ,c))
+ (defmethod .or ((,a ,matrix-type) (,b integer))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-or (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+ (defmethod .or ((,b integer) (,a ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-or (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+
+ (defmethod .nor ((,a ,matrix-type) (,b ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-ub8-nor (vector-store ,a) (vector-store ,b) (vector-store ,c))
+ ,c))
+ (defmethod .nor ((,a ,matrix-type) (,b integer))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-nor (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+ (defmethod .nor ((,b integer) (,a ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-nor (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+
+ (defmethod .xor ((,a ,matrix-type) (,b ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-ub8-xor (vector-store ,a) (vector-store ,b) (vector-store ,c))
+ ,c))
+ (defmethod .xor ((,a ,matrix-type) (,b integer))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-xor (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+ (defmethod .xor ((,b integer) (,a ,matrix-type))
+ (let ((,c (mcreate ,a)))
+ (ub8-int-xor (vector-store ,a) ,b (vector-store ,c))
+ ,c))
+ )))
+
+(def-unsigned-integer-methods matrix-ub8 )
\ No newline at end of file
More information about the lisplab-cvs
mailing list