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.

--- old-smoke/src/clos.lisp 2014-10-30 08:12:51.000000000 +0100

+++ new-smoke/src/clos.lisp 2014-10-30 08:12:51.000000000 +0100

@@ -117,12 +117,9 @@

(:documentation "A Smoke C++ class"))

(defclass cxx:class (smoke-standard-class)

- ((pointer :type smoke-standard-class))

+ ()

(:documentation "Metaclass to extend Smoke Objects."))

-(defmethod pointer ((class cxx:class))

- (pointer (slot-value class 'pointer)))

-

(defmethod closer-mop:validate-superclass ((class smoke-standard-class) (superclass standard-class))

T)

@@ -160,7 +157,7 @@

"The first superclass must be an subclass of an smoke class.")

(apply

#'call-next-method class

- :pointer superclass

+ :id (id superclass)

:smoke (smoke superclass)

:direct-superclasses direct-superclasses

args)))

@@ -181,7 +178,7 @@

(apply

#'call-next-method class

- :pointer superclass

+ :id (id superclass)

:smoke (smoke superclass)

:direct-superclasses direct-superclasses

args)))

@@ -206,13 +203,7 @@

:direct-superclasses

(mapcar #'smoke-class-symbol

(smoke-class-direct-superclasses class))

- :pointer

- (pointer class)

- ;(mem-aref (smoke-array-pointer

- ; (smoke-module-classes

- ; (smoke class)))

- ; 'smoke-class

- ; (id class))

+ :id (id class)

:smoke (smoke class)

:metaclass 'smoke-standard-class))

(export (lispify (name class)))))

@@ -293,7 +284,7 @@

(defun put-returnvalue (stack value type object)

(unless (void-p type)

(let ((stack (make-call-stack stack)))

- (setf (top stack) (pointer stack))

+ (setf (call-stack-top stack) (call-stack-pointer stack))

;; FIXME support user conversions.

;; We need to determine which of value and converted-value is

;; passed on the stack. E.g. converted-value can be something like

@@ -397,12 +388,12 @@

;;FIXME use CHANGE-CLASS instead?

(defun cast (object class)

"Returns a pointer of type CLASS to the C++ object of OBJECT."

+ (declare (optimize (speed 3)))

(assert (derived-p (class-of object) class)

()

"Can not cast object ~A of class ~A to class ~A."

object (name (class-of object)) (name class))

(smoke-cast (smoke-module-pointer (smoke (class-of object))) (pointer object)

- ;(id (class-of object)) (id (real-class class))))

(id (class-of object)) (id class)))