Wed Jul 8 22:41:19 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Speedup overload resolution and some other stuff for faster C++ method calling.
hunk ./src/clos.lisp 120
- ((pointer :type smoke-standard-class))
+ ()
hunk ./src/clos.lisp 123
-(defmethod pointer ((class cxx:class))
- (pointer (slot-value class 'pointer)))
-
hunk ./src/clos.lisp 160
- :pointer superclass
+ :id (id superclass)
hunk ./src/clos.lisp 181
- :pointer superclass
+ :id (id superclass)
hunk ./src/clos.lisp 206
- :pointer [_$_]
- (pointer class)
- ;(mem-aref (smoke-array-pointer [_$_]
- ; (smoke-module-classes
- ; (smoke class)))
- ; 'smoke-class
- ; (id class))
+ :id (id class)
hunk ./src/clos.lisp 287
- (setf (top stack) (pointer stack))
+ (setf (call-stack-top stack) (call-stack-pointer stack))
hunk ./src/clos.lisp 391
+ (declare (optimize (speed 3)))
hunk ./src/clos.lisp 397
- ;(id (class-of object)) (id (real-class class))))
hunk ./src/method.lisp 68
-
hunk ./src/method.lisp 151
- (eval-startup (:execute)
- (make-smoke-classes ,package ,smoke)
+ (eval-startup (:load-toplevel :execute)
+ ;; eval on startup for class map.
+ (make-smoke-classes ,package ,smoke))
+ (eval-when (:load-toplevel :execute)
hunk ./src/objects/class.lisp 4
- ;; FXIME maybe change back to id
- ((pointer ;:type foreign-pointer
- :initarg :pointer
- :reader pointer)
- (smoke :type smoke-module
- :initarg :smoke
- :reader smoke))
- (:documentation "A class"))
+ ((id :initform 0 :type smoke-index :reader id :initarg :id)
+ (smoke :type smoke-module :reader smoke :initarg :smoke)))
hunk ./src/objects/class.lisp 8
- (make-instance 'smoke-class
- :pointer (mem-aref (smoke-array-pointer (smoke-module-classes
- smoke))
- 'smoke-class
- id)
- :smoke smoke))
+ (make-instance 'smoke-class :id id :smoke smoke))
hunk ./src/objects/class.lisp 10
-(defmethod id ((class smoke-class))
- (declare (values (smoke-index 0))
- (optimize (speed 3)))
- (values
- (floor
- (the (integer 0)
- (- (pointer-address (pointer class))
- (pointer-address (smoke-array-pointer (smoke-module-classes
- (smoke class))))))
- #.(cffi:foreign-type-size 'smoke-class))))
+
+(declaim (inline smoke-class-pointer))
+(defun smoke-class-pointer (class)
+ (mem-aref (the foreign-pointer (smoke-array-pointer (smoke-module-classes
+ (smoke class))))
+ 'smoke-class
+ (the smoke-index (id class))))
hunk ./src/objects/class.lisp 20
- (foreign-slot-value (pointer class)
+ (foreign-slot-value (smoke-class-pointer class)
hunk ./src/objects/class.lisp 25
- `(foreign-slot-value (pointer ,class)
+ `(foreign-slot-value (smoke-class-pointer ,class)
hunk ./src/objects/class.lisp 39
- (setf (slot-value class 'pointer)
- (mem-aref (smoke-array-pointer (smoke-module-classes smoke))
- 'smoke-class
- id))
+ (setf (slot-value class 'id)
+ id)
hunk ./src/objects/class.lisp 87
- :pointer (smoke-get-class [_$_]
- (foreign-slot-value c 'smoke-module-index 'smoke)
- (foreign-slot-value c 'smoke-module-index 'index))
+ :id (foreign-slot-value c 'smoke-module-index 'index)
hunk ./src/objects/method.lisp 136
+ (declare (optimize (speed 3)))
hunk ./src/objects/method.lisp 210
- (call-next-method)))
+ (the smoke-index (call-next-method))))
hunk ./src/objects/stack.lisp 3
-(defclass call-stack ()
- ((pointer :reader pointer :initarg :pointer
- :initform (null-pointer)
- :type foreign-pointer
- :documentation "Pointer to the Smoke stack")
- (top :accessor top :initarg :top
- :initform (null-pointer)
- :type foreign-pointer
- :documentation "Pointer to push the next argument to."))
- (:documentation "Contains the argument passed to a Smoke method."))
+(declaim (inline %make-call-stack))
+(defstruct (call-stack (:constructor %make-call-stack))
+ (pointer (null-pointer) :type foreign-pointer)
+ (top (null-pointer) :type foreign-pointer))
hunk ./src/objects/stack.lisp 12
- (- (pointer-address (top stack))
- (pointer-address (pointer stack)))
+ (- (pointer-address (call-stack-top stack))
+ (pointer-address (call-stack-pointer stack)))
hunk ./src/objects/stack.lisp 17
- (declare (optimize (speed 3)))
- (make-instance 'call-stack
- :pointer smoke-stack
- :top (inc-pointer smoke-stack (foreign-type-size 'smoke-stack-item))))
+ (declare (type foreign-pointer smoke-stack)
+ (optimize (speed 3)))
+ (%make-call-stack
+ :pointer smoke-stack
+ :top (inc-pointer smoke-stack
+ #.(foreign-type-size 'smoke-stack-item))))
hunk ./src/objects/stack.lisp 25
- (setf (foreign-slot-value (top stack)
+ (setf (foreign-slot-value (call-stack-top stack)
hunk ./src/objects/stack.lisp 27
- (incf-pointer (top stack) #.(foreign-type-size 'smoke-stack-item)))
+ (incf-pointer (call-stack-top stack) #.(foreign-type-size 'smoke-stack-item)))
hunk ./src/objects/stack.lisp 32
- (setf (foreign-slot-value (top ,stack)
+ (setf (foreign-slot-value (call-stack-top ,stack)
hunk ./src/objects/stack.lisp 34
- (incf-pointer (top ,stack) ,(foreign-type-size 'smoke-stack-item)))
+ (incf-pointer (call-stack-top ,stack)
+ ,(foreign-type-size 'smoke-stack-item)))
hunk ./src/objects/stack.lisp 41
+ :type foreign-pointer
hunk ./src/objects/type.lisp 123
+ (declare (optimize (speed 3)))
hunk ./src/objects/type.lisp 127
- (id type))
+ (the smoke-index (id type)))
hunk ./src/overload-resolution.lisp 79
+;;; INLINE OPTIMIZE
+(declaim (inline first-unabigious-index))
hunk ./src/overload-resolution.lisp 99
- (declare (type (smoke-index 0) start end))
+ (declare (type (smoke-index 0) start end)
+ (dynamic-extent start))
hunk ./src/overload-resolution.lisp 117
- (dynamic-extent method index cmp))
+ (dynamic-extent method))
hunk ./src/overload-resolution.lisp 196
-(defclass std-conversion ()
- ((function-name :accessor conversion-function-name
- :initarg :conversion-function-name))
- (:documentation "A conversion"))
+(declaim (inline make-conversion make-exact-match make-promotion
+ make-number-conversion make-pointer-conversion
+ make-boolean-conversion make-user-conversion))
+(defstruct conversion
+ (function-name nil :type (or symbol function) :read-only t)
+ (rank -1 :type fixnum :read-only t))
hunk ./src/overload-resolution.lisp 203
-(defclass exact-match (std-conversion)
- ((rank :reader rank
- :allocation :class
- :type fixnum
- :initform +exact-match+)))
+(defstruct (exact-match (:include conversion (rank +exact-match+))))
hunk ./src/overload-resolution.lisp 205
-(defclass promotion (std-conversion)
- ((rank :reader rank
- :allocation :class
- :type fixnum
- :initform +promotion+)))
+(defstruct (promotion (:include conversion (rank +promotion+))))
hunk ./src/overload-resolution.lisp 207
-(defclass number-conversion (std-conversion)
- ((rank :reader rank
- :allocation :class
- :type fixnum
- :initform +conversion+)))
+(defstruct (number-conversion (:include conversion (rank +conversion+))))
hunk ./src/overload-resolution.lisp 209
-(defclass pointer-conversion (std-conversion)
- ((rank :reader rank
- :allocation :class
- :type fixnum
- :initform (1+ +conversion+))
- (from :reader from
- :initarg :from)
- (to :reader to
- :initarg :to)))
+(defstruct (pointer-conversion (:include conversion (rank (1+ +conversion+))))
+ (from (find-class t) :type class :read-only t)
+ (to (find-class t) :type class :read-only t))
hunk ./src/overload-resolution.lisp 213
-(defclass boolean-conversion (std-conversion)
- ((rank :reader rank
- :allocation :class
- :type fixnum
- :initform (+ 2 +conversion+))))
+(defstruct (boolean-conversion (:include conversion (rank (+ 2 +conversion+)))))
hunk ./src/overload-resolution.lisp 215
-(defclass user-conversion (std-conversion)
- ((rank :reader rank
- :allocation :class
- :type fixnum
- :initform (+ 3 +conversion+))))
+(defstruct (user-conversion (:include conversion (rank (+ 3 +conversion+)))))
hunk ./src/overload-resolution.lisp 225
- (< (the fixnum (rank conversion1))
- (the fixnum (rank conversion2)))))
+ (< (the fixnum (conversion-rank conversion1))
+ (the fixnum (conversion-rank conversion2)))))
hunk ./src/overload-resolution.lisp 229
- (if (eq (from conversion1) (from conversion2))
+ (if (eq (pointer-conversion-from conversion1)
+ (pointer-conversion-from conversion2))
hunk ./src/overload-resolution.lisp 232
- (subtypep (to conversion1) (to conversion2))
- (if (eq (to conversion1) (to conversion2))
+ (subtypep (pointer-conversion-to conversion1)
+ (pointer-conversion-to conversion2))
+ (if (eq (pointer-conversion-to conversion1)
+ (pointer-conversion-to conversion2))
hunk ./src/overload-resolution.lisp 237
- (subtypep (from conversion1) (from conversion2))
+ (subtypep (pointer-conversion-from conversion1)
+ (pointer-conversion-from conversion2))
hunk ./src/overload-resolution.lisp 246
- (= (rank conversion1) (rank conversion2)))
+ (= (conversion-rank conversion1) (conversion-rank conversion2)))
hunk ./src/overload-resolution.lisp 277
- `(make-instance ,type
- :conversion-function-name ,(conversion-function name argument)
- [_$_]
+ `(,(symbolicate 'make- (eval type))
+ :function-name ,(conversion-function name argument)
hunk ./src/sb-optimize.lisp 84
- ;; FIXME only cast when needed.
- (cast object
- (find-class (quote ,(class-name [_$_]
- (find-smoke-class
- (get-class method))))))
+ ,(if (eql (type-specifier object)
+ (find-smoke-class (get-class method)))
+ `(pointer object)
+ `(cast object
+ (find-class (quote ,(class-name [_$_]
+ (find-smoke-class
+ (get-class method)))))))
hunk ./src/smoke.lisp 33
- (foreign-slot-value (pointer (get-class method))
+ (foreign-slot-value (smoke-class-pointer (get-class method))
hunk ./src/smoke.lisp 46
- (call-s-method method object-pointer (pointer stack))
- (type-to-lisp (pointer stack) (return-type method))))
+ (call-s-method method object-pointer (call-stack-pointer stack))
+ (type-to-lisp (call-stack-pointer stack) (return-type method))))
hunk ./src/smoke.lisp 51
- (call-s-method method object-pointer (pointer stack))
- (foreign-slot-value (pointer stack) 'smoke-stack-item 'class)))
+ (call-s-method method object-pointer (call-stack-pointer stack))
+ (foreign-slot-value (call-stack-pointer stack) 'smoke-stack-item 'class)))
hunk ./src/smoke.lisp 76
- (call-s-method method (null-pointer) (pointer stack))
- (foreign-slot-value (pointer stack) 'smoke-stack-item 'long)))
+ (call-s-method method (null-pointer) (call-stack-pointer stack))
+ (foreign-slot-value (call-stack-pointer stack) 'smoke-stack-item 'long)))
hunk ./src/smoke.lisp 107
- (foreign-slot-value (pointer (class-of object))
+ (foreign-slot-value (smoke-class-pointer (class-of object))