[lisplab-cvs] r89 - src/matrix

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Fri Aug 28 15:04:22 2009
New Revision: 89

Log:
efficency of allocation

Modified:
   src/matrix/level1-classes.lisp
   src/matrix/level1-util.lisp

Modified: src/matrix/level1-classes.lisp
==============================================================================
--- src/matrix/level1-classes.lisp	(original)
+++ src/matrix/level1-classes.lisp	Fri Aug 28 15:04:22 2009
@@ -107,7 +107,7 @@
     :initarg :store
     :initform nil
     :reader matrix-store
-    :type (array t (*))))
+    :type (simple-array t (*))))
   (:documentation "A full matrix (rows x cols) with unspecified matrix element types.")) 
 
 (defmethod initialize-instance :after ((m matrix-ge) &key (value 0))

Modified: src/matrix/level1-util.lisp
==============================================================================
--- src/matrix/level1-util.lisp	(original)
+++ src/matrix/level1-util.lisp	Fri Aug 28 15:04:22 2009
@@ -20,18 +20,6 @@
 
 (in-package :lisplab)
 
-(defun fill-matrix-with-list (m x)  
-  (let* ((rows (rows m))
-	 (cols (cols m)))
-    (do ((xx x (cdr xx))
-	 (i 0 (1+ i)))
-	((= i rows))
-      (do ((yy (car xx) (cdr yy))
-	   (j 0 (1+ j)))
-	  ((= j cols))
-	(setf (mref m i j) (car yy))))
-    m))
-
 (deftype type-blas-store ()
   '(simple-array double-float (*)))
 
@@ -84,6 +72,18 @@
 		 (complex double-float))
 		(setf ref-blas-complex-store)))
 
+(defun fill-matrix-with-list (m x)  
+  (let* ((rows (rows m))
+	 (cols (cols m)))
+    (do ((xx x (cdr xx))
+	 (i 0 (1+ i)))
+	((= i rows))
+      (do ((yy (car xx) (cdr yy))
+	   (j 0 (1+ j)))
+	  ((= j cols))
+	(setf (mref m i j) (car yy))))
+    m))
+
 (defun column-major-idx (i j rows)
   (truly-the type-blas-idx (+ i (truly-the type-blas-idx (* j rows)))))
 
@@ -95,19 +95,30 @@
 				     (truly-the type-blas-idx col)
 				     rows))))
 
+
 (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)
+  value)
 
 (defun allocate-real-store (size &optional (initial-element 0.0))
-  (make-array size :element-type 'double-float
-	      :initial-element 
-	      (coerce initial-element 'double-float)))
-
+  (let ((x (coerce initial-element 'double-float)))
+    (declare (type double-float x)
+	     (type type-blas-idx size))
+    ;; Stupid efficiency hack, on SBCL. All matrix double and complex double 
+    ;; should call this one
+    (if (= x 0.0) 	
+	(make-array size
+		    :element-type 'double-float
+		    :initial-element 0.0)	
+	(make-array size
+		    :element-type 'double-float
+		    :initial-element x))))
+	     
 (defun ref-blas-complex-store (store row col rows)
   "Accessor for the complet blas store"
   (let ((idx (truly-the type-blas-idx 
@@ -133,8 +144,10 @@
 	 (rv (coerce (realpart value) 'double-float))
 	 (iv (coerce (imagpart value) 'double-float))
 	 (store (allocate-real-store 2size iv)))
-    (declare (type type-blas-idx 2size))
-    (loop for i from 0 below 2size by 2 do
-	 (setf (aref store i) rv))
+    (declare (type type-blas-idx 2size)
+	     (type double-float rv iv))
+    (when (/= rv iv)    
+      (loop for i from 0 below 2size by 2 do
+	   (setf (aref store i) rv)))
     store))