Sat Feb 20 18:24:36 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Cache overload resolution on sbcl
hunk ./src/clos.lisp 464
- (find-best-viable-function (constructor-name class)
- arguments
- class)
+ (#-sbcl find-best-viable-function
+ #+sbcl find-best-viable-function-cached
+ (constructor-name class)
+ arguments
+ class nil)
hunk ./src/objects/type.lisp 122
+ (declare (optimize (speed 3)))
hunk ./src/objects/type.lisp 124
- (foreign-slot-pointer [_$_]
- (mem-aref (smoke-array-pointer
- (smoke-module-types (smoke type)))
- 'smoke-type
- (the smoke-index (id type)))
- 'smoke-type 'name)
- :pointer)))
+ (foreign-slot-pointer [_$_]
+ (mem-aref (smoke-array-pointer
+ (smoke-module-types (smoke type)))
+ 'smoke-type
+ (the smoke-index (id type)))
+ 'smoke-type 'name)
+ :pointer)))
hunk ./src/overload-resolution.lisp 198
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun conversion-function (name &optional arg)
- (if arg
- `(if (using-typep)
- `(,,name
- (find-class ',(class-name ,arg)))
- #'(lambda (object)
- (funcall (fdefinition ,name)
- object ,arg)))
- `(if (using-typep)
- ,name
- (fdefinition ,name)))))
-
hunk ./src/overload-resolution.lisp 200
- `(,(symbolicate 'make- (eval type))
- :function-name ,(conversion-function name argument)
- ,@args))
+ (flet ((conversion-function (name &optional arg)
+ (if arg
+ `(if (using-typep)
+ `(,,name
+ ,(if (typep ,arg 'class)
+ `(find-class ',(class-name ,arg))
+ `(find-smoke-method (find-class ,(class-name
+ (find-smoke-class
+ (get-class ,arg))))
+ ,(name ,arg))))
+ #'(lambda (object)
+ (funcall (fdefinition ,name)
+ object ,arg)))
+ `(if (using-typep)
+ ,name
+ (fdefinition ,name)))))
+ `(,(symbolicate 'make- (eval type))
+ :function-name ,(conversion-function name argument)
+ ,@args)))
hunk ./src/overload-resolution.lisp 310
- (subtypep type ',lisp-type)
+ (multiple-value-bind (value valid-p)
+ (subtypep type ',lisp-type)
+ (unless valid-p
+ (throw 'unspecific-type type))
+ value)
hunk ./src/overload-resolution.lisp 347
- (12 (and (object.typep 'enum) ;; FIXME enum-type using type
- (smoke-type= type (enum-type object))))
+ (12 (when (object.typep 'enum)
+ (when (using-typep)
+ (throw 'unspecific-type object))
+ (smoke-type= type (enum-type object))))
hunk ./src/overload-resolution.lisp 530
- (find-best-viable-function name
- arguments
- (smoke-class-of object-or-class)
- (when (typep object-or-class
- 'smoke-standard-object)
- (const-p object-or-class)))
+ (#-sbcl find-best-viable-function
+ #+sbcl find-best-viable-function-cached
+ name
+ arguments
+ (smoke-class-of object-or-class)
+ (when (typep object-or-class
+ 'smoke-standard-object)
+ (const-p object-or-class)))
hunk ./src/overload-resolution.lisp 543
- (if (static-p method)
- (apply #'call-sequence method (null-pointer) sequence arguments)
- (apply #'call-sequence method (cast object-or-class (get-class method)) [_$_]
- sequence arguments))))
+ (apply #'call-sequence method
+ (if (static-p method)
+ (null-pointer)
+ (cast object-or-class (get-class method)))
+ sequence arguments)))
hunk ./src/sb-optimize.lisp 95
-;;; cache ==================================================================
+;;; Cache overload resolution / method lookup
+
+;;; FIXME the cached lookup should be faster
hunk ./src/sb-optimize.lisp 99
-;;; 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.
+;;; 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.
+;;;
+;;; 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)
hunk ./src/sb-optimize.lisp 112
-(sb-int:defun-cached (find-best-viable-function-using-types-cached
+(sb-int:defun-cached (find-best-viable-function-using-layouts-cached
hunk ./src/sb-optimize.lisp 117
- (class class)
+ (sb-c::layout class)
hunk ./src/sb-optimize.lisp 122
- (sxhash arguments)
+ (the fixnum
+ (reduce [_$_]
+ #'logxor
+ (mapcar #'sb-c::layout-clos-hash
+ arguments)))
hunk ./src/sb-optimize.lisp 135
- (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)
hunk ./src/sb-optimize.lisp 142
+ (declare (optimize (speed 3)))
hunk ./src/sb-optimize.lisp 145
- (second s)))))
+ (eval (second s))))))
hunk ./src/sb-optimize.lisp 147
- [_$_]
+
hunk ./src/sb-optimize.lisp 154
- (find-best-viable-function-using-types-cached
+ (find-best-viable-function-using-layouts-cached
hunk ./src/sb-optimize.lisp 156
- (mapcar #'(lambda (o) (class-of o)) arguments)
+ (mapcar #'(lambda (o) (sb-c::layout-of o)) arguments)