Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch extensible updated. 2012-02-23-175-g1c74913
|
From: Akshay S. <ak...@us...> - 2012-12-26 03:47:27
|
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, extensible has been updated
via 1c74913ff22ddc869220e6ee124bcf272b188d12 (commit)
from 376399e23fbbb868c8eb3ef80ee8bc9c65c5d98e (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 1c74913ff22ddc869220e6ee124bcf272b188d12
Author: Akshay Srinivasan <aks...@gm...>
Date: Tue Dec 25 21:41:55 2012 -0600
o Ported scal.lisp
diff --git a/matlisp.asd b/matlisp.asd
index d573c09..61a7721 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -133,11 +133,11 @@
(:file "swap")
(:file "copy"
:depends-on ("tensor-maker"))
- #+nil(:file "scal"
- :depends-on ("copy" "tensor-maker"))
- #+nil(:file "realimag"
+ (:file "realimag"
:depends-on ("copy"))
- #+nil(:file "dot"
+ (:file "scal"
+ :depends-on ("copy" "tensor-maker" "realimag"))
+ (:file "dot"
:depends-on ("realimag"))
#+nil(:file "axpy"
:depends-on ("copy" "scal"))
diff --git a/src/classes/complex-tensor.lisp b/src/classes/complex-tensor.lisp
index 97e6656..03a8fab 100644
--- a/src/classes/complex-tensor.lisp
+++ b/src/classes/complex-tensor.lisp
@@ -44,6 +44,10 @@
(definline complex-type.fid* ()
#c(1.0d0 0.0d0))
+(definline complex-type.fconj (a)
+ (declare (type complex-type a))
+ (conjugate a))
+
;;Store operations
(definline allocate-complex-store (size)
"
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index dfb7d42..fd92ddf 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -27,72 +27,66 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(definline real-typed-dot (x y conjugate-p)
- (declare (type real-vector x y)
- (ignore conjugate-p))
- (let ((call-fortran? (> (number-of-elements x)
- *real-l1-fcall-lb*)))
- (cond
- (call-fortran?
- (ddot (number-of-elements x)
- (store x) (aref (strides x) 0)
- (store y) (aref (strides y) 0)
- (head x) (head y)))
- (t
- (let-typed
- ((stp-x (aref (strides x) 0) :type index-type)
- (sto-x (store x) :type real-store-vector)
- (stp-y (aref (strides y) 0) :type index-type)
- (sto-y (store y) :type real-store-vector)
- (nele (number-of-elements x) :type index-type))
- (very-quickly
- (loop repeat nele
- for of-x of-type index-type = (head x) then (+ of-x stp-x)
- for of-y of-type index-type = (head y) then (+ of-y stp-y)
- summing (* (aref sto-x of-x) (aref sto-y of-y)) into dot of-type real-type
- finally (return dot))))))))
-
-(definline complex-typed-dot (x y conjugate-p)
- (declare (type complex-vector x y))
- (let ((call-fortran? (> (number-of-elements x)
- *complex-l1-fcall-lb*)))
- (cond
- (call-fortran?
- (if conjugate-p
- (zdotc (number-of-elements x)
- (store x) (aref (strides x) 0)
- (store y) (aref (strides y) 0)
- (head x) (head y))
- (zdotu (number-of-elements x)
- (store x) (aref (strides x) 0)
- (store y) (aref (strides y) 0)
- (head x) (head y))))
- (t
- (let-typed
- ((stp-x (aref (strides x) 0) :type index-type)
- (sto-x (store x) :type complex-store-vector)
- (stp-y (aref (strides y) 0) :type index-type)
- (sto-y (store y) :type complex-store-vector)
- (nele (number-of-elements x) :type index-type))
- (if conjugate-p
- (very-quickly
- (loop repeat nele
- for of-x of-type index-type = (head x) then (+ of-x stp-x)
- for of-y of-type index-type = (head y) then (+ of-y stp-y)
- summing (let-typed ((xval (complex (aref sto-x (* 2 of-x)) (- (aref sto-x (1+ (* 2 of-x))))) :type complex-type)
- (yval (complex (aref sto-y (* 2 of-y)) (aref sto-y (1+ (* 2 of-y)))) :type complex-type))
- (* xval yval))
- into dot of-type complex-type
- finally (return dot)))
- (very-quickly
- (loop repeat nele
- for of-x of-type index-type = (head x) then (+ of-x stp-x)
- for of-y of-type index-type = (head y) then (+ of-y stp-y)
- summing (let-typed ((xval (complex (aref sto-x (* 2 of-x)) (aref sto-x (1+ (* 2 of-x)))) :type complex-type)
- (yval (complex (aref sto-y (* 2 of-y)) (aref sto-y (1+ (* 2 of-y)))) :type complex-type))
- (* xval yval))
- into dot of-type complex-type
- finally (return dot)))))))))
+(defmacro generate-typed-dot (func (tensor-class blas-func blasc-func conj-func fortran-lb))
+ (let* ((opt (get-tensor-class-optimization-hashtable tensor-class))
+ (conj? (and blasc-func conj-func))
+ (blas? (or blas-func blasc-func)))
+ (assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ `(definline ,func (x y conjugate-p)
+ (declare (type ,tensor-class x y)
+ ,(if conj?
+ `(type boolean conjugate-p)
+ `(ignore conjugate-p)))
+ ,(let
+ ((lisp-routine
+ `(let-typed
+ ((stp-x (aref (strides x) 0) :type index-type)
+ (sto-x (store x) :type complex-store-vector)
+ (stp-y (aref (strides y) 0) :type index-type)
+ (sto-y (store y) :type complex-store-vector)
+ (nele (number-of-elements x) :type index-type))
+ ,(labels ((main-loop (conjp)
+ `(very-quickly
+ (loop :repeat nele
+ :for of-x :of-type index-type = (head x) :then (+ of-x stp-x)
+ :for of-y :of-type index-type = (head y) :then (+ of-y stp-y)
+ :with dot :of-type ,(getf opt :element-type) = (,(getf opt :fid+))
+ :do (let-typed ((xval ,(recursive-append
+ (when conjp `(,conj-func))
+ `(,(getf opt :reader) sto-x of-x)) :type ,(getf opt :element-type))
+ (yval (,(getf opt :reader) sto-y of-y) :type ,(getf opt :element-type)))
+ (setf dot (,(getf opt :f+) dot (,(getf opt :f*) xval yval))))
+ :finally (return dot)))))
+ (if conj?
+ `(if conjugate-p
+ ,(main-loop t)
+ ,(main-loop nil))
+ (main-loop nil))))))
+ (if blas?
+ `(let ((call-fortran? (> (number-of-elements x)
+ ,fortran-lb)))
+ (cond
+ (call-fortran?
+ ,(recursive-append
+ (when conj?
+ `(if conjugate-p
+ (,blasc-func (number-of-elements x)
+ (store x) (aref (strides x) 0)
+ (store y) (aref (strides y) 0)
+ (head x) (head y))))
+ `(,blas-func (number-of-elements x)
+ (store x) (aref (strides x) 0)
+ (store y) (aref (strides y) 0)
+ (head x) (head y))))
+ (t
+ ,lisp-routine)))
+ lisp-routine)))))
+
+(generate-typed-dot real-typed-dot
+ (real-tensor ddot nil nil *real-l1-fcall-lb*))
+
+(generate-typed-dot complex-typed-dot
+ (complex-tensor zdotu zdotc complex-type.fconj *complex-l1-fcall-lb*))
;;---------------------------------------------------------------;;
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index 223f78a..d55de3c 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -45,7 +45,7 @@
(t-of (strides to) (head to)))
do (let*-typed ((val-f (,(getf opt :reader) f-sto f-of) :type ,(getf opt :element-type))
(val-t (,(getf opt :reader) t-sto t-of) :type ,(getf opt :element-type))
- (mul (* val-f val-t) :type ,(getf opt :element-type)))
+ (mul (,(getf opt :f*) val-f val-t) :type ,(getf opt :element-type)))
(,(getf opt :value-writer) mul t-sto t-of)))))))
(if fortran-func
`(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
@@ -75,7 +75,7 @@
(mod-dotimes (idx (dimensions to))
with (linear-sums
(t-of (strides to) (head to)))
- do (let ((scal-val (* (,(getf opt :reader) t-sto t-of) alpha)))
+ do (let ((scal-val (,(getf opt :f*) (,(getf opt :reader) t-sto t-of) alpha)))
(,(getf opt :value-writer) scal-val t-sto t-of)))))))
(if blas-func
`(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
@@ -105,7 +105,7 @@
(t-of (strides to) (head to)))
do (let*-typed ((val-f (,(getf opt :reader) f-sto f-of) :type ,(getf opt :element-type))
(val-t (,(getf opt :reader) t-sto t-of) :type ,(getf opt :element-type))
- (mul (/ val-f val-t) :type ,(getf opt :element-type)))
+ (mul (,(getf opt :f/) val-f val-t) :type ,(getf opt :element-type)))
(,(getf opt :value-writer) mul t-sto t-of)))))))
(if fortran-func
`(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
@@ -135,7 +135,7 @@
(mod-dotimes (idx (dimensions to))
with (linear-sums
(t-of (strides to) (head to)))
- do (let-typed ((scal-val (/ alpha (,(getf opt :reader) t-sto t-of)) :type ,(getf opt :element-type)))
+ do (let-typed ((scal-val (,(getf opt :f/) alpha (,(getf opt :reader) t-sto t-of)) :type ,(getf opt :element-type)))
(,(getf opt :value-writer) scal-val t-sto t-of)))))))
(if fortran-func
`(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
@@ -144,7 +144,7 @@
((and call-fortran? min-stride)
(let ((num-array (,(getf opt :store-allocator) 1)))
(declare (type ,(linear-array-type (getf opt :store-type)) num-array))
- (let-typed ((id (,(getf opt :coercer) 1) :type ,(getf opt :element-type)))
+ (let-typed ((id (,(getf opt :fid*)) :type ,(getf opt :element-type)))
(,(getf opt :value-writer) id num-array 0))
(,fortran-func (number-of-elements to) num-array 0 (store to) min-stride (head to))))
(t
-----------------------------------------------------------------------
Summary of changes:
matlisp.asd | 8 +-
src/classes/complex-tensor.lisp | 4 +
src/level-1/dot.lisp | 124 ++++++++++++++++++--------------------
src/level-1/scal.lisp | 10 ++--
4 files changed, 72 insertions(+), 74 deletions(-)
hooks/post-receive
--
matlisp
|
