[Ecls-list] Hopefully some innovation..

[Juan Jose Garcia-Ripoll]

Hi,

I am working on a major fix in ECL which, however, does not involve a
lot of coding. I am currently conducting the usual tests and the code
HAS NOT YET been committed to CVS. If after reading this email
somebody sees a major objection on this change or has an idea for
other kind of testing, please speak up :-)

The idea is very simple. When generic functions are called, the
appropiate method has to be selected based on the argument types. This
computation is costly and it is cached on a hash table. Traditionally,
this table is a per-function one. This is how PCL was coded and it is
also how ECL, CMUCL, SBCL and probably others evolved.

I have decided to use instead a thread-local hash table. This has the
potential of saving bytes for generic functions which are not called
that often, but also using larger hash tables means we may be more
efficient when caching these function calls. In addition, I have
changed the hashing algorithm, making it the same as in the ordinary
hash tables.

The only risky issue is when to clean the hashes. They have to be
partially purged whenever a generic function definition changes or
when a method is added. Potentially, one might need to establish a
per-hash lock, but I have come to the conclusion that this is not
really the case and that one should use a different approach that
prevents a generic function from being invoked while it is being
redefined or updated -- the clearing of the hash table being a minor
step in that process. In any case, current code is _NOT_ safer than
the changes I am going to introduce.

Anyway, preliminary tests show a 40% decrease in execution time and
30% in consing, both with and without threads. I include below the
profile outcome and the file I used to do it -- and which I think
might be useful to profile other aspects of CLOS --. Of course, one
might build a more realistic test, using not only a single method but
multiple ones, but I think it is remarkable that it already represents
an improvement for this simple scenario.

Juanjo

--- outcome ---

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; NO THREADS, FUNCTION-LOCAL HASH
;;;

;;; CLASS DEFINITION
real time : 0.399 secs
run time  : 0.391 secs
gc count  : 7 times
consed    : 12469248 bytes

;;; INSTANCE CREATION
real time : 0.029 secs
run time  : 0.028 secs
gc count  : 1 times
consed    : 1727272 bytes

;;; METHOD INVOCATION
real time : 0.789 secs
run time  : 0.781 secs
gc count  : 8 times
consed    : 23396104 bytes

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; NO THREADS, THREAD-LOCAL HASH
;;;

;;; CLASS DEFINITION
real time : 0.399 secs
run time  : 0.393 secs
gc count  : 7 times
consed    : 12441768 bytes

;;; INSTANCE CREATION
real time : 0.042 secs
run time  : 0.041 secs
gc count  : 1 times
consed    : 1405260 bytes

;;; METHOD INVOCATION
real time : 0.479 secs
run time  : 0.475 secs
gc count  : 6 times
consed    : 17224672 bytes

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THREADS, FUNCTION-LOCAL HASH
;;;

;;; CLASS DEFINITION
real time : 0.548 secs
run time  : 0.539 secs
gc count  : 7 times
consed    : 12465896 bytes

;;; INSTANCE CREATION
real time : 0.036 secs
run time  : 0.034 secs
gc count  : 1 times
consed    : 1760464 bytes

;;; METHOD INVOCATION
real time : 1.280 secs
run time  : 1.257 secs
gc count  : 9 times
consed    : 23253536 bytes

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THREADS, THREAD-LOCAL HASH
;;;

;;; CLASS DEFINITION
real time : 0.550 secs
run time  : 0.542 secs
gc count  : 5 times
consed    : 12478576 bytes

;;; INSTANCE CREATION
real time : 0.053 secs
run time  : 0.053 secs
gc count  : 1 times
consed    : 1405052 bytes

;;; METHOD INVOCATION
real time : 0.775 secs
run time  : 0.766 secs
gc count  : 6 times
consed    : 17224672 bytes


--- test.lisp ---

(defvar *instances* nil)

(defun make-name (number)
  (intern (format nil "NAME-~D" number)))

(defun make-tree (depth)
  (let ((*counter* 0))
    (declare (special *counter*))
    (labels ((recurse (depth)
	       (if (minusp depth)
		   nil
		   (list (make-name (incf *counter*))
			 (recurse (1- depth))
			 (recurse (1- depth))))))
      (recurse depth))))

(defun make-classes (tree)
  (labels ((recurse (parent tree)
	     (when tree
	       (let ((ancestor (if parent (list parent) '()))
		     (name (first tree)))
		 (eval `(defclass ,name ,ancestor ((s :initform ',name))))
		 (eval `(defmethod get-foo ((x ,name)) ',name))
		 (recurse name (second tree))
		 (recurse name (third tree))))))
      (recurse nil tree)))

(defun make-instances (tree)
  (setf *instances* (make-array '(128) :adjustable t :fill-pointer 0))
  (labels ((recurse (tree)
	     (when tree
	       (vector-push-extend (make-instance (first tree)) *instances*)
	       (recurse (second tree))
	       (recurse (third tree)))))
      (recurse tree)))

(defun random-instance ()
  (aref *instances* (random (length *instances*))))

(let ((tree (make-tree 8)))
  (format t "~%;;; CLASS DEFINITION")
  (time (make-classes tree))
  (format t "~%;;; INSTANCE CREATION")
  (time (make-instances tree)))

(format t "~%;;; METHOD INVOCATION")
(time
 (dotimes (i 100000)
   (get-foo (random-instance))))


-- 
Facultad de Fisicas, Universidad Complutense,
Ciudad Universitaria s/n Madrid 28040 (Spain)
http://juanjose.garciaripoll.googlepages.com