10 Jan
2006
10 Jan
'06
7:03 p.m.
NOTE: This patch has been committed. The version below is
informational only (whitespace differences have been removed).
ChangeLog addition:
2006-01-10 Didier Verna <didier(a)lrde.epita.fr>
* 2.0/src/oo/cl/t.cl: New (CLOS, linear, signle buffer).
* 2.0/txt/bench.didier: Update for C++ and CLOS.
GSC source patch:
Diff command: svn diff --diff-cmd /usr/bin/diff -x "-u -t -b -B -w"
Files affected: 2.0/src/oo/cl/t.cl 2.0/txt/bench.didier
Index: 2.0/txt/bench.didier
===================================================================
--- 2.0/txt/bench.didier (revision 50)
+++ 2.0/txt/bench.didier (working copy)
@@ -311,11 +311,11 @@
*** Summary
- Linear Randomized
+ Linear S/M Randomized S/M
C 0.31 - 0.33 10.82 - 8.86
Java 0.35 - 0.57 11.00 - 9.10
Eiffel 0.40 - 1.06 11.04 - 9.00
-Commom Lisp 0.55 - 1.10 18.38 - 22.03
+Common Lisp 0.55 - 1.10 18.38 - 22.03
Note for Common Lisp: the best MB version is the sized one, and makes a big
difference. The best randomized MB version is also the sized one.
@@ -324,6 +324,17 @@
Multi buffer versions: randomized time ~ 20 * linear time
+** OO versions
+
+ Linear S
+C++ 10.97
+Common Lisp 52.50
+
+Notes: C++ ~ 30x slower than C
+ CLOS ~ 95x slower than CL dd
+ CLOS ~ 4.8x slower than C++
+
+
Local Variables:
Index: 2.0/src/oo/cl/t.cl
===================================================================
--- 2.0/src/oo/cl/t.cl (revision 0)
+++ 2.0/src/oo/cl/t.cl (revision 0)
@@ -0,0 +1,191 @@
+;;; 1D Image assignation algorithm, CLOS typed version.
+
+(eval-when (:compile-toplevel)
+ (defvar *optimize* t)
+ (if *optimize* (declaim (inline assign)
+ (optimize (speed 3)
+ (compilation-speed 0)
+ (safety 0)
+ (debug 0)))
+ (declaim (optimize (speed 0)
+ (compilation-speed 0)
+ (safety 3)
+ (debug 0)))))
+
+(defvar *size* 800
+ "Dimension for (square) images.")
+
+(defvar *nsteps* 200
+ "Number of times to repeat the algorithm.")
+
+
+
+;;; =========================================================================
+;;; The value heirarchy
+;;; =========================================================================
+
+(defclass value ()
+ ()
+ (:documentation "Base class for all possible image values."))
+
+(defgeneric value-assign (to from)
+ (:documentation "Copy a value into another."))
+
+
+;;; The fixnum-value subclass
+(defclass fixnum-value (value)
+ ((value :type fixnum :initarg :value :accessor fixnum-value-value))
+ (:documentation "Image value class for fixnums."))
+
+(defun make-fixnum-value (&optional (value 0))
+ "Create an instance of a fixnum-value."
+ (make-instance 'fixnum-value :value value))
+
+
+(defmethod value-assign ((to fixnum-value) (from fixnum-value))
+ (setf (fixnum-value-value to) (fixnum-value-value from)))
+
+
+
+;;; =========================================================================
+;;; The point hierarchy
+;;; =========================================================================
+
+(defclass point ()
+ ()
+ (:documentation "Base class for all points."))
+
+(defgeneric point-index (p)
+ (:documentation "Returns the index stored in a point."))
+
+
+;;; The 1d-point subclass
+(defclass 1d-point (point)
+ ((index :type fixnum :initarg :index :accessor 1d-point-index))
+ (:documentation "1D point class."))
+
+(defun make-1d-point (&optional (index 0))
+ "Create an instance of a 1d-point."
+ (make-instance '1d-point :index index))
+
+
+(defmethod point-index ((p 1d-point))
+ (1d-point-index p))
+
+
+
+;;; =========================================================================
+;;; The point-iterator hierarchy
+;;; =========================================================================
+
+(defclass point-iterator ()
+ ()
+ (:documentation "Base class for point iterators."))
+
+(defgeneric point-iterator-start (pit)
+ (:documentation "(Re)Start a point iterator."))
+
+(defgeneric point-iterator-next (pit)
+ (:documentation "Iterate once a point iterator."))
+
+(defgeneric point-iterator-validp (pit)
+ (:documentation
+ "Returns non nil if current iterator value (point) is valid."))
+
+(defgeneric point-iterator-point (pit)
+ (:documentation "Return the current iterator's point."))
+
+
+;;; The 1d-point-iterator subclass
+(defclass 1d-point-iterator (point-iterator)
+ ((max :type fixnum :initarg :max :reader 1d-point-iterator-max)
+ (point :type 1d-point
+ :initform (make-1d-point) :accessor 1d-point-iterator-point))
+ (:documentation "1D point iterator class."))
+
+(defun make-1d-point-iterator (max)
+ "Create an instance of a 1d-point-iterator."
+ (make-instance '1d-point-iterator :max max))
+
+
+(defmethod point-iterator-start ((pit 1d-point-iterator))
+ (setf (1d-point-index (1d-point-iterator-point pit)) 0)
+ pit)
+
+(defmethod point-iterator-next ((pit 1d-point-iterator))
+ (incf (the fixnum (1d-point-index (1d-point-iterator-point pit))))
+ pit)
+
+(defmethod point-iterator-validp ((pit 1d-point-iterator))
+ (< (the fixnum (1d-point-index (1d-point-iterator-point pit)))
+ (the fixnum (1d-point-iterator-max pit))))
+
+(defmethod point-iterator-point ((pit 1d-point-iterator))
+ (1d-point-iterator-point pit))
+
+
+
+;;; =========================================================================
+;;; The image hierarchy
+;;; =========================================================================
+
+(defclass image ()
+ ()
+ (:documentation "Base class for all images."))
+
+(defgeneric make-image-point-iterator (im)
+ (:documentation "Creates an iterator for an image."))
+
+(defgeneric image-value-at-point (im p)
+ (:documentation "Return the value of image at point."))
+
+
+;;; The 1d-fixnum-image subclass
+(defclass 1d-fixnum-image (image)
+ ((data :type (simple-array fixnum) :accessor 1d-fixnum-image-data))
+ (:documentation "1D fixnum image class."))
+
+(defun make-1d-fixnum-image (size)
+ "Create an instance of a 1D fixnum image."
+ (declare (type fixnum size))
+ (let ((im (make-instance '1d-fixnum-image)))
+ ;; Note: should rather be done in an :after specialization of
+ ;; initialize-instance rather than here.
+ (setf (1d-fixnum-image-data im)
+ (let ((zero (make-fixnum-value 0)))
+ (make-array (* size size)
+ :element-type 'fixnum-value
+ :initial-element zero)))
+ im))
+
+
+(defmethod make-image-point-iterator ((im 1d-fixnum-image))
+ (make-1d-point-iterator (array-dimension (1d-fixnum-image-data im) 0)))
+
+(defmethod image-value-at-point ((im 1d-fixnum-image) (p 1d-point))
+ (aref (the (simple-array fixnum-value) (1d-fixnum-image-data im))
+ (1d-point-index p)))
+
+
+
+;;; =========================================================================
+;;; The benchmark function
+;;; =========================================================================
+
+(defun assign (im val)
+ (do ((pit (make-image-point-iterator im) (point-iterator-next pit)))
+ ((not (point-iterator-validp pit)))
+ (value-assign (image-value-at-point im (point-iterator-point pit))
+ val)))
+
+(defun bench ()
+ (let ((val (make-fixnum-value 51))
+ (im (make-1d-fixnum-image *size*)))
+ (format t ";;; ~Aptimized benches for ~D step(s):~&"
+ (if *optimize* "O" "Not o") *nsteps*)
+ (format t ";; CLOS / Linear / Typed:")
+ (time
+ (dotimes (i (the fixnum *nsteps*))
+ (declare (type fixnum i))
+ (assign im val)))
+ im))
--
Didier Verna, didier(a)lrde.epita.fr, http://www.lrde.epita.fr/~didier
EPITA / LRDE, 14-16 rue Voltaire Tel.+33 (1) 44 08 01 85
94276 Le Kremlin-Bicêtre, France Fax.+33 (1) 53 14 59 22 didier(a)xemacs.org