Sat Feb 20 18:24:36 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Cache overload resolution on sbcl

--- old-smoke/src/sb-optimize.lisp 2014-10-30 08:06:16.000000000 +0100

+++ new-smoke/src/sb-optimize.lisp 2014-10-30 08:06:16.000000000 +0100

@@ -92,23 +92,38 @@

sequence argument-names)))))))))))

-;;; cache ==================================================================

+;;; Cache overload resolution / method lookup

+

+;;; FIXME the cached lookup should be faster

+;;;

+;;; cache return value conversion

+;;;

+;;; Using the gf symbol instead of the method name would be better,

+;;; althoug we would have to invent one for constructors.

;;;

-;;; we could replace the call to #'find-best-viable-function in

-;;; #'call-using-args with a call to

-;;; #'find-best-viable-function-cached, but it is only doubles speed.

+;;; Since the -using-types stuff was intended for for compile time

+;;; expansion it is not that well suited for this. i.e. passing

+;;; closures would be better than the actual syntax.

+;;;

+;;; For qt.tests the uncached calls make up 30 % of all calls.

+;;; qt.examples:colliding-mice (run for ~1 min) gets 20 % uncached

+;;; calls and qt.examples:class-browser get 10 %. (20 February 2010)

-(sb-int:defun-cached (find-best-viable-function-using-types-cached

+(sb-int:defun-cached (find-best-viable-function-using-layouts-cached

:hash-function (lambda (name arguments

class const-p)

(declare (string name)

(list arguments)

- (class class)

+ (sb-c::layout class)

(boolean const-p))

(logand

(logxor

(sxhash name)

- (sxhash arguments)

+ (the fixnum

+ (reduce

+ #'logxor

+ (mapcar #'sb-c::layout-clos-hash

+ arguments)))

(sxhash class)

(sxhash const-p))

#x1FF))

@@ -117,25 +132,28 @@

(declare (optimize (speed 3))

(inline find-best-viable-function-using-types))

(multiple-value-bind (method conversion-sequence)

- (find-best-viable-function-using-types name arguments class const-p)

+ (find-best-viable-function-using-types

+ name (mapcar #'sb-pcl::wrapper-class* arguments)

+ class const-p)

(list method (mapcar #'(lambda (s)

(if (symbolp s)

(fdefinition s)

#'(lambda (x)

+ (declare (optimize (speed 3)))

(funcall (fdefinition (first s))

x

- (second s)))))

+ (eval (second s))))))

conversion-sequence))))

-

+

(declaim (inline find-best-viable-function-cached))

(defun find-best-viable-function-cached (name arguments class const-p)

(declare (optimize (speed 3)))

(catch 'unspecific-type

(return-from find-best-viable-function-cached

(values-list

- (find-best-viable-function-using-types-cached

+ (find-best-viable-function-using-layouts-cached

name

- (mapcar #'(lambda (o) (class-of o)) arguments)

+ (mapcar #'(lambda (o) (sb-c::layout-of o)) arguments)

class

const-p))))

(find-best-viable-function name arguments class const-p))