NOTE: This patch has been committed. The version below is informational only (whitespace differences have been removed). ChangeLog addition: 2006-01-10 Didier Verna &lt;didier(a)lrde.epita.fr&gt; * 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