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.
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/clos.lisp	2014-10-30 08:12:49.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)))
 
 
diff -rN -u old-smoke/src/method.lisp new-smoke/src/method.lisp
--- old-smoke/src/method.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/method.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -65,7 +65,6 @@
                              :lambda-list '(object &rest args))
     (export (first symbol-name) :cxx)))
 
-
 (defun setf-method-definition (method)
   `(defun (setf ,(lispify (subseq (name method) 3) :cxx)) (new-value object)
      (,(lispify (name method) :cxx) object new-value)
@@ -149,8 +148,10 @@
              (push export exports))))
     `(progn (check-recompile ,smoke)
             ,@functions
-            (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)
               (ensure-generic-methods ',(hash-table-alist generics)))
             ,@constants
             (eval-when (:load-toplevel :execute)
diff -rN -u old-smoke/src/objects/class.lisp new-smoke/src/objects/class.lisp
--- old-smoke/src/objects/class.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/objects/class.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -1,42 +1,28 @@
 (in-package #:smoke)
 
 (defclass smoke-class ()
-  ;; 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)))
 
 (defun make-smoke-class-from-id (smoke id)
-  (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))
 
-(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))))
 
 (declaim (inline class-slot-value))
 (defun class-slot-value (class slot-name)
-  (foreign-slot-value (pointer class)
+  (foreign-slot-value (smoke-class-pointer class)
                       'smoke-class slot-name))
 
 (define-compiler-macro class-slot-value (&whole form class slot-name)
   (if (constantp slot-name)
-      `(foreign-slot-value (pointer ,class)
+      `(foreign-slot-value (smoke-class-pointer ,class)
                            'smoke-class ,slot-name)
       form))
 
@@ -50,10 +36,8 @@
   (let ((class (make-instance 'smoke-class
                               :smoke smoke)))
     (loop for id from 1 to (smoke-array-length (smoke-module-classes smoke)) do
-         (setf (slot-value class 'pointer)
-               (mem-aref (smoke-array-pointer (smoke-module-classes smoke))
-                         'smoke-class
-                         id))
+         (setf (slot-value class 'id)
+               id)
          (funcall function class))))
 
 (defun external-p (class)
@@ -100,9 +84,7 @@
           :interactive read-new-value
           (setf name new-name))))
     (make-instance 'smoke-class
-                   :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)
                    :smoke (gethash (pointer-address (foreign-slot-value c 'smoke-module-index 'smoke)) *smoke-modules*))))
 
 (defun real-class (class)
diff -rN -u old-smoke/src/objects/method.lisp new-smoke/src/objects/method.lisp
--- old-smoke/src/objects/method.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/objects/method.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -133,6 +133,7 @@
 
 (defun return-type (method)
   "Returns the return type of METHOD."
+  (declare (optimize (speed 3)))
   (make-instance 'smoke-type
                  :id (method-slot-value method 'return-type)
                  :smoke (smoke-method-smoke method)))
@@ -206,7 +207,7 @@
   (declare (optimize (speed 3)))
   (mem-aref (smoke-module-argument-list (smoke argument))
             'smoke-index
-            (call-next-method)))
+            (the smoke-index (call-next-method))))
 
 (defun last-p (argument)
   "Returns T when ARGUMENT is the last argument and NIL otherwise."
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/objects/stack.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -1,46 +1,44 @@
 (in-package #:smoke)
 
-(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))
 
 (defgeneric size (object))
 (defmethod size ((stack call-stack))
   "Returns the size (number of arguments) of STACK."
   (/ 
-   (- (pointer-address (top stack))
-      (pointer-address (pointer stack)))
+   (- (pointer-address (call-stack-top stack))
+      (pointer-address (call-stack-pointer stack)))
    (foreign-type-size 'smoke-stack-item)))
 
 (defun make-call-stack (smoke-stack)
-  (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))))
 
 (defun push-stack (stack value type)
-  (setf (foreign-slot-value (top stack)
+  (setf (foreign-slot-value (call-stack-top stack)
                             'smoke-stack-item type) value)
-  (incf-pointer (top stack) #.(foreign-type-size 'smoke-stack-item)))
+  (incf-pointer (call-stack-top stack) #.(foreign-type-size 'smoke-stack-item)))
 
 (define-compiler-macro push-stack (&whole form stack value type)
   (if (constantp type)
       `(progn 
-         (setf (foreign-slot-value (top ,stack)
+         (setf (foreign-slot-value (call-stack-top ,stack)
                                    'smoke-stack-item ,type) ,value)
-         (incf-pointer (top ,stack) ,(foreign-type-size 'smoke-stack-item)))
+         (incf-pointer (call-stack-top ,stack)
+                       ,(foreign-type-size 'smoke-stack-item)))
       form))
       
 
 (defclass smoke-standard-object ()
   ((pointer :reader pointer
+            :type foreign-pointer
             :initarg :pointer
             :documentation "Pointer to the C++ object.")
    #+clisp (finalizer :type list :initform (list nil))
diff -rN -u old-smoke/src/objects/type.lisp new-smoke/src/objects/type.lisp
--- old-smoke/src/objects/type.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/objects/type.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -120,10 +120,11 @@
   ;; For efficiency just check if the first byte is a null byte;
   ;; No need to convert the entire C string to lisp like in:
   ;;  (null (name type)))
+  (declare (optimize (speed 3)))
   (= 0 (mem-ref (mem-aref (smoke-array-pointer
                            (smoke-module-types (smoke type)))
                           'smoke-type
-                          (id type))
+                          (the smoke-index (id type)))
                 :char)))
               
 
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/overload-resolution.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -76,6 +76,8 @@
         (cstring-cmp (smoke-method-name method)
                      name))))
              
+;;; INLINE OPTIMIZE
+(declaim (inline first-unabigious-index))
 (defun first-unabigious-index (smoke index)
   (declare (type smoke-index index)
            (optimize (speed 3)))
@@ -94,7 +96,8 @@
          (class-id (id class))
          (smoke (smoke class))
          (end (1+ (smoke-array-length (smoke-module-method-maps smoke)))))
-    (declare (type (smoke-index 0) start end))
+    (declare (type (smoke-index 0) start end)
+             (dynamic-extent start))
     (loop until (> start end) do
          (let* ((index (the smoke-index (floor (+ end start) 2)))
                 (method (make-smoke-method 
@@ -111,7 +114,7 @@
                                  'method)))))
                 (cmp (the (integer -1 1) (method-cmp method class-id name))))
            (declare (type (integer -1 1) cmp)
-                    (dynamic-extent method index cmp))
+                    (dynamic-extent method))
            (ecase cmp
              (-1 (setf start (1+ index)))
              (0 (return-from find-method-for-class index))
@@ -190,50 +193,26 @@
 (defconstant +promotion+ 1)
 (defconstant +conversion+ 2))
 
-(defclass std-conversion ()
-  ((function-name :accessor conversion-function-name
-             :initarg :conversion-function-name))
-  (:documentation "A conversion"))
-
-(defclass exact-match (std-conversion)
-  ((rank :reader rank
-         :allocation :class
-         :type fixnum
-         :initform +exact-match+)))
-
-(defclass promotion (std-conversion)
-  ((rank :reader rank
-         :allocation :class
-         :type fixnum
-         :initform +promotion+)))
-
-(defclass number-conversion (std-conversion)
-  ((rank :reader rank
-         :allocation :class
-         :type fixnum
-         :initform +conversion+)))
-
-(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)))
-
-(defclass boolean-conversion (std-conversion)
-  ((rank :reader rank
-         :allocation :class
-         :type fixnum
-         :initform (+ 2 +conversion+))))
-
-(defclass user-conversion (std-conversion)
-  ((rank :reader rank
-         :allocation :class
-         :type fixnum
-         :initform (+ 3 +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))
+
+(defstruct (exact-match (:include conversion (rank +exact-match+))))
+
+(defstruct (promotion (:include conversion (rank +promotion+))))
+
+(defstruct (number-conversion (:include conversion (rank +conversion+))))
+
+(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))
+
+(defstruct (boolean-conversion (:include conversion (rank (+ 2 +conversion+)))))
+
+(defstruct (user-conversion (:include conversion (rank (+ 3 +conversion+)))))
 
 (defgeneric conversion< (conversion1 conversion2)
   (:documentation
@@ -243,16 +222,20 @@
   (:method (conversion1 conversion2)
     (declare (optimize (speed 3)))
     (or (null conversion2)
-        (< (the fixnum (rank conversion1))
-           (the fixnum (rank conversion2)))))
+        (< (the fixnum (conversion-rank conversion1))
+           (the fixnum (conversion-rank conversion2)))))
   (:method ((conversion1 pointer-conversion) (conversion2 pointer-conversion))
     (declare (optimize (speed 3)))
-    (if (eq (from conversion1) (from conversion2))
+    (if (eq (pointer-conversion-from conversion1)
+            (pointer-conversion-from conversion2))
         ;; A->B < A->C <=> B subclass of C
-        (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))
             ;; B->A < C->A <=> B subclass of C
-            (subtypep (from conversion1) (from conversion2))
+            (subtypep (pointer-conversion-from conversion1)
+                      (pointer-conversion-from conversion2))
             nil))))
 
 (defgeneric conversion= (conversion1 conversion2)
@@ -260,7 +243,7 @@
    "Returns true when the standard conversion sequence CONVERSION1
  is indistinguishable from CONVERSION2.")
   (:method (conversion1 conversion2)
-    (= (rank conversion1) (rank conversion2)))
+    (= (conversion-rank conversion1) (conversion-rank conversion2)))
   (:method ((conversion1 (eql nil)) (conversion2 (eql nil)))
     t)
   (:method ((conversion1 pointer-conversion) (conversion2 pointer-conversion))
@@ -291,9 +274,8 @@
 (defmacro make-match (type &optional (name ''identity)
                       (argument nil)
                       &rest args)
-  `(make-instance ,type
-                  :conversion-function-name ,(conversion-function name argument)
-                                                    
+  `(,(symbolicate  'make- (eval type))
+                  :function-name ,(conversion-function name argument)
                   ,@args))
       
 (defun+using-type get-conversion-sequence object (object type &optional user)
diff -rN -u old-smoke/src/sb-optimize.lisp new-smoke/src/sb-optimize.lisp
--- old-smoke/src/sb-optimize.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/sb-optimize.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -81,10 +81,12 @@
                                    sequence args)))
                  `(lambda (object ,@argument-names)
                     (s-call ,(method-form method)
-                            ;; 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)))))))
                             (list ,@(sequence-form
                                      sequence argument-names)))))))))))
diff -rN -u old-smoke/src/smoke.lisp new-smoke/src/smoke.lisp
--- old-smoke/src/smoke.lisp	2014-10-30 08:12:49.000000000 +0100
+++ new-smoke/src/smoke.lisp	2014-10-30 08:12:49.000000000 +0100
@@ -30,7 +30,7 @@
 (declaim (inline call-s-method))
 (defun call-s-method (method object-pointer stack-pointer)
   (foreign-funcall-pointer 
-   (foreign-slot-value (pointer (get-class method))
+   (foreign-slot-value (smoke-class-pointer (get-class method))
                        'smoke-class
                        'class-function)
    ()
@@ -43,13 +43,13 @@
 
 (defun s-call (method object-pointer &optional (args nil))
   (with-stack (stack args (arguments method) )
-    (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))))
 
 (defun pointer-call (method object-pointer &optional (args nil))
   (with-stack (stack args (arguments method) )
-    (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)))
 
 
 (defun smoke-call (class pointer method-name &optional (args nil))
@@ -73,8 +73,8 @@
   ;; 
   (assert (enum-p method))
   (with-stack (stack nil nil)
-    (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)))
 
 (defun delete-pointer (pointer class)
   "Destructs the object at POINTER of type CLASS.
@@ -104,7 +104,7 @@
                               'voidp)
           (smoke-module-binding (smoke (class-of object))))
     (foreign-funcall-pointer 
-     (foreign-slot-value (pointer (class-of object))
+     (foreign-slot-value (smoke-class-pointer (class-of object))
                          'smoke-class
                          'class-function)
      ()