[Ecls-list] Second iteration of method cache

[Juan Jose Garcia-Ripoll]

I am quite happy with performance of method caching right now. As the
profiling below, there are things to improve, in particular around the
interpreter (which is responsible for the large consing numbers
there).

Juanjo

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


-------- ECL (CVS) -------------

;;; CLASS DEFINITION
;;;  # classes = 4095
real time : 9.615 secs
run time  : 9.528 secs
gc count  : 13 times
consed    : 103265124 bytes

;;; INSTANCE CREATION
;;;  # instances = 4095
real time : 0.287 secs
run time  : 0.285 secs
gc count  : 1 times
consed    : 10203328 bytes

;;; METHOD INVOCATION
;;;  # methods = 4095
;;;  exhausting cache
real time : 12.365 secs
run time  : 12.278 secs
gc count  : 4 times
consed    : 86474088 bytes

;;; METHOD INVOCATION
;;;  # methods = 10
;;;  checking simple access
real time : 0.021 secs
run time  : 0.021 secs
gc count  : 1 times
consed    : 896096 bytes

;;; INTERPRETED FUNCTION INVOCATION
real time : 0.009 secs
run time  : 0.009 secs
gc count  : 1 times
consed    : 416096 bytes


-------- CLISP 2.41 ----------

;;; CLASS DEFINITION
;;;  # classes = 4095
Real time: 43.657177 sec.
Run time: 42.879524 sec.
Space: 54141384 Bytes
GC: 35, GC time: 1.605158 sec.
;;; INSTANCE CREATION
;;;  # instances = 4095
Real time: 1.329153 sec.
Run time: 1.227821 sec.
Space: 2126916 Bytes
GC: 1, GC time: 0.101195 sec.
;;; METHOD INVOCATION
;;;  # methods = 4095
;;;  exhausting cache
Real time: 63.096287 sec.
Run time: 59.675545 sec.
Space: 204279676 Bytes
GC: 47, GC time: 5.250664 sec.
;;; METHOD INVOCATION
;;;  # methods = 10
;;;  checking simple access
Real time: 0.805814 sec.
Run time: 0.577297 sec.
Space: 13844788 Bytes
GC: 3, GC time: 0.298553 sec.
;;; FUNCTION INVOCATION
Real time: 0.030198 sec.
Run time: 0.029698 sec.
Space: 684788 Bytes



--------- SBCL 1.0.10 -----------

;;; CLASS DEFINITION
STYLE-WARNING: implicitly creating new generic function GET-FOO
;;;  # classes = 4095
Evaluation took:
  46.236 seconds of real time
  42.569225 seconds of user run time
  2.421055 seconds of system run time
  [Run times include 2.663 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  2,699,175,584 bytes consed.

;;; INSTANCE CREATION
;;;  # instances = 4095
Evaluation took:
  1.027 seconds of real time
  0.745658 seconds of user run time
  0.168333 seconds of system run time
  [Run times include 0.08 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  25,464,456 bytes consed.

;;; METHOD INVOCATION
;;;  # methods = 4095
;;;  exhausting cache
Evaluation took:
  11.023 seconds of real time
  10.319587 seconds of user run time
  0.592653 seconds of system run time
  [Run times include 3.333 seconds GC run time.]
  0 calls to %EVAL
  0 page faults and
  617,459,952 bytes consed.

;;; METHOD INVOCATION
;;;  # methods = 10
;;;  checking simple access
Evaluation took:
  0.0 seconds of real time
  3.9e-4 seconds of user run time
  1.e-6 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  0 bytes consed.

;;; FUNCTION INVOCATION
Evaluation took:
  0.0 seconds of real time
  6.1e-5 seconds of user run time
  1.e-6 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  0 bytes consed.
T

------- source file ----------

(defvar *instances* nil)

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

(defun foo ())

(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))))))
      (values (recurse depth) *counter*))))

(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*))))

(multiple-value-bind (tree size)
    (make-tree 11)
  (format t "~%;;; CLASS DEFINITION")
  (format t "~%;;;  # classes = ~D" size)
  (time (make-classes tree))
  (format t "~%;;; INSTANCE CREATION")
  (format t "~%;;;  # instances = ~D" size)
  (time (make-instances tree)))

(progn
 (format t "~%;;; METHOD INVOCATION")
 (format t "~%;;;  # methods = ~D" (length *instances*))
 (format t "~%;;;  exhausting cache")
 (time
  (dotimes (i 10000)
   (get-foo (random-instance)))))


(format t "~%;;; METHOD INVOCATION")
(format t "~%;;;  # methods = ~D" 10)
(format t "~%;;;  checking simple access")
(dotimes (j 10)
   (get-foo (aref *instances* j)))
(time
 (dotimes (i 1000)
   (dotimes (j 10)
     (get-foo (aref *instances* j)))))

(format t "~%;;; FUNCTION INVOCATION")
(eval '(defun faa ()))
(time
 (dotimes (i 1000)
   (dotimes (j 10)
     (faa))))