Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-93-g578dc43
|
From: Akshay S. <ak...@us...> - 2012-06-25 15:45:03
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".
The branch, tensor has been updated
via 578dc43e356575b8c860f46f157c07d773843af8 (commit)
from 0f1b57f2c90f00aac4aa5ea6e7240ae69690409f (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 578dc43e356575b8c860f46f157c07d773843af8
Author: Akshay Srinivasan <aks...@gm...>
Date: Mon Jun 25 19:47:10 2012 +0530
More tweaks to mod-loop
diff --git a/src/complex-tensor.lisp b/src/complex-tensor.lisp
index 9ae6fbe..ebcdf7f 100644
--- a/src/complex-tensor.lisp
+++ b/src/complex-tensor.lisp
@@ -67,8 +67,8 @@ Cannot hold complex numbers."))
(aref store (1+ (* 2 idx))) (imagpart value)))
:reader-writer
(lambda (fstore fidx tstore tidx)
- (setf (aref fstore (* 2 fidx)) (aref tstore (* 2 tidx))
- (aref fstore (1+ (* 2 fidx))) (aref tstore (1+ (* 2 tidx))))))
+ (setf (aref tstore (* 2 tidx)) (aref fstore (* 2 fidx))
+ (aref tstore (1+ (* 2 tidx))) (aref fstore (1+ (* 2 fidx))))))
(setf (gethash 'complex-sub-tensor *tensor-class-optimizations*) 'complex-tensor)
diff --git a/src/loopy.lisp b/src/loopy.lisp
new file mode 100644
index 0000000..d0cb80b
--- /dev/null
+++ b/src/loopy.lisp
@@ -0,0 +1,147 @@
+(in-package :matlisp)
+
+(defparameter *lisp-copy-upper-bound* 1000
+ "When (< (store-size te) *LISP-COPY-UPPER-BOUND*) the method defined in Lisp
+is used, else the fortran routine is called instead.
+")
+
+(defun column-major-p (offsets dims)
+ (loop
+ for off across offsets
+ and dim across dims
+ and accumulated-off = 1 then (* accumulated-off dim)
+ unless (= off accumulated-off) do (return nil)
+ finally (return t)))
+
+(defun row-major-p (offsets dims)
+ (very-quickly
+ (loop
+ for idx of-type index-type from (1- (length dims)) downto 0
+ for dim of-type index-type = (aref dims idx)
+ for off of-type index-type = (aref offsets idx)
+ and accumulated-off of-type index-type = 1 then (* accumulated-off dim)
+ unless (= off accumulated-off) do (return nil)
+ finally (return t))))
+
+(defmacro mod-loop ((idx dims) &body body)
+ (check-type idx symbol)
+ (let ((tensor-table (make-hash-table)))
+ (labels ((get-tensors (decl)
+ (if (null decl) t
+ (let ((cdecl (car decl)))
+ (when (and (eq (first cdecl) 'type)
+ (get-tensor-class-optimization (second cdecl)))
+ (dolist (sym (cddr cdecl))
+ (let ((hsh (list
+ :class (second cdecl)
+ :stride-sym (gensym (string+ (symbol-name sym) "-stride"))
+ :store-sym (gensym (string+ (symbol-name sym) "-store"))
+ :offset-sym (gensym (string+ (symbol-name sym) "-offset"))
+ :ref-count 0)))
+ (setf (gethash sym tensor-table) hsh))))
+ (get-tensors (cdr decl)))))
+ (ttrans-p (code)
+ (and (consp code) (eq (first code) 'tensor-ref)
+ (gethash (second code) tensor-table)
+ (eq (third code) idx)))
+ (incref (ten)
+ (incf (getf (gethash ten tensor-table) :ref-count)))
+ (transform-setf-tensor-ref (snippet ret)
+ (if (null snippet) ret
+ (transform-setf-tensor-ref
+ (cddr snippet)
+ (append ret
+ (destructuring-bind (to from &rest rest) snippet
+ (declare (ignore rest))
+ (let ((to-t? (ttrans-p to))
+ (fr-t? (ttrans-p from)))
+ (cond
+ ((and to-t? fr-t?)
+ (let ((to-opt (gethash (second to) tensor-table))
+ (fr-opt (gethash (second from) tensor-table)))
+ (if (eq (second (multiple-value-list (get-tensor-class-optimization (getf to-opt :class))))
+ (second (multiple-value-list (get-tensor-class-optimization (getf fr-opt :class)))))
+ (progn
+ (incref (second to)) (incref (second from))
+ (cdr (funcall (getf (get-tensor-class-optimization (getf to-opt :class)) :reader-writer)
+ (getf fr-opt :store-sym) (getf fr-opt :offset-sym) (getf to-opt :store-sym) (getf to-opt :offset-sym))))
+ (list to (find-tensor-refs from nil)))))
+ (to-t?
+ (incref (second to))
+ (let ((to-opt (gethash (second to) tensor-table)))
+ ;;Add type checking here!
+ (cdr (funcall (getf (get-tensor-class-optimization (getf to-opt :class)) :value-writer)
+ from (getf to-opt :store-sym) (getf to-opt :offset-sym)))))
+ (fr-t?
+ (incref (second from))
+ (let ((fr-opt (gethash (second from) tensor-table)))
+ (cons to (funcall (getf (get-tensor-class-optimization (getf fr-opt :class)) :reader)
+ (getf fr-opt :store-sym) (getf fr-opt :offset-sym)))))
+ (t
+ (list to (find-tensor-refs from nil))))))))))
+ (transform-tensor-ref (snippet)
+ (if (eq (first snippet) 'setf)
+ (cons 'setf (transform-setf-tensor-ref (cdr snippet) nil))
+ (destructuring-bind (tref ten index) snippet
+ (assert (eq tref 'tensor-ref))
+ (let ((topt (gethash ten tensor-table)))
+ (if (not (and (eq index idx) topt)) snippet
+ (progn
+ (incref ten)
+ (funcall (getf (get-tensor-class-optimization (getf topt :class)) :reader) (getf topt :store-sym) (getf topt :offset-sym))))))))
+ (find-tensor-refs (code ret)
+ (if (null code) (reverse ret)
+ (cond
+ ((consp code)
+ (if (member (first code) '(tensor-ref setf))
+ (transform-tensor-ref code)
+ (find-tensor-refs (cdr code) (cons (find-tensor-refs (car code) nil) ret))))
+ (t code)))))
+ ;;
+ (when (eq (caar body) 'declare)
+ (get-tensors (cdar body)))
+ (let ((tr-body (find-tensor-refs body nil)))
+ (with-gensyms (dims-sym rank-sym count-sym)
+ `(let* ((,dims-sym ,dims)
+ (,rank-sym (length ,dims-sym))
+ (,idx (allocate-index-store ,rank-sym))
+ ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ collect (let ((hsh (gethash key tensor-table)))
+ `(,(getf hsh :stride-sym) (strides ,key))))
+ ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ collect (let ((hsh (gethash key tensor-table)))
+ `(,(getf hsh :store-sym) (store ,key)))))
+ (declare (type (index-array *) ,idx ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ collect (getf (gethash key tensor-table) :stride-sym)))
+ ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ collect (let* ((hsh (gethash key tensor-table))
+ (opt (get-tensor-class-optimization (getf hsh :class))))
+ `(type ,(linear-array-type (getf opt :store-type)) ,(getf hsh :store-sym)))))
+ (loop
+ ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ append (let ((hsh (gethash key tensor-table)))
+ `(with ,(getf hsh :offset-sym) of-type index-type = (head ,key))))
+ do (locally
+ ,@tr-body)
+ ;;Optimized for row-order
+ while (loop for ,count-sym of-type index-type from (1- ,rank-sym) downto 0
+ do (if (= (aref ,idx ,count-sym) (1- (aref ,dims-sym ,count-sym)))
+ (progn
+ (setf (aref ,idx ,count-sym) 0)
+ ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ collect (let ((hsh (gethash key tensor-table)))
+ `(decf ,(getf hsh :offset-sym) (* (aref ,(getf hsh :stride-sym) ,count-sym) (1- (aref ,dims-sym ,count-sym)))))))
+ (progn
+ (incf (aref ,idx ,count-sym))
+ ,@(loop for key being the hash-keys of tensor-table
+ when (> (getf (gethash key tensor-table) :ref-count) 0)
+ collect (let ((hsh (gethash key tensor-table)))
+ `(incf ,(getf hsh :offset-sym) (aref ,(getf hsh :stride-sym) ,count-sym))))
+ (return t)))
+ finally (return nil)))))))))
diff --git a/src/real-tensor.lisp b/src/real-tensor.lisp
index b47f5be..9855a0c 100644
--- a/src/real-tensor.lisp
+++ b/src/real-tensor.lisp
@@ -49,7 +49,7 @@ Allocates real storage. Default initial-element = 0d0.")
(setf (aref store idx) value))
:reader-writer
(lambda (fstore fidx tstore tidx)
- (setf (aref fstore fidx) (aref tstore tidx))))
+ (setf (aref tstore tidx) (aref fstore fidx))))
(setf (gethash 'real-sub-tensor *tensor-class-optimizations*) 'real-tensor)
diff --git a/src/standard-tensor.lisp b/src/standard-tensor.lisp
index 3ef4919..f4c257b 100644
--- a/src/standard-tensor.lisp
+++ b/src/standard-tensor.lisp
@@ -92,7 +92,6 @@
:accessor parent-tensor))
(:documentation "Basic sub-tensor class."))
-
;;
(defparameter *sub-tensor-counterclass* (make-hash-table)
"
@@ -122,7 +121,7 @@
((symbolp opt)
(get-tensor-class-optimization opt))
((null opt) nil)
- (t opt))))
+ (t (value opt clname)))))
;; Akshay: I have no idea what this does, or why we want it
;; (inherited from standard-matrix.lisp
@@ -219,10 +218,10 @@
i = 0
"
(declare (type standard-tensor tensor)
- (type (or cons (index-array *)) idx))
+ (type (or (index-array *) cons) idx))
(typecase idx
(cons (store-indexing-lst idx (head tensor) (strides tensor) (dimensions tensor)))
- (vector (store-indexing-lst idx (head tensor) (strides tensor) (dimensions tensor)))))
+ (vector (store-indexing-vec idx (head tensor) (strides tensor) (dimensions tensor)))))
;;
(defmethod initialize-instance :after ((tensor standard-tensor) &rest initargs)
diff --git a/src/tensor-copy.lisp b/src/tensor-copy.lisp
index 3400bc3..2a1a2a3 100644
--- a/src/tensor-copy.lisp
+++ b/src/tensor-copy.lisp
@@ -1,140 +1,15 @@
(in-package :matlisp)
-(defparameter *lisp-copy-upper-bound* 1000
- "When (< (store-size te) *LISP-COPY-UPPER-BOUND*) the method defined in Lisp
-is used, else the fortran routine is called instead.
-")
-
-(defun column-major-p (offsets dims)
- (loop
- for off across offsets
- and dim across dims
- and accumulated-off = 1 then (* accumulated-off dim)
- unless (= off accumulated-off) do (return nil)
- finally (return t)))
-
-(defun row-major-p (offsets dims)
- (very-quickly
- (loop
- for idx of-type index-type from (1- (length dims)) downto 0
- for dim of-type index-type = (aref dims idx)
- for off of-type index-type = (aref offsets idx)
- and accumulated-off of-type index-type = 1 then (* accumulated-off dim)
- unless (= off accumulated-off) do (return nil)
- finally (return t))))
-
-(defmacro mod-loop ((idx dims) &body body)
- (check-type idx symbol)
- (let ((tensor-table (make-hash-table)))
- (labels ((get-tensors (decl)
- (if (null decl) t
- (let ((cdecl (car decl)))
- (when (and (eq (first cdecl) 'type)
- (get-tensor-class-optimization (second cdecl)))
- (dolist (sym (cddr cdecl))
- (let ((hsh (list
- :class (second cdecl)
- :stride-sym (gensym (string+ (symbol-name sym) "-stride"))
- :store-sym (gensym (string+ (symbol-name sym) "-store"))
- :offset-sym (gensym (string+ (symbol-name sym) "-offset")))))
- (setf (gethash sym tensor-table) hsh))))
- (get-tensors (cdr decl)))))
- (ttrans-p (code)
- (and (eq (first code) 'tensor-ref)
- (gethash (second code) tensor-table)
- (eq (third code) idx)))
- (transform-setf-tensor-ref (snippet ret)
- (if (null snippet) ret
- (transform-setf-tensor-ref
- (cddr snippet)
- (append ret
- (destructuring-bind (to from &rest rest) snippet
- (declare (ignore rest))
- (let ((to-t? (ttrans-p to))
- (fr-t? (ttrans-p from)))
- (cond
- ((and to-t? fr-t?)
- (let ((to-opt (gethash (second to) tensor-table))
- (fr-opt (gethash (second from) tensor-table)))
- ;;Add type checking here!
- (cdr (funcall (getf (get-tensor-class-optimization (getf to-opt :class)) :reader-writer)
- (getf fr-opt :store-sym) (getf fr-opt :offset-sym) (getf to-opt :store-sym) (getf to-opt :offset-sym)))))
- (to-t?
- (let ((to-opt (gethash (second to) tensor-table)))
- ;;Add type checking here!
- (cdr (funcall (getf (get-tensor-class-optimization (getf to-opt :class)) :value-writer)
- from (getf to-opt :store-sym) (getf to-opt :offset-sym)))))
- (fr-t?
- (let ((fr-opt (gethash (second from) tensor-table)))
- (cons to (funcall (getf (get-tensor-class-optimization (getf fr-opt :class)) :reader)
- (getf fr-opt :store-sym) (getf fr-opt :offset-sym)))))
- (t
- (list to from)))))))))
- (transform-tensor-ref (snippet)
- (if (eq (first snippet) 'setf)
- (cons 'setf (transform-setf-tensor-ref (cdr snippet) nil))
- (destructuring-bind (tref ten index) snippet
- (assert (eq tref 'tensor-ref))
- (let ((topt (gethash ten tensor-table)))
- (if (not (and (eq index idx) topt)) snippet
- (funcall (getf (get-tensor-class-optimization (getf topt :class)) :reader) (getf topt :store-sym) (getf topt :offset-sym)))))))
- (find-tensor-refs (code ret)
- (if (null code) (reverse ret)
- (cond
- ((consp code)
- (if (member (first code) '(tensor-ref setf))
- (transform-tensor-ref code)
- (find-tensor-refs (cdr code) (cons (find-tensor-refs (car code) nil) ret))))
- (t code)))))
- (when (eq (caar body) 'declare)
- (get-tensors (cdar body)))
- (with-gensyms (dims-sym rank-sym count-sym)
- `(let* ((,dims-sym ,dims)
- (,rank-sym (length ,dims-sym))
- (,idx (allocate-index-store ,rank-sym))
- ,@(loop for key being the hash-keys of tensor-table
- collect (let ((hsh (gethash key tensor-table)))
- `(,(getf hsh :stride-sym) (strides ,key))))
- ,@(loop for key being the hash-keys of tensor-table
- collect (let ((hsh (gethash key tensor-table)))
- `(,(getf hsh :store-sym) (store ,key)))))
- (declare (type (index-array *) ,idx ,@(loop for key being the hash-keys of tensor-table
- collect (getf (gethash key tensor-table) :stride-sym)))
- ,@(loop for key being the hash-keys of tensor-table
- collect (let* ((hsh (gethash key tensor-table))
- (opt (get-tensor-class-optimization (getf hsh :class))))
- `(type ,(linear-array-type (getf opt :store-type)) ,(getf hsh :store-sym)))))
- (loop
- ,@(loop for key being the hash-keys of tensor-table
- append (let ((hsh (gethash key tensor-table)))
- `(with ,(getf hsh :offset-sym) of-type index-type = (head ,key))))
- do (locally
- ,@(find-tensor-refs body nil))
- while (dotimes (,count-sym ,rank-sym nil)
- (declare (type index-type ,count-sym))
- (if (= (aref ,idx ,count-sym) (1- (aref ,dims-sym ,count-sym)))
- (progn
- (setf (aref ,idx ,count-sym) 0)
- ,@(loop for key being the hash-keys of tensor-table
- collect (let ((hsh (gethash key tensor-table)))
- `(decf ,(getf hsh :offset-sym) (* (aref ,(getf hsh :stride-sym) ,count-sym) (1- (aref ,dims-sym ,count-sym)))))))
- (progn
- (incf (aref ,idx ,count-sym))
- ,@(loop for key being the hash-keys of tensor-table
- collect (let ((hsh (gethash key tensor-table)))
- `(incf ,(getf hsh :offset-sym) (aref ,(getf hsh :stride-sym) ,count-sym))))
- (return t))))))))))
-
(defun tensor-copy (from to)
- (declare (optimize (speed 3) (safety 0))
+ (declare (optimize (speed 3) (safety 0) (space 0))
(type real-tensor to from))
(let ((dims (dimensions from)))
(mod-loop (idx dims)
- (declare (type real-tensor to from))
+ (declare (type real-tensor to from)
+ (optimize (speed 3) (safety 0) (space 0)))
(setf (tensor-ref to idx) (tensor-ref from idx)))))
-
-(let ((x (make-real-tensor-dims 100 100 100))
+#+nil(let ((x (make-real-tensor-dims 100 100 100))
(y (make-real-tensor-dims 100 100 100)))
(mod-loop (idx #(100 100 100))
(declare (type real-tensor x y))
@@ -167,72 +42,15 @@ is used, else the fortran routine is called instead.
do (,blas-func nc-a st-a cs-a st-b cs-b :head-x (+ hd-a (* i rs-a)) :head-y (+ hd-b (* i rs-b)))))))
mat-b))
-
-(defun real-typed-copy!-func (ten-a ten-b)
-
-
-
-(defun find-longest-chain (stds dims))
-
-;; (defun tensor-copy (to from)
-;; (declare (optimize (speed 3) (safety 0))
-;; (type real-tensor to from))
-;; (let* ((rank (rank to))
-;; (dims (dimensions to))
-;; (t-strides (strides to))
-;; (f-strides (strides from))
-;; (t-store (store to))
-;; (f-store (store from))
-;; (idx (allocate-index-store rank)))
-;; (declare (type (index-array *) dims t-strides f-strides idx)
-;; (type (real-array *) t-store f-store))
-;; (loop
-;; with of-t of-type index-type = (head to)
-;; with of-f of-type index-type = (head from)
-;; do (setf (aref t-store of-f) (aref f-store of-f))
-;; while (dotimes (i rank nil)
-;; (incf (aref idx i))
-;; (incf of-t (aref t-strides i))
-;; (incf of-f (aref f-strides i))
-;; (when (< (aref idx i) (aref dims i)) (return t))
-;; (setf (aref idx i) 0)
-;; (decf of-t (* (aref t-strides i) (aref dims i)))
-;; (decf of-f (* (aref f-strides i) (aref dims i)))))))
-
-;; (cffi:define-foreign-library strided-copy
-;; (t (:default "/home/neptune/devel/matlisp/csrc/libtcopy")))
-
-;; (cffi:use-foreign-library strided-copy)
-
-;; (cffi:defcfun ("tcopy_" fortran-tcopy) :void
-;; (rank :pointer :int64) (dims :pointer :int64)
-;; (head-t :pointer :int64) (strides-t :pointer :int64) (data-t :pointer :double)
-;; (head-f :pointer :int64) (strides-f :pointer :int64) (data-f :pointer :double)
-;; (idx-work :pointer :int64))
-
-;; (defun tcopy (rank dims head-t strides-t data-t head-f strides-f data-f idx-work)
-;; (with-foreign-objects-stacked ((r :int64 :initial-element rank)
-;; (ht :int64 :initial-element head-t)
-;; (hf :int64 :initial-element head-f))
-;; (fortran-tcopy r (sb-sys:vector-sap dims)
-;; ht (sb-sys:vector-sap strides-t) (sb-sys:vector-sap data-t)
-;; hf (sb-sys:vector-sap strides-f) (sb-sys:vector-sap data-f)
-;; (sb-sys:vector-sap idx-work))))
-
-;; (cffi:defcfun ("strided_copy" strided-copy) :void
-;; (rank :int64) (dims :pointer :int64)
-;; (head-t :int64) (strides-t :pointer :int64) (data-t :pointer :double)
-;; (head-f :int64) (strides-f :pointer :int64) (data-f :pointer :double)
-;; (idx-work :pointer :int64))
-
-;; (let* ((idx (allocate-index-store (rank x))))
-;; (time (strided-copy (rank x) (sb-sys:vector-sap (dimensions x))
-;; (head x) (sb-sys:vector-sap (strides x)) (vector-data-address (store x))
-;; (head y) (sb-sys:vector-sap (strides y)) (vector-data-address (store y))
-;; (sb-sys:vector-sap idx))))
-
-
-
+(defun test-mm ()
+ (let ((t-a (make-real-tensor 1000 1000))
+ (t-b (make-real-tensor 1000 1000))
+ (t-c (make-real-tensor 1000 1000)))
+ (declare (type real-tensor t-a t-b t-c))
+ (mod-loop (idx #(1000 1000))
+ (setf (tensor-ref t-c idx)
+ (loop for k from 0 below 1000
+ summing (* (tensor-ref t-a `(,(aref idx 0) ,k)) (tensor-ref t-b `(,k ,(aref idx 1)))))))))
;;
#+nil
(defun test-tensor-1k-dot ()
-----------------------------------------------------------------------
Summary of changes:
src/complex-tensor.lisp | 4 +-
src/loopy.lisp | 147 ++++++++++++++++++++++++++++++++
src/real-tensor.lisp | 2 +-
src/standard-tensor.lisp | 7 +-
src/tensor-copy.lisp | 208 +++-------------------------------------------
5 files changed, 166 insertions(+), 202 deletions(-)
create mode 100644 src/loopy.lisp
hooks/post-receive
--
matlisp
|
