Mon Jun 22 14:18:08 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Speedup overload resolution by calling less into C, more efficient finding of the viable methods
  and various optimizations.
  This breaks Clozure CL -- fix it later.
diff -rN -u old-smoke/CMakeLists.txt new-smoke/CMakeLists.txt
--- old-smoke/CMakeLists.txt	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/CMakeLists.txt	2014-10-01 19:32:19.000000000 +0200
@@ -3,6 +3,5 @@
 project(smoke)
 
 add_subdirectory(src)
-add_subdirectory(examples)
 
 include(UseDoxygen OPTIONAL)
diff -rN -u old-smoke/examples/CMakeLists.txt new-smoke/examples/CMakeLists.txt
--- old-smoke/examples/CMakeLists.txt	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/examples/CMakeLists.txt	1970-01-01 01:00:00.000000000 +0100
@@ -1,16 +0,0 @@
-
-find_package(Qt4)
-set(QT_DONT_USE_QTGUI true)
-include(${QT_USE_FILE})
-
-find_library(SMOKE_KDE_LIBRARY smokekde)
-include(FindPackageHandleStandardArgs)
-find_package_handle_standard_args(smokekde DEFAULT_MSG SMOKE_KDE_LIBRARY)
-
-## kde-hello-world
-if(SMOKE_KDE_LIBRARY)
-	include_directories("${CMAKE_CURRENT_SOURCE_DIR}/../src/smoke-c/")
-
-	add_executable(kde-hello-world kde-hello-world.cpp ../src/smoke-c/csmokebinding.cpp)
-	target_link_libraries(kde-hello-world ${SMOKE_KDE_LIBRARY})
-endif(SMOKE_KDE_LIBRARY)
diff -rN -u old-smoke/examples/kde-hello-world.cpp new-smoke/examples/kde-hello-world.cpp
--- old-smoke/examples/kde-hello-world.cpp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/examples/kde-hello-world.cpp	1970-01-01 01:00:00.000000000 +0100
@@ -1,164 +0,0 @@
-/*
- * Copyright 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
- *
- * Permission is hereby granted, free of charge, to any person
- * obtaining a copy of this software and associated documentation
- * files (the "Software"), to deal in the Software without
- * restriction, including without limitation the rights to use,
- * copy, modify, merge, publish, distribute, sublicense, and/or sell
- * copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following
- * conditions:
- *
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
- * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
- * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
- * OTHER DEALINGS IN THE SOFTWARE.
- */
-
-/**
- * Hello world example using libsmoke-c.
- * Display an KDE Window. */
-
-#include <smoke/qt_smoke.h>
-#include <smoke/kde_smoke.h>
-
-#include "smoke-c.cpp"
-
-#include <iostream>
-
-using namespace std;
-using namespace cl_smoke;
-
-static void
-destructed(Binding* binding, Smoke::Index class_id,
-	void* object)
-{
-	cout << "destructed: " << binding->className(class_id) << endl;
-}
-
-/** No method dispatch in this example. */
-static int
-dispatch(Binding* binding, Smoke::Index method,
-	void* object, Smoke::Stack args, int abstract)
-{
-	return false;
-}
-
-int
-main(int argc, char** argv)
-{
-	init_kde_Smoke(); // calls also init_qt_Smoke();
-	smoke_binding kde = smoke_init(kde_Smoke, reinterpret_cast<void*>(&destructed),
-			reinterpret_cast<void*>(&dispatch));
-	smoke_binding qt = smoke_init(qt_Smoke, reinterpret_cast<void*>(&destructed),
-			reinterpret_cast<void*>(&dispatch));
-
-	Smoke::StackItem stack[5];
-	Smoke::ModuleIndex m;
-	Smoke::ModuleIndex c;
-
-	// bytearray = new QByteArray("foo");
-	{
-		char str[] = "foo";
-
-		smoke_find_class(&c, qt_Smoke, "QByteArray");
-		smoke_find_method(&m, qt_Smoke, c.index, "QByteArray$");
-
-		stack[1].s_class = str;
-
-		smoke_call_method(qt_Smoke, m.index, NULL, stack);
-	}
-	void* bytearray = stack[0].s_class;
-
-
-	// l10n = ki18n(bar);
-	{
-		char str[] = "hello world";
-		smoke_find_class(&c, kde_Smoke, "QGlobalSpace");
-		smoke_find_method(&m, kde_Smoke, c.index, "ki18n$");
-
-		stack[1].s_class = str;
-
-		smoke_call_method(kde_Smoke, m.index, NULL, stack);
-	}
-	void* l10n = stack[0].s_class;
-
-	// about = KAboutData(bytearray, bytearray, l10n, bytearray);
-	{
-		smoke_find_class(&c, kde_Smoke, "KAboutData");
-		smoke_find_method(&m, kde_Smoke, c.index, "KAboutData####");
-
-		stack[1].s_class = bytearray;
-		stack[2].s_class = bytearray;
-		stack[3].s_class = l10n;
-		stack[4].s_class = bytearray;
-
-		smoke_call_method(kde_Smoke, m.index, NULL, stack);
-	}
-	void* about = stack[0].s_class;
-
-
-	// KCmdLineArgs::init(argc, argv, about);
-	{
-		smoke_find_class(&c, kde_Smoke, "KCmdLineArgs");
-		smoke_find_method(&m, kde_Smoke, c.index, "init$?#");
-
-		stack[1].s_int = argc;
-		stack[2].s_class = argv;
-		stack[3].s_class = about;
-
-		smoke_call_method(kde_Smoke, m.index, NULL, stack);
-	}
-
-	// app = new KApplication();
-	void* app;
-	{
-		smoke_find_class(&c, kde_Smoke, "KApplication");
-		smoke_find_method(&m, kde_Smoke, c.index, "KApplication");
-
-		smoke_call_method(kde_Smoke, m.index, NULL, stack);
-		app = stack[0].s_class;
-
-		smoke_set_binding(c.smoke, kde, c.index, app);
-	}
-
-	{
-		smoke_find_class(&c, kde_Smoke, "KGlobalSettings");
-		smoke_find_method(&m, kde_Smoke, c.index, "Disable");
-		smoke_call_method(kde_Smoke, m.index, NULL, stack);
-	}
-
-	// widget = new KXmlGuiWindow();
-	// widget->setupGUI();
-	// widget->show();
-	// return app->exec();
-	void* widget;
-	{
-		smoke_find_class(&c, kde_Smoke, "KXmlGuiWindow");
-		smoke_find_method(&m, kde_Smoke, c.index, "KXmlGuiWindow");
-
-		smoke_call_method(m.smoke, m.index, NULL, stack);
-		widget = stack[0].s_class;
-		smoke_set_binding(c.smoke, kde, c.index, widget);
-
-		smoke_find_method(&m, c.smoke, c.index, "setupGUI");
-		smoke_call_method(m.smoke, m.index, widget, stack);
-
-		smoke_find_method(&m, c.smoke, c.index, "show");
-		smoke_call_method(m.smoke, m.index, widget, stack);
-
-		smoke_find_class(&c, kde_Smoke, "KApplication");
-		smoke_find_method(&m, c.smoke, c.index, "exec");
-		smoke_call_method(m.smoke, m.index, NULL, stack);
-
-		return stack[0].s_int;
-	}
-}
diff -rN -u old-smoke/src/bindings.lisp new-smoke/src/bindings.lisp
--- old-smoke/src/bindings.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/bindings.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -20,3 +20,46 @@
   (with-lock-held (*bindings-lock*)
     (setf (gethash (pointer-address smoke) *bindings*)
           binding)))
+
+(defstruct smoke-array
+  (pointer (null-pointer) :type foreign-pointer)
+  (length 0 :type (smoke-index 0)))
+
+
+(defstruct smoke-module
+  (pointer (null-pointer) :type foreign-pointer)
+  (binding (null-pointer) :type foreign-pointer)
+
+  (classes (make-smoke-array) :type smoke-array)
+  (methods (make-smoke-array) :type smoke-array)
+  (method-maps (make-smoke-array) :type smoke-array)
+  (method-names (make-smoke-array) :type smoke-array)
+  (types (make-smoke-array) :type smoke-array)
+
+  (inheritance-list (null-pointer) :type foreign-pointer)
+  (argument-list (null-pointer) :type foreign-pointer)
+  (ambiguous-method-list (null-pointer) :type foreign-pointer))
+  
+(defvar *smoke-modules* (make-hash-table))
+
+(defun init-smoke-module (module)
+  (let ((smoke (smoke-module-pointer module)))
+    (setf (gethash (pointer-address smoke) *smoke-modules*)
+          module)
+    (flet ((mk-array (array)
+             (make-smoke-array :pointer (cl-smoke-array smoke array)
+                               :length (cl-smoke-array-size smoke array))))
+      (setf (smoke-module-classes module) (mk-array :classes)
+            (smoke-module-methods module) (mk-array :methods)
+            (smoke-module-method-maps module) (mk-array :method-maps)
+            (smoke-module-method-names module) (mk-array :method-names)
+            (smoke-module-types module) (mk-array :types)
+
+            (smoke-module-inheritance-list module)
+            (cl-smoke-array smoke :inheritance-list)
+
+            (smoke-module-argument-list module)
+            (cl-smoke-array smoke :argument-list)
+
+            (smoke-module-ambiguous-method-list module)
+            (cl-smoke-array smoke :ambiguous-method-list)))))
diff -rN -u old-smoke/src/class-map.lisp new-smoke/src/class-map.lisp
--- old-smoke/src/class-map.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/class-map.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -7,16 +7,16 @@
 
 
 (defun id-class-map (smoke)
-  (let ((value (gethash (pointer-address smoke)
+  (let ((value (gethash (pointer-address (smoke-module-pointer smoke))
                         *smoke-id-class-map*)))
     (assert value 
             ()
             "Unknown smoke module ~A ~A."
-            smoke (smoke-get-module-name smoke))
+            smoke (smoke-get-module-name (smoke-module-pointer smoke)))
     value))
 
 (defun (setf id-class-map) (new-value smoke)
-  (setf (gethash (pointer-address smoke) *smoke-id-class-map*)
+  (setf (gethash (pointer-address (smoke-module-pointer smoke)) *smoke-id-class-map*)
         new-value))
 
 (defun add-id-class-map (smoke)
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/clos.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -92,7 +92,7 @@
                (go-next camel-case)
                (go-next default)))))
   (namespace
-   "Convert camelCase to lisp-style."
+   "C++ namespace separator"
    (assert (eql #\: char))
    (append-char #\.)
    (go-next default))
@@ -117,13 +117,11 @@
   (:documentation "A Smoke C++ class"))
 
 (defclass cxx:class (smoke-standard-class)
-  ((smoke :reader smoke-symbol :initarg :smoke-symbol
-         :type symbol))
+  ((pointer :type smoke-standard-class))
   (:documentation "Metaclass to extend Smoke Objects."))
 
-(defmethod smoke ((class cxx:class))
-  (eval (smoke-symbol class)))
-
+(defmethod pointer ((class cxx:class))
+  (pointer (slot-value class 'pointer)))
 
 (defmethod closer-mop:validate-superclass ((class smoke-standard-class) (superclass standard-class))
   T)
@@ -162,8 +160,8 @@
             "The first superclass must be an subclass of an smoke class.")
     (apply
      #'call-next-method class
-     :id (id superclass)
-     :smoke (get-smoke-variable-for-pointer (smoke superclass))
+     :pointer superclass
+     :smoke (smoke superclass)
      :direct-superclasses direct-superclasses
      args)))
 
@@ -183,8 +181,8 @@
             
     (apply
      #'call-next-method class
-     :id (id superclass)
-     :smoke (get-smoke-variable-for-pointer (smoke superclass))
+     :pointer superclass
+     :smoke (smoke superclass)
      :direct-superclasses direct-superclasses
      args)))
 
@@ -197,10 +195,9 @@
 
 (defun make-smoke-classes (package smoke)
   "Construts a lisp class in PACKAGE for each one in the Smoke module SMOKE."
-  (declare (foreign-pointer smoke)
-           (optimize (speed 3)))
-	   (let ((*package* (find-package package)))
-  (add-id-class-map smoke)
+  (declare (optimize (speed 3)))
+  (let ((*package* (find-package package)))
+    (add-id-class-map smoke)
     (map-classes 
      #'(lambda (class)
          (unless (external-p class)
@@ -209,7 +206,13 @@
                                             :direct-superclasses
                                             (mapcar #'smoke-class-symbol
                                                     (smoke-class-direct-superclasses class))
-                                            :id (id class)
+                                            :pointer 
+                                            (pointer class)
+                                            ;(mem-aref (smoke-array-pointer 
+                                            ;           (smoke-module-classes
+                                            ;            (smoke class)))
+                                            ;          'smoke-class
+                                            ;          (id class))
                                             :smoke (smoke class)
                                             :metaclass 'smoke-standard-class))
            (export (lispify (name class)))))
@@ -222,9 +225,11 @@
   (:metaclass closer-mop:funcallable-standard-class)
   (:documentation "Smoke generic function."))
 
+(declaim (inline smoke-class-of))
 (defun smoke-class-of (object)
   "Returns the class of OBJECT or OBJECT iff it alread is a class."
-  (if (subtypep (class-of object) (find-class 'smoke-class))
+  (declare (optimize (speed 3)))
+  (if (typep object 'smoke-class)
       object
       (class-of object)))
   
@@ -232,7 +237,8 @@
 ;;; ENSURE-METHOD is only called as needed.
 (defmethod no-applicable-method ((gf smoke-gf) &rest args)
   "Calls the smoke method."
-  (declare (optimize (speed 3)))
+  (declare (dynamic-extent args)
+           (optimize (speed 3)))
   (call-using-args (first args) (name gf) (rest args)))
 
 (defmethod add-method :after ((gf cxx-method-generic-function) method)
@@ -248,28 +254,31 @@
                            (list ,@(rest lambda-list))))))))
 
 (defcallback destructed :void
-  ((binding :pointer)
-   (id smoke-index)
-   (object-pointer :pointer))
-  (declare (ignore binding id)
-           (optimize (speed 3)))
+  ((object-pointer :pointer))
+  (declare (optimize (speed 3)))
   (let ((object (get-object object-pointer)))
     (when object
       (cancel-finalization object)
       (remove-object object-pointer)
       (setf (slot-value object 'pointer) (null-pointer)))))
 
+(declaim (inline argument-to-lisp))
+(defun argument-to-lisp (stack-item type)
+  ;; FIXME do not take ownership of stack allocated objects.
+  (type-to-lisp stack-item type))
+
 (defun stack-to-args (stack arg &optional (args nil))
   "Returns the arguments in STACK, where ARG is the type
 of the first argument, as an list of Lisp objects."
   (if (end-p arg)
-      args
-      (stack-to-args (cffi:inc-pointer stack
-                                       (cffi:foreign-type-size 'smoke-stack-item))
+      (reverse args)
+      (stack-to-args (inc-pointer stack
+                                  (foreign-type-size 'smoke-stack-item))
                      (next arg)
-                     (append args (list
-                                   (type-to-lisp (cffi:mem-ref stack 'smoke-stack-item)
-                                                 arg))))))
+                     (push (argument-to-lisp (mem-ref stack
+                                                  'smoke-stack-item)
+                                         arg)
+                           args))))
 
 (defun convert-argument (argument type &optional (user t))
   "Returns ARGUMENT converted to TYPE. If USER is true, user defined
@@ -304,40 +313,47 @@
 (defcallback dispatch-method :boolean
   ((binding :pointer)
    (method smoke-index)
-   (object :pointer)
+   (object-ptr :pointer)
    (stack smoke-stack)
    (abstract :boolean))
   (declare (optimize (speed 3)))
-  (let* ((method (make-instance 'smoke-method
-                                :id method
-                                :smoke (smoke-get-smoke binding))))
+  (let* ((method (make-smoke-method
+                  :smoke (gethash (pointer-address (smoke-get-smoke binding))
+                                  *smoke-modules*)
+                  :id method)))
     (loop
        (restart-case
            (return-from dispatch-method
              (let ((gf (get-gf-for-method method)))
+               (declare (function gf))
                (if (null (gf-methods gf))
                    (progn
                      (when abstract
                        (error "Abstract method ~A called."
                               (method-declaration method)))
                      nil)
-                   (let ((object (get-object object)))
+                   (let ((object (get-object object-ptr)))
+                     ;; FIXME:
+                     ;;(assert object
+                     ;;       (object)
+                     ;;       "No object for ~A to call ~A." object-ptr method)
                      (if object
                          (progn
-                           (put-returnvalue
-                            stack
-                            (apply gf object
-                                   (stack-to-args
-                                    (cffi:inc-pointer stack 
-                                                      (cffi:foreign-type-size
-                                                       'smoke-stack-item))
-                                    (get-first-argument method)))
-                            (return-type method)
-                            object)
-                           t)
+                     (put-returnvalue stack
+                                      (apply gf object
+                                             (stack-to-args
+                                              (inc-pointer stack 
+                                                           (foreign-type-size
+                                                            'smoke-stack-item))
+                                              (get-first-argument method)))
+                                      (return-type method)
+                                      object)
+                     t)
                          nil)))))
+         ;; Restarts to prevent stack unwinding across the C++ stack.
          (call-default ()
            :report (lambda (stream)
+                     (declare (stream stream))
                      (format stream "Call default implementation ~A instead."
                              method))
            :test (lambda (condition)
@@ -346,6 +362,7 @@
            (return-from dispatch-method nil))
          (use-returnvalue (return-value)
            :report (lambda (stream)
+                     (declare (stream stream))
                      (format stream "Supply a return value for ~A."
                              (method-declaration method)))
            :test (lambda (condition)
@@ -356,10 +373,11 @@
                           (multiple-value-list (eval (read *query-io*))))
            (put-returnvalue stack return-value 
                             (return-type method)
-                            (get-object object))
+                            (get-object object-ptr))
            (return-from dispatch-method t))
          (return ()
                  :report (lambda (stream)
+                           (declare (stream stream))
                            (format stream "Return void for ~A."
                                    (method-declaration method)))
                  :test (lambda (condition)
@@ -368,7 +386,8 @@
                  (return-from dispatch-method (values)))
          (retry ()
            :report (lambda (stream)
-                     (format stream "Try again calling ~A" 
+                     (declare (stream stream))
+                     (format stream "Try again calling ~A." 
                              (method-declaration method))))))))
 
 ;;FIXME use CHANGE-CLASS instead?
@@ -378,10 +397,9 @@
           ()
           "Can not cast object ~A of class ~A to class ~A."
           object (name (class-of object)) (name class))
-  (smoke-cast (smoke (class-of object)) (pointer object)
+  (smoke-cast (smoke-module-pointer (smoke (class-of object))) (pointer object)
               ;(id (class-of object)) (id (real-class class))))
-              (id (class-of object)) (class-id (smoke (class-of object))
-                                               class)))
+              (id (class-of object)) (id class)))
 
 
 (defun upcast (object class)
@@ -389,7 +407,7 @@
           ()
           "Can not upcast object ~A of class ~A to class ~A."
           object (name (class-of object)) (name class))
-  (smoke-cast (smoke class) (pointer object)
+  (smoke-cast (smoke-module-pointer (smoke class)) (pointer object)
               (id (class-of object)) (id (real-class class))))
 
 
@@ -417,6 +435,7 @@
                                        &key args &allow-other-keys)
   "Initializes a Smoke object. Calls its constructor with the arguments supplied
 by the key :ARGS and sets the smoke binding."
+  (declare (optimize (speed 3)))
   (assert (not (and (slot-boundp object 'pointer)
                     (not (null args))))
           ((slot-value object 'pointer) args)
@@ -424,31 +443,35 @@
           (slot-value object 'pointer) args)
   (unless (slot-boundp object 'pointer)
     (setf (slot-value object 'pointer) (call-constructor object args))
-    (set-binding object (binding (smoke (class-of object))))
+    (set-binding object)
     (take-ownership object)
     (add-object object)))
 
 
 (defmethod instance-to-lisp (pointer class type)
-  (let ((ret (make-instance class
-                            :pointer pointer)))
+  (declare (type smoke-standard-class class)
+           (optimize (speed 3)))
+  (let ((ret (make-instance class :pointer pointer)))
     (when (stack-p type)
       (take-ownership ret)
       (add-object ret))
     ret))
 
 (defun keep-wrapper (object new-owner)
-  #-clisp
+  (declare (type smoke-standard-object object)
+           (optimize (speed 3)))
   (when (member object (owned-objects new-owner))
     (cerror "ignore" "~A has already been called for ~A."
             #'keep-wrapper object))
   (push object (owned-objects new-owner)))
 
+(declaim (inline remove-wrapper-object))
 (defun remove-wrapper-object (object owner)
   (remove object (owned-objects owner)))
 
 (defun transfer-ownership-to (object new-owner)
   "Transfers the ownership of OBJECT to C++."
+  (declare (optimize (speed 3)))
   (cancel-finalization object)
   (if (virtual-destructor-p (class-of object))
       (keep-wrapper object new-owner)
diff -rN -u old-smoke/src/method.lisp new-smoke/src/method.lisp
--- old-smoke/src/method.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/method.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,5 +1,4 @@
 (in-package :smoke)
-(declaim (optimize (debug 3)))
 
 (defun constant-definition (package method smoke)
   "Returns an expression that defines a constant for the enum METHOD.
@@ -21,7 +20,7 @@
                        :value ,(enum-call method)
                        :type (make-instance 'smoke-lazy-type
                                             :id ,(id (return-type method))
-                                            :smoke ',smoke))
+                                            :smoke ,smoke))
         :test #'enum=)
      symbol)))
 
@@ -72,20 +71,24 @@
      (,(lispify (name method) :cxx) object new-value)
      new-value))
 
+(defmacro sizes= ((smoke)&rest arrays)
+  `(and ,@(loop for array in arrays collect
+               `(= (smoke-array-length (,array ,smoke))
+                   ,(smoke-array-length (funcall (fdefinition array)
+                                                 (eval smoke)))))))
+
 (defmacro check-recompile (smoke)
   "Raises an error when the fasl of the DEFINE-METHOS was not compiled against
 the current smoke module."
   `(eval-when (:load-toplevel :execute)
-     (unless (and (= (smoke-methods-size ,smoke)
-                     ,(smoke-methods-size (eval smoke)))
-                  (= (smoke-method-name-size ,smoke)
-                     ,(smoke-method-name-size (eval smoke)))
-                  (= (smoke-types-size ,smoke)
-                     ,(smoke-types-size (eval smoke)))
-                  (= (smoke-classes-size ,smoke)
-                     ,(smoke-classes-size (eval smoke))))
+     (unless (sizes= (,smoke)
+                     smoke-module-methods
+                     smoke-module-method-names
+                     smoke-module-method-maps
+                     smoke-module-classes
+                     smoke-module-types)
        (error "The smoke module ~A changed, you need to recompile the lisp file."
-              (smoke-get-module-name ,smoke)))))
+              (smoke-get-module-name (smoke-module-pointer ,smoke))))))
 
 (defmacro define-classes-and-gfs (package smoke)
   "Process the C++ methods of the Smoke module SMOKE.
@@ -132,9 +135,9 @@
                      (if methods (- (id method)) (id method)))))))
      (eval smoke))
     (loop for id being the hash-values of function-symbols do
-         (let ((method (make-instance 'smoke-method
-                                      :id (abs id)
-                                      :smoke (eval smoke))))
+         (let ((method (make-smoke-method
+                        :smoke (eval smoke)
+                        :id (abs id))))
            (multiple-value-bind (definition export)
                (static-method-definition
 	       	package
diff -rN -u old-smoke/src/object-map.lisp new-smoke/src/object-map.lisp
--- old-smoke/src/object-map.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/object-map.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -41,43 +41,36 @@
 except object with a non virtual destuctor which had their ownership transfered
 to C++.")
 
-(declaim (inline ptr -address))
-(defun ptr-address (pointer)
-  ;; CLISP returns NIL for a null pointer
-  #+clisp
-  (if pointer
-      (pointer-address pointer)
-      0)
-  #-clisp
-  (pointer-address pointer))
-
 (declaim (inline get-object))
 (defun get-object (pointer)
-  (gethash (ptr-address pointer) *object-map*))
+  (gethash (pointer-address pointer) *object-map*))
 
 (declaim (inline (setf get-object)))
 (defun (setf get-object) (value pointer)
-  (setf (gethash (ptr-address pointer) *object-map*)
+  (setf (gethash (pointer-address pointer) *object-map*)
         value))
 
+(declaim (inline has-pointer-p))
 (defun has-pointer-p (pointer)
   "Returns T when there is an object for POINTER in the map and NIL otherwise."
-  (nth-value 1 (gethash (ptr-address pointer) *object-map*)))
+  (nth-value 1 (gethash (pointer-address pointer) *object-map*)))
 
 (defun remove-if-exists (pointer)
-  (remhash (ptr-address pointer) *object-map*))
+  (remhash (pointer-address pointer) *object-map*))
 
 (defun remove-object (pointer)
+  (declare (optimize (speed 3)))
   (assert (has-pointer-p pointer)
           (pointer)
           "No object to remove for pointer ~A." pointer)
-  (remhash (ptr-address pointer) *object-map*))
+  (remhash (pointer-address pointer) *object-map*))
 
 (defun report-finalize-error (condition function class pointer)
   "Report the error CONDITION it the finalizer FUNCTION for the
 object at POINTER of class CLASS."
   (warn "error calling finalizer ~A for ~A ~A:~%~5T~A~%"
-        function class pointer condition))
+        function class pointer condition)
+  #+sbcl (sb-debug:backtrace 10))
 
 (defgeneric make-finalize (object)
   (:documentation "Returns a function to be called when OBJECT is finalized."))
@@ -86,6 +79,7 @@
   (let ((pointer (pointer object))
         (class (class-of object)))
     #'(lambda ()
+        (declare (optimize (speed 3)))
         (handler-case (delete-pointer pointer class)
           (error (condition)
             (report-finalize-error condition 't (name class) pointer))))))
diff -rN -u old-smoke/src/objects/class.lisp new-smoke/src/objects/class.lisp
--- old-smoke/src/objects/class.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/objects/class.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,56 +1,78 @@
 (in-package #:smoke)
 
-;;;
-;;; find-class
-;;; ensure-class
-;;; make-instance
-;;; class-name
-;;; class-slots
-;;; class-direct-subclasses
-;;; class-direct-superclasses
-;;; class-of
-;;; subclassp / subtypep
+(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"))
 
+(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))
 
-(defclass smoke-class (smoke-symbol)
-  ()
-  (:documentation "A class"))
+(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 class-slot-value))
 (defun class-slot-value (class slot-name)
-  (foreign-slot-value (smoke-get-class (smoke class) (id class))
+  (foreign-slot-value (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)
+                           'smoke-class ,slot-name)
+      form))
+
 (defmethod name ((class smoke-class))
   (class-slot-value class 'name))
 
 (defun map-classes (function smoke)
   "Applys FUNCTION to the classes of SMOKE."
   (declare (function function)
-           (foreign-pointer smoke)
            (optimize (speed 3)))
   (let ((class (make-instance 'smoke-class
-                              :id 0
                               :smoke smoke)))
-    (loop for id from 1 to (1- (the fixnum (smoke-classes-size smoke))) do
-         (setf (slot-value class 'id) id)
+    (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))
          (funcall function class))))
 
 (defun external-p (class)
   "Returns T when CLASS is external in its module; NIL otherwise."
+  (declare (optimize (speed 3)))
   (class-slot-value class 'external))
 
-(defmethod get-flag ((class smoke-class) flag)
-  (boole boole-and (class-slot-value class 'flags)
-         (foreign-enum-value 'smoke-class-flags flag)))
+(defun get-class-flag (class flag)
+  (declare (optimize (speed 3)))
+  (logand (class-slot-value class 'flags)
+          (the fixnum (foreign-enum-value 'smoke-class-flags flag))))
 
 (defmethod constructor-p ((class smoke-class))
   "Returns T when CLASS has a constructor; NIL otherwise."
-  (/= 0 (get-flag class :constructor)))
+  (/= 0 (get-class-flag class :constructor)))
 
 (defun virtual-destructor-p (class)
   "Returns T when CLASS has a virtual destructor and NIL otherwise."
-  (/= 0 (get-flag class :virtual-destructor)))
+  (/= 0 (get-class-flag class :virtual-destructor)))
 
 (define-condition undefined-class (cell-error)
   ((smoke-name :initarg :smoke-name
@@ -68,18 +90,20 @@
 Signals an undefined-class condition when there is no class for NAME."
   (with-foreign-object (c 'smoke-module-index)
     (do () (nil)
-      (smoke-find-class c smoke name)
+      (smoke-find-class c (smoke-module-pointer smoke) name)
       (restart-case
           (if (null-pointer-p (foreign-slot-value c 'smoke-module-index 'smoke))
-              (error (make-condition 'undefined-class :name name :smoke-name (smoke-get-module-name smoke)))
+              (error (make-condition 'undefined-class :name name :smoke-name (smoke-get-module-name (smoke-module-pointer smoke))))
               (return))
         (supply (new-name)
           :report "Supply a new class name"
           :interactive read-new-value
           (setf name new-name))))
     (make-instance 'smoke-class
-                   :id (foreign-slot-value c 'smoke-module-index 'index)
-                   :smoke (foreign-slot-value c 'smoke-module-index 'smoke))))
+                   :pointer (smoke-get-class 
+                             (foreign-slot-value c 'smoke-module-index 'smoke)
+                             (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)
   "Returns the same class like CLASS, but such that EXTERNAL-P returns NIL."
@@ -101,21 +125,25 @@
    T))
 
 (defun derived-real-p (class base-class)
-  (smoke-is-derived-from (smoke class) (id class)
-                         (smoke base-class) (id base-class)))
+  (smoke-is-derived-from (smoke-module-pointer (smoke class)) (id class)
+                         (smoke-module-pointer (smoke base-class)) (id base-class)))
   
 
 (defun smoke-class-direct-superclasses (class)
   (smoke-add-superclass class nil (class-slot-value class 'parents)))
 
 (defun smoke-add-superclass (class classes index)
-  (let ((class-index (smoke-get-parent-index (smoke class) index)))
-    (assert (< class-index (smoke-classes-size (smoke class))))
+  (let ((class-index (mem-aref (smoke-module-inheritance-list 
+                                (smoke class))
+                               'smoke-index
+                               index)))
+    (assert (<= class-index
+                (smoke-array-length
+                 (smoke-module-classes (smoke class)))))
     (if (= 0 class-index)
         classes
         (smoke-add-superclass class (append classes
                                             (list
-                                            (make-instance 'smoke-class
-                                                           :id class-index
-                                                           :smoke (smoke class))))
+                                             (make-smoke-class-from-id (smoke class)
+                                                                       class-index)))
                               (1+ index)))))
diff -rN -u old-smoke/src/objects/method.lisp new-smoke/src/objects/method.lisp
--- old-smoke/src/objects/method.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/objects/method.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,15 +1,32 @@
 (in-package #:smoke)
 
-(defclass smoke-method (smoke-symbol)
-  ()
-  (:documentation "A C++ method"))
+(declaim (inline make-smoke-method))
+(defstruct smoke-method
+  (id 0 :type smoke-index)
+  (smoke (make-smoke-module) :type smoke-module))
+
+(declaim (inline smoke-method-pointer))
+(defun smoke-method-pointer (method)
+  (declare (optimize (speed 3)))
+  (mem-aref (smoke-array-pointer (smoke-module-methods
+                                  (smoke-method-smoke method)))
+            'smoke-method
+            (smoke-method-id method)))
 
 (defmethod print-object ((smoke-method smoke-method) stream)
-  (if (null-pointer-p (smoke smoke-method))
+  (if (or (null-pointer-p (smoke-module-pointer (smoke-method-smoke smoke-method)))
+          (null-pointer-p (smoke-method-pointer smoke-method)))
       (call-next-method)
       (print-unreadable-object (smoke-method stream :type t)
         (princ (method-declaration smoke-method) stream))))
 
+(defmethod smoke ((method smoke-method))
+  (smoke-module-pointer (smoke-method-smoke method)))
+
+(defmethod id ((method smoke-method))
+  (declare (optimize (speed 3)))
+  (smoke-method-id method))
+
 (define-condition undefined-method (undefined-function)
   ((class-name :initarg :class-name
                :initform nil))
@@ -19,42 +36,25 @@
                      (slot-value condition 'class-name)))) 
   (:documentation "A undefined Smoke method"))
   
-(defun valid-p (method)
-  "Returns T when METHOD is valid and NIL otherwise."
-  (/= 0 (id method)))
-
-(defun unambigous-p (method)
-  "Returns T when METHOD is valid and not ambiguous."
-  (< 0 (id method)))
-
-(defun ambiguous-p (method)
-  "Returns T when METHOD is ambiguous and NIL otherwise."
-  (> 0 (id method)))
-
-(defun make-smoke-method-munged (class munged-name-id)
-  "Returns the method for the MUNGED-NAME-ID of SMOKE."
-  (with-foreign-object (module 'smoke-module-index)
-    (smoke-find-method-for-id module (smoke class) (id class) munged-name-id)
-    (make-instance 'smoke-method
-                   :id (foreign-slot-value module 'smoke-module-index 'index)
-                   :smoke (foreign-slot-value module 'smoke-module-index 'smoke))))
-
 (defun find-smoke-method (class name)
   "Returns the method NAME of CLASS."
   (with-foreign-object (m 'smoke-module-index)
-    (smoke-find-method m (smoke class) (id class) name)
-    (make-instance 'smoke-method
-                   :id (foreign-slot-value m 'smoke-module-index 'index)
-                   :smoke (foreign-slot-value m 'smoke-module-index 'smoke))))
+    (smoke-find-method m (smoke-module-pointer (smoke class)) (id class) name)
+    (let ((smoke (foreign-slot-value m 'smoke-module-index 'smoke)))
+      (make-smoke-method
+       :smoke (if (null-pointer-p smoke)
+                  (make-smoke-module)
+                  (gethash (pointer-address smoke) *smoke-modules*))
+       :id (foreign-slot-value m 'smoke-module-index 'index)))))
 
 ;smoke-find-method
-(defun make-smoke-method (class name)
+(defun make-smoke-method-from-name (class name)
   "Returns the method NAME of CLASS.
 Signals a undefined-method condition when no method was found.
 Signals an error when the method is ambigious."
   (with-foreign-object (m 'smoke-module-index)
     (do () (nil)
-      (smoke-find-method m (smoke class) (id class) name)
+      (smoke-find-method m (smoke-module-pointer (smoke class)) (id class) name)
       (restart-case
           (if  (null-pointer-p (foreign-slot-value m 'smoke-module-index 'smoke))
                (error (make-condition 'undefined-method :name name :class-name (name class)))
@@ -64,29 +64,29 @@
           :interactive read-new-value
           (setf name new-name))))
     (when (> 0 (foreign-slot-value m 'smoke-module-index 'index))
-      (loop as i = (smoke-ambiguous-method (smoke class)
-                                           (- (foreign-slot-value m 'smoke-module-index 'index)))
-           while (> i 0)
+      (loop as i = (mem-aref (smoke-module-ambiguous-method-list (smoke class))
+                             'smoke-index
+                             (- (foreign-slot-value m 'smoke-module-index 'index)))
+         while (> i 0)
          do (decf (foreign-slot-value m 'smoke-module-index 'index))
-           (let ((m (make-instance 'smoke-method :id i :smoke (smoke class))))
-              (format t " ~A ~A~%" (name m) (signature m))))
-      (error "The method ~S of ~S is ambigious" name (name class)));;TODO
-    (make-instance 'smoke-method
-                   :id (foreign-slot-value m 'smoke-module-index 'index)
-                   :smoke (foreign-slot-value m 'smoke-module-index 'smoke))))
+         (let ((m (make-smoke-method :smoke (smoke class) :id i)))
+           (format t " ~A ~A~%" (name m) (signature m))))
+      (error "The method ~S of ~S is ambigious" name (name class))) ;;TODO
+    (make-smoke-method
+     :smoke (gethash (pointer-address
+                      (foreign-slot-value m 'smoke-module-index 'smoke))
+                     *smoke-modules*)
+     :id (foreign-slot-value m 'smoke-module-index 'index))))
 
 (defun map-methods (function smoke)
   "Applys FUNCTION to the methods of SMOKE.
 The method argument to function must not be modified."
   (declare (function function)
-           (cffi:foreign-pointer smoke)
            (optimize (speed 3)))
-  (let ((method (make-instance 'smoke-method
-                               :id 0
-                               :smoke smoke))
-        (length (1- (the fixnum (smoke-methods-size smoke)))))
+  (let ((method (make-smoke-method :smoke smoke :id 0))
+        (length (smoke-array-length (smoke-module-methods smoke))))
     (loop for id from 1 to length do
-         (setf (slot-value method 'id) id)
+         (setf (smoke-method-id method) id)
          (funcall function method))))
 
 (declaim (inline method-slot-value))
@@ -94,12 +94,25 @@
   (declare (smoke-method method)
            (symbol slot-name)
            (optimize (speed 3)))
-  (foreign-slot-value (smoke-get-method (smoke method) (id method))
+  (foreign-slot-value (smoke-method-pointer method)
                       'smoke-method slot-name))
 
+(define-compiler-macro method-slot-value (&whole form method slot-name)
+  "Optimize constant slot-names."
+  ;; declaring the function inline calls the compiler macro of
+  ;; foreign-slot-value with 'SLOT-NAME instead of its value an thus
+  ;; has no effect; thus the compiler macro.
+  (if (constantp slot-name)
+      `(foreign-slot-value (smoke-method-pointer ,method)
+                           'smoke-method ,slot-name)
+      form))
+  
+
 (defmethod name ((method smoke-method))
-  (smoke-get-method-name (smoke method)
-                         (method-slot-value method 'name)))
+  (mem-aref (smoke-array-pointer (smoke-module-method-names
+                                  (smoke-method-smoke method)))
+            :string
+            (method-slot-value method 'name)))
 
 (defun signature (method)
   "Returns the signature of METHOD."
@@ -122,7 +135,7 @@
   "Returns the return type of METHOD."
   (make-instance 'smoke-type
                  :id (method-slot-value method 'return-type)
-                 :smoke (smoke method)))
+                 :smoke (smoke-method-smoke method)))
 
 (defun method-declaration (method)
   (format nil "~A~:[ void~; ~1:*~A~] ~A::~A"
@@ -131,61 +144,75 @@
           (name (get-class method))
           (signature method)))
 
-(defmethod get-flag ((method smoke-method) flag)
+(defun get-method-flag (method flag)
   (logand (method-slot-value method 'flags)
           (foreign-enum-value 'smoke-method-flags flag)))
 
+(define-compiler-macro get-method-flag (&whole form method flag)
+  (if (constantp flag)
+      `(logand (method-slot-value ,method 'flags)
+               ;; Resolve flag value at compile time
+               ,(foreign-enum-value 'smoke-method-flags flag))   
+      form))
+
 (defgeneric constructor-p (object)
   (:documentation "Returns T when OBJECT is a constructor."))
 
 (defmethod constructor-p ((method smoke-method))
-  (/= 0 (get-flag method :constructor)))
+  (/= 0 (get-method-flag method :constructor)))
 
 (defun destructor-p (method)
   "Returns T when METHOD is a destructor; NIL otherwise."
-  (/= 0 (get-flag method :destructor)))
+  (/= 0 (get-method-flag method :destructor)))
 
 (defun static-p (method)
   "Retruns T when METHOD is static and NIL otherwise."
-  (/= 0 (get-flag method :static)))
+  (/= 0 (get-method-flag method :static)))
 
 (defun protected-p (method)
   "Returns T when METHOD is protected; NIL otherwise."
-  (/= 0 (get-flag method :protected)))
+  (/= 0 (get-method-flag method :protected)))
 
 (defmethod const-p ((method smoke-method))
   "Returns T when METHOD is a const method and NIL otherwise."
-  (/= 0 (get-flag method :const)))
+  (/= 0 (get-method-flag method :const)))
+
+(defun valid-p (method)
+  "Returns T when METHOD is valid and NIL otherwise."
+  (/= 0 (smoke-method-id method)))
 
 (defun ambigious-p (method)
   "Returns T when METHOD is ambigious and NIL otherwise."
-  (< 0 (id method)))
+  (< 0 (smoke-method-id method)))
 
 (defun enum-p (method)
   "Returns T when METHOD is enum value and NIL otherwise."
-  (/= 0 (get-flag method :enum)))
+  (/= 0 (get-method-flag method :enum)))
 
 (defun internal-p (method)
   "Returns T when METHOD is internal and NIL otherwise."
-  (/= 0 (get-flag method :internal)))
+  (/= 0 (get-method-flag method :internal)))
 
 (defmethod get-class ((method smoke-method))
-  (make-instance 'smoke-class
-                 :id (method-slot-value method 'class)
-                 :smoke (smoke method)))
-
-  
+  (make-smoke-class-from-id
+   (smoke-method-smoke method)
+   (method-slot-value method 'class)))
 
 (defclass smoke-argument (smoke-type)
   ()
   (:documentation "A argument to a method"))
 
 (defmethod id ((argument smoke-argument))
-  (smoke-get-argument (smoke argument) (slot-value argument 'id)))
+  (declare (optimize (speed 3)))
+  (mem-aref (smoke-module-argument-list (smoke argument))
+            'smoke-index
+            (call-next-method)))
 
 (defun last-p (argument)
   "Returns T when ARGUMENT is the last argument and NIL otherwise."
-  (= 0 (smoke-get-argument (smoke argument) (1+ (slot-value argument 'id)))))
+  (= 0 (mem-aref (smoke-module-argument-list (smoke argument))
+                 'smoke-index
+                 (1+ (slot-value argument 'id)))))
 
 (defun end-p (argument)
   "Returns T when ARGUMENT is the after last element and NIL otherwise."
@@ -206,15 +233,16 @@
     
 (defun get-first-argument (method)
   "Returns the first argument of METHOD"
+  (declare (optimize (speed 3)))
   (make-instance 'smoke-argument
                  :id (method-slot-value method 'arguments)
-                 :smoke (smoke method)))
+                 :smoke (smoke-method-smoke method)))
 
 (defun get-argument (method index)
   "Returns the type of METHODs argument with number INDEX."
   (make-instance 'smoke-argument
                  :id (+ (method-slot-value method 'arguments) index)
-                 :smoke (smoke method)))
+                 :smoke (smoke-method-smoke method)))
 
 
 (defun build-argument-list (list argument)
diff -rN -u old-smoke/src/objects/object.lisp new-smoke/src/objects/object.lisp
--- old-smoke/src/objects/object.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/objects/object.lisp	2014-10-01 19:32:19.000000000 +0200
@@ -1,23 +1,3 @@
 (in-package #:smoke)
-
-(defclass smoke-symbol ()
-  ((id :reader id :initarg :id
-       :type smoke-index
-       :documentation "The objects index.")
-   (smoke :reader smoke :initarg :smoke
-          :initform (null-pointer)
-          :documentation "Pointer to the Smoke module."))
-  (:documentation "A method or class in a Smoke module."))
-
-(defmethod print-object ((smoke-symbol smoke-symbol) stream)
-  (if (null-pointer-p (smoke smoke-symbol))
-      (call-next-method)
-      (print-unreadable-object (smoke-symbol stream :type t)
-        (princ (name smoke-symbol) stream))))
-
-(defgeneric name (smoke-symbol)
-  (:documentation "Returns the name of SMOKE-SYMBOL."))
-
-(defgeneric get-struct-slot-value (smoke-symbol slot-name)
-  (:documentation "Returns the slot value of SLOT-NAME of
-the SMOKE-SYMBOLs struct."))
+ 
+(declaim (inline id))
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/objects/stack.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -20,6 +20,7 @@
    (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))))
@@ -27,7 +28,16 @@
 (defun push-stack (stack value type)
   (setf (foreign-slot-value (top stack)
                             'smoke-stack-item type) value)
-  (incf-pointer (top stack) (foreign-type-size 'smoke-stack-item)))
+  (incf-pointer (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)
+                                   'smoke-stack-item ,type) ,value)
+         (incf-pointer (top ,stack) ,(foreign-type-size 'smoke-stack-item)))
+      form))
+      
 
 (defclass smoke-standard-object ()
   ((pointer :reader pointer
@@ -43,6 +53,9 @@
   (:documentation "The standard superclass for Smoke classes."))
   
 (defun push-smoke-stack (stack value type-id)
+  (declare (type (smoke-index 0) type-id)
+           (type call-stack stack)
+           (optimize (speed 3)))
   (ecase type-id
     (0 (push-stack stack value 'voidp))
     (1 (push-stack stack value 'bool))
@@ -87,6 +100,7 @@
 
 (defun enum-to-lisp (stack-item type)
   "Returns the Lisp representation for STACK-ITEM of the basic C type TYPE."
+  (declare (optimize (speed 3)))
   (ecase (type-id type)
     (0 (let ((cffi-type (get-type (name type))))
          (if (null cffi-type)
@@ -120,9 +134,11 @@
                        :type type))))
 
 (defgeneric instance-to-lisp (pointer class type)
+  (declare (optimize (speed 3)))
   (:documentation "Returns a clos instance for POINTER."))
 
 (defun object-to-lisp (object type)
+  (declare (optimize (speed 3)))
   (if (class-p type)
       (let ((class (get-class type)))
         (if (has-pointer-p object)
@@ -134,14 +150,14 @@
 
 (defun class-to-lisp (stack-item type)
   "Returns the Lisp representation for STACK-ITEM of type C++ class."
-  (let ((object (object-to-lisp (foreign-slot-value stack-item
-                                                    'smoke-stack-item
-                                                    'class)
-                                type)))
-    object))
+  (object-to-lisp (foreign-slot-value stack-item
+                                      'smoke-stack-item
+                                      'class)
+                  type))
 
 (defun type-to-lisp (stack-item type)
   "Returns the Lisp representation of STACK-ITEM"
+  (declare (optimize (speed 3)))
   (cond
     ((void-p type)
      (values))
diff -rN -u old-smoke/src/objects/type.lisp new-smoke/src/objects/type.lisp
--- old-smoke/src/objects/type.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/objects/type.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,33 +1,55 @@
 (in-package #:smoke)
 
-(defclass smoke-type (smoke-symbol)
-  ()
+(declaim (inline smoke))
+
+(defclass smoke-type ()
+  ((id :reader id :initarg :id
+       :type smoke-index
+       :documentation "The objects index.")
+   (smoke :reader smoke :initarg :smoke
+          :type smoke-module
+          :documentation "Pointer to the Smoke module."))
   (:documentation "A type"))
 
-(defclass smoke-lazy-type (smoke::smoke-type)
-  ((id :reader smoke::id
-       :initarg :id)
-   (smoke :initarg :smoke
-          :reader smoke-symbol)))
+(defmethod print-object ((type smoke-type) stream)
+  (if (or (<= (id type) 0)
+          (null-pointer-p (smoke-module-pointer (smoke type))))
+      (call-next-method)
+      (print-unreadable-object (type stream :type t)
+        (princ (name type) stream))))
 
-(defmethod smoke::smoke ((type smoke-lazy-type))
-  (eval (smoke-symbol type)))
+(defclass smoke-lazy-type (smoke-type)
+  ())
 
 (declaim (inline type-slot-value))
 (defun type-slot-value (type slot-name)
   (declare (smoke-type type)
            (symbol slot-name)
            (optimize (speed 3)))
-  (foreign-slot-value (smoke-get-type (smoke type) (id type))
+  (foreign-slot-value (mem-aref (smoke-array-pointer
+                                 (smoke-module-types (smoke type)))
+                                'smoke-type
+                                (the smoke-index (id type)))
                       'smoke-type slot-name))
 
+(define-compiler-macro type-slot-value (&whole form type slot-name)
+  (if (constantp slot-name)
+      `(foreign-slot-value (mem-aref (smoke-array-pointer
+                                      (smoke-module-types (smoke ,type)))
+                                     'smoke-type
+                                     (the smoke-index (id ,type)))
+                           'smoke-type ,slot-name)
+      form))
+  
+
 (defun make-smoke-type (smoke name)
   "Returns the type in the Smoke module SMOKE named NAME."
   (make-instance 'smoke-type
-                 :id (smoke-find-type smoke name)
+                 :id (smoke-find-type (smoke-module-pointer smoke) name)
                  :smoke smoke))
 
 (defmethod name ((type smoke-type))
+  (declare (optimize (speed 3)))
   (type-slot-value type 'name))
 
 (defun smoke-type= (type1 type2)
@@ -36,34 +58,44 @@
        (= (id type1)
           (id type2))))
 
-(defgeneric get-flag (object flag)
-  (:documentation "Returns the value for FLAG of OBJECT."))
-
-(defmethod get-flag ((type smoke-type) flag)
+(defun get-type-flag (type flag)
+  (declare (optimize (speed 3)))
   (logand (type-slot-value type 'flags)
-          #xF0 ;; = ! 0x0F
-          (foreign-enum-value 'smoke-type-flags flag)))
+          #xF0 ;; = !0x0F
+          (the fixnum (foreign-enum-value 'smoke-type-flags flag))))
 
-(defun get-allocation-flag (type)
-  (logand (type-slot-value type 'flags)
-          #x30))
+(define-compiler-macro get-type-flag (&whole form type flag)
+  (if (constantp flag)
+      `(logand (type-slot-value ,type 'flags)
+               #xF0
+               ,(foreign-enum-value 'smoke-type-flags flag))
+      form))
+      
+(defmacro allocation-flag-p (type flag)
+  ;; Can't just use #'get-type-flag since it
+  ;; can only be one of :stack, :reference and :pointer.
+  ;; (:stack + :pointer = :reference) <=> (#x10 + #x20 = #x30)
+  `(= ,(foreign-enum-value 'smoke-type-flags flag)
+      (logand #x30
+              (type-slot-value ,type 'flags))))
 
+(declaim (inline stack-p))
 (defun stack-p (type)
   "Returns T when TYPE is stored on the stack; NIL otherwise."
-  (= (get-allocation-flag type) (get-flag type :stack)))
+  (allocation-flag-p type :stack))
 
 (defun reference-p (type)
   "Returns T when TYPE is a reference ('type&'); NIL otherwise."
-  (= (get-allocation-flag type) (get-flag type :reference)))
+  (allocation-flag-p type :reference))
 
 (defun pointer-p (type)
   "Returns T when TYPE is a pointer ('type*'); NIL otherwise."
-  (= (get-allocation-flag type) (get-flag type :pointer)))
+  (allocation-flag-p type :pointer))
 
 (defgeneric const-p (object)
   (:method ((type smoke-type))
     "Returns T when TYPE is const; NIL otherwise."
-    (/= 0 (get-flag type :const))))
+    (/= 0 (get-type-flag type :const))))
 
 (defun class-p (type)
   "Returns T when TYPE is a smoke class"
@@ -72,8 +104,10 @@
 
 (defun type-id (type)
   "Returns the ID of TYPE."
-  (logand (type-slot-value type 'flags)
-          (foreign-enum-value 'smoke-type-flags :type-id)))
+  (declare (smoke-type type)
+           (optimize (speed 3) (safety 0)))
+  (logand (the (c-integer :unsigned-short) (type-slot-value type 'flags))
+          #.(foreign-enum-value 'smoke-type-flags :type-id)))
 
 (defun void-p (type)
   "Return T when TYPE is a void type (no value)."
@@ -81,7 +115,10 @@
   ;; For efficency 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)))
-  (= 0 (mem-ref (smoke-get-type (smoke type) (id type))
+  (= 0 (mem-ref (mem-aref (smoke-array-pointer
+                           (smoke-module-types (smoke type)))
+                          'smoke-type
+                          (id type))
                 :char)))
               
 
@@ -93,13 +130,6 @@
   (assert (/= -1 (type-slot-value type 'class))
           (type)
           "The type ~S is not a smoke class." (name type))
-  (make-instance 'smoke-class
-                 :id (type-slot-value type 'class)
-                 :smoke (smoke type)))
-
-
-;; FIXME why macro?
-(defmacro smoke-type-p (type smoke type-name)
-  (let ((t2 (smoke-find-type smoke type-name)))
-    `(and (= (id ,type) ,(id t2))
-          (pointer-eq (smoke ,type) ,(smoke t2)))))
+  (make-smoke-class-from-id
+                 (smoke type)
+                 (type-slot-value type 'class)))
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/overload-resolution.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -3,111 +3,188 @@
 
 (in-package :smoke)
 
-(defun mung-char-p (character)
-  "Returns true when CHARACTER is used for munging and false otherwise."
-  (declare (character character))
-  (case character
-    ((#\$ #\? #\#) t)))
-
-(defun binary-search-method-names (name smoke start end)
-  "Returns the index of NAME for the Smoke module SMOKE and 0 when
-NAME is not found."
-  ;; FIXME search methods instead of methodMaps, since we are not
-  ;;  interrested in the munging.
-  (declare ((smoke-index 1) start end)
-           (string name)
+(defun cstring= (string1 string2)
+  "Returns T when the C strings STRING1 and STRING2 are equal
+ and NIL otherwise."
+  (declare (optimize (speed 3) (safety 0)))
+  (dotimes (i array-total-size-limit)
+    (let ((char1 (mem-aref string1 :char i))
+          (char2 (mem-aref string2 :char i)))
+      (when (/= char1 char2)
+        (return-from cstring= nil))
+      (when (or (= 0 char1)
+                (= 0 char2))
+        (return-from cstring= (= char1 char2))))))
+
+(declaim (inline cmp))
+(defun cmp (a b)
+  "Returns -1 if a < b; 0 if a = b and 1 if a > b"
+  (declare (values (integer -1 1)))
+  (if (< a b)
+      -1
+      (if (> a b)
+          1
+          0)))
+
+(declaim (inline cstring-cmp))
+(defun cstring-cmp (string1 string2)
+  "Compares the C strings STRING1 and STRING2."
+  (declare (foreign-pointer string1 string2)
+           (values (integer -1 1))
            (optimize (speed 3)))
-  (if (> start end)
-      0
-      (let* ((index (floor (+ end start) 2))
-             (method-name (smoke-get-method-name smoke index))
-             (diff (string/= method-name name)))
-        (if diff
-            (if (and (>= diff (length name))
-                     (mung-char-p (char method-name diff)))
-                index
-                (if (and (< diff (length name))
-                         (or (>= diff (length method-name))
-                             (char< (char method-name diff) (char name diff))))
-                    (binary-search-method-names name smoke (1+ index) end)
-                    (binary-search-method-names name smoke start (1- index))))
-            index))))
-
-(defun method-name= (name munged)
-  "Returns true when the name of the munged method name MUNGED is NAME."
-  (let ((diff (string/= name munged)))
-    (not (and diff
-              (or (< diff (length name))
-                  (not (mung-char-p (char munged diff))))))))
-
-(defun munged-method-argument-count (munged-name)
-  "Returns the number of arguments the method MUNGED-NAME uses."
-  (- (1- (length munged-name))
-     (position-if-not #'mung-char-p munged-name :from-end t)))
-              
-(defun method-argument-count= (name munged-name argument-count)
-  (declare ((integer 1 #.call-arguments-limit) argument-count))
-  (and (= (length munged-name) (+ (length name) argument-count))
-       (mung-char-p (char munged-name (length name)))))
-
-(defun position-method-names (name argument-count smoke start end)
-  "Returns a list of the method indices with name NAME
-that accept ARGUMENT-COUNT arguments."
-  (declare (string name)
-           ((smoke-index 1) start end)
+  (dotimes (i array-total-size-limit (error "omg"))
+    (let ((char1 (mem-aref string1 :char i))
+          (char2 (mem-aref string2 :char i)))
+      (when (/= char1 char2)
+        (return-from cstring-cmp (if (< char1 char2) -1 1)))
+      (when (= 0 char1) ;; <=> (= 0 char2)
+        (return-from cstring-cmp 0)))))
+
+(defun cstring/= (string1 string2)
+  "Returns T when the C strings STRING1 and STRING2 are not equal
+ and NIL otherwise."
+  (declare (optimize (speed 3)))
+  (dotimes (i array-total-size-limit)
+    (let ((char1 (mem-aref string1 :char i))
+          (char2 (mem-aref string2 :char i)))
+      (when (/= char1 char2)
+        (return-from cstring/= i))
+      (when (= 0 char1)
+        (return-from cstring/= nil)))))
+
+(declaim (inline smoke-method-name))
+(defun smoke-method-name (method)
+  (mem-aref (smoke-array-pointer (smoke-module-method-names 
+                                  (smoke-method-smoke method)))
+            :pointer
+            (the (smoke-index 0)
+              (method-slot-value method 'name))))
+
+(defun method-cmp (method class-id name)
+  "Compares METHOD to the method with NAME of class CLASS-ID."
+  (declare (foreign-pointer name)
+           (type (smoke-index 0) class-id)
+           (smoke-method method)
+           (values (integer -1 1))
+           (optimize (speed 3) (debug 0) (safety 0)))
+  (let ((id-cmp (cmp (the (smoke-index 0) (method-slot-value method 'class))
+                     (the (smoke-index 0) class-id))))
+    (declare (type (integer -1 1) id-cmp)
+             (dynamic-extent id-cmp))
+    (if (/= 0 id-cmp)
+        id-cmp
+        (cstring-cmp (smoke-method-name method)
+                     name))))
+             
+(defun first-unabigious-index (smoke index)
+  (declare (type smoke-index index)
            (optimize (speed 3)))
-  (let ((positions (loop for i from start to end
-                      while (method-name= name (smoke-get-method-name smoke i))
-                      when (method-argument-count= name (smoke-get-method-name smoke i)
-                                                   argument-count)
-                      collect i)))
-    (loop for i from (1- start) downto 1
-       while (method-name= name (smoke-get-method-name smoke i))
-       do (when (method-argument-count= name (smoke-get-method-name smoke i)
-                                        argument-count)
-            (push i positions)))
-    positions))
-
-(defun smoke-modules (class)
-  "Returns a list of super classes of CLASS; one or every smoke module
-that can be reached by super classes of CLASS. The returned super classes
-are as specific as possible."
-  (let ((modules (list class)))
-    (dolist (super-class (closer-mop:class-direct-superclasses class) modules)
-      (when (and (typep super-class 'smoke-standard-class)
-                 (not (eql super-class (find-class 'smoke-standard-object))))
-        (dolist (c (smoke-modules super-class))
-          (setf modules (adjoin c modules :key #'smoke)))))))
-
+  (if (>= index 0)
+      index
+      (mem-aref (smoke-module-ambiguous-method-list smoke)
+                'smoke-index
+                (- index))))
+
+(defun find-method-for-class (name class)
+  "Returns the index of a method with name NAME for class CLASS."
+  (declare (type foreign-pointer name)
+           (type smoke-class class)
+           (optimize (speed 3)))
+  (let* ((start 1) ;; 0 is "no method"
+        (class-id (id class))
+        (smoke (smoke class))
+        (end (smoke-array-length (smoke-module-method-maps smoke))))
+    (declare (type (smoke-index 0) start end))
+    (loop until (> start end) do
+         (let* ((index (the smoke-index (floor (+ end start) 2)))
+                (method (make-smoke-method 
+                         :smoke smoke 
+                         :id (the (smoke-index 0)
+                               (first-unabigious-index
+                                smoke
+                                (foreign-slot-value
+                                 (mem-aref (smoke-array-pointer
+                                            (smoke-module-method-maps
+                                             smoke))
+                                           'smoke-method-map index)
+                                 'smoke-method-map
+                                 'method)))))
+                (cmp (the (integer -1 1) (method-cmp method class-id name))))
+           (declare (type (integer -1 1) cmp)
+                    (dynamic-extent method index cmp))
+           (ecase cmp
+             (-1 (setf start (1+ index)))
+             (0 (return-from find-method-for-class index))
+             (1 (setf end (1- index)))))))
+  -1)
+
+(defmacro push-candidate-method (index name argument-count class methods)
+  (with-gensyms (method-map method-index method ambig-index i smoke)
+    `(let* ((,smoke (smoke ,class))
+            (,method-map (mem-aref
+                          (smoke-array-pointer
+                           (smoke-module-method-maps ,smoke))
+                          'smoke-method-map
+                          ,index))
+            (,method-index (foreign-slot-value ,method-map 'smoke-method-map 'method))
+            (,method (make-smoke-method
+                      :smoke ,smoke
+                      :id (first-unabigious-index
+                           ,smoke
+                           ,method-index))))
+       (declare (type smoke-index ,method-index))
+       (if (cstring/= ,name
+                      (smoke-method-name ,method))
+           nil
+           (progn
+             (when (= (the smoke-index ,argument-count)
+                      (the smoke-index (get-arguments-length ,method)))
+               (if (< ,method-index 0)
+                   (let ((,ambig-index (- ,method-index)))
+                     (declare (type smoke-index ,ambig-index))
+                     (loop as ,i = (the smoke-index
+                                     (mem-aref (smoke-module-ambiguous-method-list
+                                                ,smoke)
+                                               'smoke-index
+                                               ,ambig-index))
+                        while (> (the smoke-index ,i) 0) do
+                        (incf ,ambig-index)
+                        (push (make-smoke-method :smoke ,smoke
+                                                 :id ,i)
+                              ,methods)))
+                   (push ,method ,methods))) 
+             t)))))
 
-(defun viable-functions (name argument-count class2)
+(defun all-smoke-superclasses (class)
+  "Returns a list of all superclasses of CLASS and CLASS itself."
+  (declare (optimize (speed 3)))
+  (let ((classes (list class)))
+    (dolist (class (closer-mop:class-direct-superclasses class) classes)
+      (when (typep class 'smoke-standard-class)
+        (setf classes (append (all-smoke-superclasses class) classes))))))
+    
+(defun viable-functions (name argument-count class)
   "Returns a list of methods named NAME that take ARGUMENT-COUNT methods."
   ;; 13.3.2
-  (let ((methods))
-    (dolist (class (smoke-modules class2))
-      (let ((index (binary-search-method-names
-                    name (smoke class) 1
-                    (smoke-method-name-size (smoke class)))))
-        (loop for i in (position-method-names name argument-count (smoke class)
-                                              index
-                                              (smoke-method-name-size 
-                                               (smoke class)))
-           do 
-           (let ((method (make-smoke-method-munged class i)))
-             (if (unambigous-p method)
-                 (push method methods)
-                 (when (ambiguous-p method)
-                   (let ((index (- (id method))))
-                     (loop as i = (smoke-ambiguous-method (smoke method)
-                                                          index)
-                        while (> i 0) do
-                        (incf index)
-                        (push (make-instance 'smoke-method
-                                             :smoke (smoke method)
-                                             :id i)
-                              methods)))))))))
-    methods))
-               
+  ;; FIXME make a lazy map-viable-functions to allow returning early,
+  ;; when an exact match is found.
+  (declare (optimize (speed 3)))
+  (with-foreign-string (name name)
+    (let ((methods)
+          (smoke (smoke class)))
+      (dolist (class (all-smoke-superclasses class))
+        (let ((start-index (find-method-for-class name class)))
+          (declare (type smoke-index start-index))
+          (loop for index from start-index downto 1
+             while (push-candidate-method index name argument-count class
+                                          methods))
+          (loop for index from (1+ start-index)
+             to (the smoke-index (smoke-array-length
+                                  (smoke-module-method-maps smoke)))
+             while (push-candidate-method index name argument-count class
+                                          methods))))
+      methods)))
+         
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defconstant +exact-match+ 0)
 (defconstant +promotion+ 1)
@@ -164,9 +241,12 @@
   ;; 13.3.3.2 Ranking implicit conversion sequences
   ;; 4
   (:method (conversion1 conversion2)
+    (declare (optimize (speed 3)))
     (or (null conversion2)
-        (< (rank conversion1) (rank conversion2))))
+        (< (the fixnum (rank conversion1))
+           (the fixnum (rank conversion2)))))
   (:method ((conversion1 pointer-conversion) (conversion2 pointer-conversion))
+    (declare (optimize (speed 3)))
     (if (eq (from conversion1) (from conversion2))
         ;; A->B < A->C <=> B subclass of C
         (subtypep (to conversion1) (to conversion2))
@@ -267,6 +347,7 @@
     (loop for method in viable-functions do
          (multiple-value-bind (rank method-conversions)
              (funcall get-sequence method objects)
+           ;; FIXME test for ambigious overload #'conversion=
            (when (and rank (conversion< rank best-rank))
              (setf best-rank rank)
              (setf best-method method)
@@ -275,20 +356,6 @@
                (return)))))
     (values best-method conversions)))
 
-(defmacro string-case ((keyform) &body clauses)
-  ;; FIXME this is horribly inefficient
-  `(cond ,@(mapcar #'(lambda (clause)
-                        `((string= ,keyform ,(first clause))
-                          ,@(rest clause)))
-                    clauses)))
-
-(defmacro smoke-type-case ((keyform class) &body clauses)
-  `(string-case ((name ,keyform))
-     ,@(mapcar (curry #'apply
-                                 #'(lambda (type-name lisp-type)
-                                     `(,type-name (typep-using-type ,class (quote ,lisp-type)))))
-               clauses)))
-
 (defvar *from-lisp-translations* (make-hash-table :test 'equal))
 
 (defmacro define-from-lisp-translation (type-names lisp-type
@@ -318,9 +385,8 @@
 (defun+using-type exact-match object  (object type)
   "Test for an exact match."
   (case (type-id type)
-    (0 
-     (when-let (test (gethash (name type) *from-lisp-translations*))
-                          (funcall test (object.type-of))))
+    (0 (when-let (test (gethash (name type) *from-lisp-translations*))
+         (funcall test (object.type-of))))
     (1 (object.typep 'boolean))
     (2 (object.typep 'standard-char))
     (3 (object.typep '(c-integer :unsigned-char)))
@@ -477,13 +543,16 @@
                                               (condition-arguments condition)))))
   
 (defun call-using-args (object-or-class name arguments)
+  "Calls the method NAME of OBJECT-OR-CLASS with ARGUMENTS."
   (declare (optimize (speed 3)))
   (if (null arguments)
       (let ((method (find-smoke-method (smoke-class-of object-or-class)
                                        name)))
-        (assert (valid-p method)
-                ()
-                "No applicable method ~A() for ~A." name object-or-class)
+        (unless (valid-p method)
+          (error (make-condition 'no-applicable-cxx-method
+                                 :method name
+                                 :class object-or-class
+                                 :arguments arguments)))
         (if (static-p method)
             (s-call method (null-pointer))
             (s-call method (cast object-or-class (get-class method)))))
diff -rN -u old-smoke/src/package.lisp new-smoke/src/package.lisp
--- old-smoke/src/package.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/package.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -19,7 +19,6 @@
            #:make-smoke-classes
            #:eval-startup
            
-           #:new-object
            #:delete-object
            #:smoke-call
            #:call
diff -rN -u old-smoke/src/smoke-c/cl_smoke.h new-smoke/src/smoke-c/cl_smoke.h
--- old-smoke/src/smoke-c/cl_smoke.h	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/cl_smoke.h	2014-10-01 19:32:20.000000000 +0200
@@ -13,11 +13,24 @@
   #endif
 #endif
 
-/** @brief Common Lisp smoke binding namespace. */
+/** @brief Common Lisp Smoke binding namespace. */
 namespace cl_smoke
 {
 class Binding;
 
+/** The arrays of the Smoke module */
+enum cl_smoke_module_array
+{
+    classes,
+    methods,
+    method_maps,
+    method_names,
+    types,
+    inheritance_list,
+    argument_list,
+    ambiguous_method_list
+};
+
 /** A Binding */
 typedef void* smoke_binding;
 
diff -rN -u old-smoke/src/smoke-c/class.lisp new-smoke/src/smoke-c/class.lisp
--- old-smoke/src/smoke-c/class.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/class.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -25,17 +25,10 @@
   (smoke :pointer)
   (name :string))
 
-(defcfun smoke-classes-size smoke-index
-  (smoke :pointer))
-
 (defcfun smoke-get-class (:pointer smoke-class)
   (smoke :pointer)
   (class smoke-index))
 
-(defcfun smoke-get-parent-index smoke-index
-  (smoke :pointer)
-  (class smoke-index))
-
 (defcfun smoke-is-derived-from :boolean
   (smoke :pointer)
   (class smoke-index)
diff -rN -u old-smoke/src/smoke-c/csmokebinding.cpp new-smoke/src/smoke-c/csmokebinding.cpp
--- old-smoke/src/smoke-c/csmokebinding.cpp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/csmokebinding.cpp	2014-10-01 19:32:20.000000000 +0200
@@ -13,9 +13,7 @@
 /** @typedef Binding::destructed
  * Callback when a Smoke object is destructed.
  *
- * @param binding Smoke binding of the object
- * @param class_id class id
- * @param object the object
+ * @param object pointer to the object
  */
 
 
@@ -29,7 +27,7 @@
  * @param abstract @c true when the method is abstract and @c false otherwise
  *
  * @return @c true when the method call was handled and @c false
- *when the default method shall be invoked.
+ *  when the default method shall be invoked.
  */
 
 /** Constructor.
@@ -50,9 +48,9 @@
 
 /** Invoked when a Smoke object is destructed. */
 void
-Binding::deleted(Smoke::Index classId, void *obj)
+Binding::deleted(Smoke::Index, void *object)
 {
-	destruct(this, classId, obj);
+	destruct(object);
 }
 
 /** Invoked when a Smoke method gets called. */
diff -rN -u old-smoke/src/smoke-c/csmokebinding.h new-smoke/src/smoke-c/csmokebinding.h
--- old-smoke/src/smoke-c/csmokebinding.h	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/csmokebinding.h	2014-10-01 19:32:20.000000000 +0200
@@ -9,8 +9,7 @@
 class Binding : public SmokeBinding
 {
 	public:
-		typedef void (*destructed)(Binding* binding, Smoke::Index class_id,
-				void* object);
+		typedef void (*destructed)(void* object);
 
 		typedef int (*dispatch_method)(Binding* binding, Smoke::Index method,
 				void* object, Smoke::Stack args, int abstract);
@@ -18,7 +17,7 @@
 		Binding(Smoke *smoke, destructed destruct, dispatch_method dispatch);
 
 		virtual void
-		deleted(Smoke::Index classId, void *obj);
+		deleted(Smoke::Index classId, void *object);
 
 		virtual bool
 		callMethod(Smoke::Index method, void* object,
diff -rN -u old-smoke/src/smoke-c/method.lisp new-smoke/src/smoke-c/method.lisp
--- old-smoke/src/smoke-c/method.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/method.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,7 +1,5 @@
 (in-package #:smoke)
 
-(declaim (optimize (debug 3)))
-
 (defcenum smoke-method-flags
   "Method flags"
   (:static #x01)
@@ -29,46 +27,9 @@
   (name smoke-index)
   (method smoke-index))
 
-(defcfun smoke-get-method-map (:pointer smoke-method-map)
-  (smoke :pointer)
-  (index smoke-index))
-
-(defcfun smoke-find-method-for-id :void
-  (m :pointer smoke-module-index)
-  (smoke :pointer)
-  (class-index smoke-index)
-  (method-name smoke-index))
-
+(declaim (inline smoke-find-method))
 (defcfun smoke-find-method :void
   (m :pointer smoke-module-index)
   (smoke :pointer)
   (class smoke-index)
   (method :string))
-
-(defcfun smoke-methods-size smoke-index
-  (smoke :pointer))
-
-(defcfun smoke-get-method (:pointer smoke-method)
-  (smoke :pointer)
-  (method smoke-index))
-
-(defcfun smoke-get-method-name :string
-  (smoke :pointer)
-  (method-index smoke-index))
-
-(defcfun smoke-method-name-size smoke-index
-  (smoke :pointer))
-
-(defcfun smoke-call-method :void
-  (smoke :pointer)
-  (method smoke-index)
-  (object :pointer)
-  (stack smoke-stack))
-
-(defcfun smoke-get-argument smoke-index
-  (smoke :pointer)
-  (argument smoke-index))
-
-(defcfun smoke-ambiguous-method smoke-index
-  (smoke :pointer)
-  (ambiguous smoke-index))
diff -rN -u old-smoke/src/smoke-c/smoke-c.cpp new-smoke/src/smoke-c/smoke-c.cpp
--- old-smoke/src/smoke-c/smoke-c.cpp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/smoke-c.cpp	2014-10-01 19:32:20.000000000 +0200
@@ -7,15 +7,6 @@
 
 /** @file 
  * @brief C wrapper the Smoke bindings.
- *
- * @example examples/kde-hello-world.cpp
- * This KDE example creates a KXmlGuiWindow.
- * Note that C++ is only used to make the example shorter
- * (by allowing to directly include smoke-c.cpp), but it could also
- * be implemented in C using \c dlsym.
- *
- * @image html doc/images/kde-hello-world.png "Screenshot"
- * @image latex doc/images/kde-hello-world.png "Screenshot" width=5cm
  */
 
 using namespace cl_smoke;
@@ -72,6 +63,68 @@
 	return get_smoke(smoke)->moduleName();
 }
 
+
+/** Returns the pointer to the array @a array of @a smoke.
+ * @param smoke the Smoke module
+ * @param array the array type
+ * 
+ * @return a pointer to the array
+ */
+CL_SMOKE_EXPORT void*
+cl_smoke_array(void* smoke, cl_smoke_module_array array)
+{
+	switch (array)
+	{
+		case classes:
+			return get_smoke(smoke)->classes;
+		case methods:
+			return get_smoke(smoke)->methods;
+		case method_maps:
+			return get_smoke(smoke)->methodMaps;
+		case method_names:
+			return get_smoke(smoke)->methodNames;
+		case types:
+			return get_smoke(smoke)->types;
+		case inheritance_list:
+			return get_smoke(smoke)->inheritanceList;
+		case argument_list:
+			return get_smoke(smoke)->argumentList;
+		case ambiguous_method_list:
+			return get_smoke(smoke)->ambiguousMethodList;
+	}
+	qFatal("cl_smoke_array(): Unknown smoke_array %d", array);
+}
+
+/** Returns the size of the array @a array of @a smoke.
+ * The size if inclusive the bound.
+ * @param smoke the Smoke module
+ * @param array the array type
+ *
+ * @return the size
+ */
+CL_SMOKE_EXPORT Smoke::Index
+cl_smoke_array_size(void* smoke, cl_smoke_module_array array)
+{
+	switch (array)
+	{
+		case classes:
+			return get_smoke(smoke)->numClasses;
+		case methods:
+			return get_smoke(smoke)->numMethods;
+		case method_maps:
+			return get_smoke(smoke)->numMethodMaps;
+		case method_names:
+			return get_smoke(smoke)->numMethodNames;
+		case types:
+			return get_smoke(smoke)->numTypes;
+		case inheritance_list:
+		case argument_list:
+		case ambiguous_method_list:
+			qFatal("cl_smoke_array_size(): size of %d not known.", array);
+	}
+	qFatal("cl_smoke_array_size(): Unknown smoke_array %d.", array);
+}
+
 ///////////////////////////
 /// Class
 ///////////////////////////
@@ -102,39 +155,6 @@
 	return m.index;
 }
 
-
-
-/** Gets the number of classes.
- *
- * @return the number of classes
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_classes_size(void* smoke)
-{
-	return get_smoke(smoke)->numClasses;
-}
-
-/** Sets the binding for an newly constructed instance.
- * @param smoke the Smoke module
- * @param binding the Smoke binding
- * @param class_index the index of the instances class
- * @param object pointer to the class instance.
- */
-CL_SMOKE_EXPORT void
-smoke_set_binding(void* smoke, smoke_binding binding, Smoke::Index class_index, void* object)
-{
-	Q_ASSERT(object != NULL);
-	Q_ASSERT(binding != NULL);
-	Q_ASSERT(class_index > 0 && class_index <= smoke_classes_size(smoke));
-
-	const Smoke::Class* klass = &get_smoke(smoke)->classes[class_index];	
-
-	Smoke::StackItem stack[2];
-        stack[1].s_voidp = get_smoke_binding(binding);
-
-	(*klass->classFn)(0, object, stack);
-}
-
 /** Gets a class
  * @param smoke the smoke binding
  * @param class_index the index of the class
@@ -144,7 +164,7 @@
 CL_SMOKE_EXPORT const struct Smoke::Class*
 smoke_get_class(void* smoke, Smoke::Index class_index)
 {
-	Q_ASSERT(class_index >= 0 && class_index <= smoke_classes_size(smoke));
+	Q_ASSERT(class_index >= 0 && class_index <= get_smoke(smoke)->numClasses);
 	return &get_smoke(smoke)->classes[class_index];
 }
 
@@ -166,88 +186,10 @@
 		get_smoke(smoke_base), base_index);
 }
 
-/** Returns the index of a base class.
- * @param smoke the Smoke module
- * @param class_index the class index
- * 
- * @return the index of a parent
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_get_parent_index(void* smoke, Smoke::Index class_index)
-{
-	Q_ASSERT(class_index >= 0);
-
-	return get_smoke(smoke)->inheritanceList[class_index];
-}
-
 //////////////////////////////
 /// Method
 //////////////////////////////
 
-/** Gets the method map.
- * @param smoke the Smoke module
- * @param method the index of the method
- *
- * @return a pointer to the @c MethodMap entry.
- */
-CL_SMOKE_EXPORT const Smoke::MethodMap*
-smoke_get_method_map(void* smoke, Smoke::Index method)
-{
-	Q_ASSERT(method >= 0 && method <= get_smoke(smoke)->numMethodMaps);
-
-	return &get_smoke(smoke)->methodMaps[method];
-}
-
-/** Gets a methods name.
- * @param smoke the Smoke module
- * @param method_name the method name index
- *
- * @return the method name
- */
-CL_SMOKE_EXPORT const char*
-smoke_get_method_name(void* smoke, Smoke::Index method_name)
-{
-	Q_ASSERT(method_name >= 0 && method_name <= get_smoke(smoke)->numMethodNames);
-
-	return get_smoke(smoke)->methodNames[method_name];
-}
-
-/** Gets the number of method names.
- * @param smoke the Smoke module
- *
- * @return the number of method names
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_method_name_size(void *smoke)
-{
-	return get_smoke(smoke)->numMethodNames;
-}
-
-/** Gets the number of methods.
- * @param smoke the Smoke module
- *
- * @return the number of methods
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_methods_size(void* smoke)
-{
-	return get_smoke(smoke)->numMethods;
-}
-
-/** Gets a method.
- * @param smoke the smoke binding
- * @param method the index of the method
- *
- * @return a pointer to the method struct
- */
-CL_SMOKE_EXPORT const struct Smoke::Method*
-smoke_get_method(void* smoke, Smoke::Index method)
-{
-	Q_ASSERT(method >= 0 && method <= smoke_methods_size(smoke));
-
-	return &get_smoke(smoke)->methods[method];
-}
-
 /** Finds a method of a class.
  * @param m pointer to write the result to
  * @param smoke the smoke binding
@@ -261,110 +203,13 @@
 	*m = get_smoke(smoke)->findMethod(get_smoke(smoke)->className(class_index),
 			method_name);
 	if(m->index > 0)
-		m->index = smoke_get_method_map(m->smoke, m->index)->method;
-}
-
-/** Finds a method for a class and a munged name.
- * @param m pointer where the result is stored.
- * @param smoke the Smoke binding
- * @param class_index index of the class
- * @param method_name index of the munged method name
- */
-CL_SMOKE_EXPORT void
-smoke_find_method_for_id(Smoke::ModuleIndex* m, void* smoke,
-		Smoke::Index class_index, Smoke::Index method_name)
-{
-	*m = get_smoke(smoke)->findMethod((Smoke::ModuleIndex){get_smoke(smoke), class_index},
-			(Smoke::ModuleIndex){get_smoke(smoke), method_name});
-
-	if(m->index > 0)
-		m->index = smoke_get_method_map(m->smoke, m->index)->method;
-}
-
-/** Gets the type index of an argument.
- * @param smoke the smoke binding
- * @param argument the argument index
- *
- * @return the type index
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_get_argument(void* smoke, Smoke::Index argument)
-{
-	Q_ASSERT(argument >= 0);
-
-	return get_smoke(smoke)->argumentList[argument];
-}
-
-/** Calls a method.
- * The methods return value is stored in the first element of the stack.
- * @param smoke the smoke binding
- * @param method the index of the method
- * @param object A pointer to the class instance, or NULL for static and constructor calls
- * @param stack The stack with the methods arguments.
- */
-CL_SMOKE_EXPORT void
-smoke_call_method(void* smoke, Smoke::Index method, void* object,
-	Smoke::Stack stack)
-{
- 	Smoke::Method meth = *smoke_get_method(smoke, method);
-	Q_ASSERT(!(meth.flags & Smoke::mf_internal));
-	Q_ASSERT_X((NULL == object
-				&& (meth.flags & (Smoke::mf_static
-						| Smoke::mf_enum
-						| Smoke::mf_copyctor
-						| Smoke::mf_ctor)))
-			|| object,
-			__func__, "object is NULL");
-	Q_ASSERT(meth.flags & Smoke::mf_ctor ?  NULL == object : true);
- 	const Smoke::Class* klass = smoke_get_class(smoke, meth.classId);
-
-	try
-	{
-		Q_ASSERT(klass->classFn != NULL);
-		(*klass->classFn)(meth.method, object, stack);
-	} 
-	// This catch is mostly useless:
-	// Qt / KDElibs do not use exceptions and since they are often built with -fno-exceptions
-	// the catch will have no effect and the terminate handler is called instead.
-	catch (const std::exception& e) 
-	{
-		qFatal(e.what());
-	}
-	catch (...)
-	{
-		qFatal("exception in C++ code.");
-	}
+		m->index = m->smoke->methodMaps[m->index].method;
 }
 
 ///////////////////////////
 /// Type
 //////////////////////////
 
-/** Gets the number of types.
- * @param smoke the Smoke module
- *
- * @return the number of types
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_types_size(void* smoke)
-{
-	return get_smoke(smoke)->numTypes;
-}
-
-/** Gets a type.
- * @param smoke the Smoke module
- * @param type the index of the type
- *
- * @return a pointer to the type struct
- */
-CL_SMOKE_EXPORT const struct Smoke::Type*
-smoke_get_type(void* smoke, Smoke::Index type)
-{
-	Q_ASSERT(type >= 0 && type <= smoke_types_size(smoke));
-
-	return &get_smoke(smoke)->types[type];
-}
-
 /** Gets the index of a type.
  * @param smoke the Smoke module
  * @param name the types name
@@ -388,24 +233,10 @@
 CL_SMOKE_EXPORT void*
 smoke_cast(void* smoke, void* object, Smoke::Index from, Smoke::Index to)
 {
-	Q_ASSERT(from > 0 && from <= smoke_classes_size(smoke));
-	Q_ASSERT(to > 0 && to <= smoke_classes_size(smoke));
+	Q_ASSERT(from > 0 && from <= get_smoke(smoke)->numClasses);
+	Q_ASSERT(to > 0 && to <= get_smoke(smoke)->numClasses);
 
 	return get_smoke(smoke)->cast(object, from, to);
 }
 
-/** Gets an ambiguous method.
- * @param smoke the Smoke module
- * @param ambiguous the index
- *
- * @return the index of a method
- */
-CL_SMOKE_EXPORT Smoke::Index
-smoke_ambiguous_method(void* smoke, Smoke::Index ambiguous)
-{
-	Q_ASSERT(ambiguous >= 0);
-
-	return get_smoke(smoke)->ambiguousMethodList[ambiguous];
-}
-
 } // extern "C"
diff -rN -u old-smoke/src/smoke-c/smoke-c.lisp new-smoke/src/smoke-c/smoke-c.lisp
--- old-smoke/src/smoke-c/smoke-c.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/smoke-c.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -57,15 +57,27 @@
   (smoke :pointer)
   (index smoke-index))
 
-(defcfun smoke-set-binding :void
-  "Sets the binding for an newly constructed instance."
-  (smoke :pointer)
-  (smoke-binding smoke-binding)
-  (class smoke-index)
-  (object :pointer))
-
+(declaim (inline smoke-get-smoke))
 (defcfun smoke-get-smoke :pointer
   (smoke-binding smoke-binding))
 
 (defcfun smoke-get-module-name :string
   (smoke :pointer))
+
+(defcenum cl-smoke-array
+  :classes
+  :methods
+  :method-maps
+  :method-names
+  :types
+  :inheritance-list
+  :argument-list
+  :ambiguous-method-list)
+
+(defcfun cl-smoke-array :pointer
+  (smoke :pointer)
+  (array cl-smoke-array))
+
+(defcfun cl-smoke-array-size smoke-index
+  (smoke :pointer)
+  (array cl-smoke-array))
diff -rN -u old-smoke/src/smoke-c/type.lisp new-smoke/src/smoke-c/type.lisp
--- old-smoke/src/smoke-c/type.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke-c/type.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -11,7 +11,6 @@
   (:const #x40))
 
 (defcstruct smoke-type
-  "A type"
   (name :string)
   (class smoke-index)
   (flags :unsigned-short))
@@ -19,10 +18,3 @@
 (defcfun smoke-find-type smoke-index
   (smoke :pointer)
   (name :string))
-
-(defcfun smoke-types-size smoke-index
-  (smoke :pointer))
-
-(defcfun smoke-get-type (:pointer smoke-type)
-  (smoke :pointer)
-  (type smoke-index))
diff -rN -u old-smoke/src/smoke.lisp new-smoke/src/smoke.lisp
--- old-smoke/src/smoke.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/smoke.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -27,28 +27,40 @@
 
 (in-package #:smoke)
 
-(defun s-call (method object &optional (args nil))
+(declaim (inline call-s-method) (optimize (debug 3)))
+(defun call-s-method (method object-pointer stack-pointer)
+  (foreign-funcall-pointer 
+   (foreign-slot-value (pointer (get-class method))
+                       'smoke-class
+                       'class-function)
+   ()
+   smoke-index (foreign-slot-value (smoke-method-pointer method)
+                                   'smoke-method
+                                   'method)
+   :pointer object-pointer
+   smoke-stack stack-pointer
+   :void))
+
+(defun s-call (method object-pointer &optional (args nil))
   (with-stack (stack args (arguments method) )
-    (smoke-call-method (smoke method) (id method)
-                       object (pointer stack))
+    (call-s-method method object-pointer (pointer stack))
     (type-to-lisp (pointer stack) (return-type method))))
 
-(defun pointer-call (method object &optional (args nil))
+(defun pointer-call (method object-pointer &optional (args nil))
   (with-stack (stack args (arguments method) )
-    (smoke-call-method (smoke method) (id method)
-                       object (pointer stack))
+    (call-s-method method object-pointer (pointer stack))
     (foreign-slot-value (pointer stack) 'smoke-stack-item 'class)))
 
 
 (defun smoke-call (class pointer method-name &optional (args nil))
   (s-call
-   (make-smoke-method class method-name)
+   (make-smoke-method-from-name class method-name)
    pointer args))
 
 (defun static-call (smoke class-name method-name &rest args)
   (s-call
-   (make-smoke-method (make-smoke-class smoke class-name)
-                           method-name)
+   (make-smoke-method-from-name (make-smoke-class smoke class-name)
+                                method-name)
    (null-pointer) args))
 
 (defun enum-call (method)
@@ -61,56 +73,62 @@
   ;; 
   (assert (enum-p method))
   (with-stack (stack nil nil)
-    (smoke-call-method (smoke method) (id method)
-                       (null-pointer) (pointer stack))
+    (call-s-method method (null-pointer) (pointer stack))
     (foreign-slot-value (pointer stack) 'smoke-stack-item 'long)))
 
-(defun new-object (binding class-name method-name &rest args)
-  (let* ((smoke (smoke-get-smoke binding))
-         (method (make-smoke-method (make-smoke-class smoke class-name)
-                                    method-name))
-         (pointer
-          (pointer-call method (null-pointer) args))
-         (object (instance-to-lisp pointer 
-                                   (find-smoke-class (get-class (return-type method)))
-                                   (return-type method))))
-    (set-binding object (binding (smoke (class-of object))))
-    (add-object object)
-    object))
-  
-
 (defun delete-pointer (pointer class)
   "Destructs the object at POINTER of type CLASS.
 Calls the destrutor and frees the memory."
+;  (declare (optimize (speed 3)))
   (let ((method-name (concatenate 'string "~" (name class))))
     (s-call
-     (make-smoke-method class method-name)
+     (make-smoke-method-from-name class method-name)
      pointer))
   (setf pointer (null-pointer)))
 
 (defun delete-object (object)
   (let ((method-name (concatenate 'string "~" (name (class-of object)))))
     (s-call
-                (make-smoke-method (class-of object) method-name)
+                (make-smoke-method-from-name (class-of object) method-name)
                 (pointer object)))
   (setf (slot-value object 'pointer) (null-pointer)))
 
-(defun set-binding (object binding)
-  (smoke-set-binding (smoke (class-of object)) binding (id (class-of object)) (pointer object)))
+(defun set-binding (object)
+  "Sets the Smoke binding for OBJECT, that receives its callbacks."
+  (declare (optimize (speed 3)))
+  (with-foreign-object (stack 'smoke-stack-item 2)
+    (setf (foreign-slot-value (mem-aref stack
+                                        'smoke-stack-item
+                                        1)
+                              'smoke-stack-item
+                              'voidp)
+          (smoke-module-binding (smoke (class-of object))))
+    (foreign-funcall-pointer 
+     (foreign-slot-value (pointer (class-of object))
+                         'smoke-class
+                         'class-function)
+     ()
+     smoke-index 0 ;; set binding method index
+     :pointer (pointer object) smoke-stack stack
+     :void)))
 
-(defun init (smoke)
+(defun init (smoke module)
   "Returns the a new Smoke binding for the Smoke module SMOKE."
   (use-foreign-library libsmoke-c)
-  (let ((binding (smoke-init smoke
-                             (callback destructed)
-                             (callback dispatch-method))))
-    (setf (binding smoke) binding)
-    binding))
+  (let* ((binding (smoke-init smoke
+                              (callback destructed)
+                              (callback dispatch-method))))
+    (setf (binding smoke) binding
+          (smoke-module-pointer module) smoke
+          (smoke-module-binding module) binding)
+    (init-smoke-module module)
+    (setf (gethash (pointer-address smoke) *smoke-modules*) module)
+    module))
 
 (let ((pointer-symbol-map (make-hash-table)))
   (defun register-smoke-module-var (symbol)
     "Registers SYMBOL of a variable containing a pointer to a Smoke module."
-    (setf (gethash (pointer-address (eval symbol)) pointer-symbol-map)
+    (setf (gethash (pointer-address (smoke-module-pointer (eval symbol))) pointer-symbol-map)
           symbol))
   (defun get-smoke-variable-for-pointer (pointer)
     "Returns the SYMBOL of the variable whose value is POINTER."
@@ -141,46 +159,51 @@
   (declare (string name)
            (optimize (speed 3)))
   (let ((methods))
-    (maphash #'(lambda (address value)
-                 (declare (ignore value))
-                 (let ((smoke (make-pointer address)))
-                   (map-methods #'(lambda (method)
-                                    (when (and (string= name (name method))
-                                               (not (enum-p method)))
-                                      (push (make-instance 'smoke-method
-                                                           :id (id method)
-                                                           :smoke (smoke method))
-                                            methods)))
-                                smoke)))
-             *smoke-id-class-map*)
+    (maphash
+     #'(lambda (address value)
+         (declare (ignore value))
+         (let ((smoke (make-pointer address)))
+           (map-methods #'(lambda (method)
+                            (when (and (string= name (name method))
+                                       (not (enum-p method)))
+                              (push (make-instance 'smoke-method
+                                                   :id (smoke-method-id method)
+                                                   :smoke (smoke method))
+                                    methods)))
+                        smoke)))
+     *smoke-id-class-map*)
     methods))
 
 (defun fgrep-methods (smoke str)
   (map-methods #'(lambda (method)
-                     (when (search str (name method))
-                       (format t "~A::~A~%" (name (get-class method))
-                               (signature method))))
+                   (when (search str (name method))
+                     (princ (method-declaration method))
+                     (terpri)))
                smoke))
 
 (defmacro define-smoke-module (package library 
                                (variable variable-name)
                                (init-function function-name))
   "Define a Smoke module."
-  `(progn
-     (eval-startup (:compile-toplevel :execute)
+  (let ((smoke-module (intern "*SMOKE-MODULE*")))
+    `(progn
+       (eval-startup (:compile-toplevel :execute)
+                     (eval-when (:compile-toplevel :load-toplevel :execute)
+                       (define-foreign-library ,library
+                           (:unix ,(format nil "~(~A~).so.2" library))
+                         (t (:default ,(format nil "~(~A~)" library))))
+                       (use-foreign-library ,library))
+                     (defcvar (,variable ,variable-name :read-only t) :pointer)
+                     (defcfun (,init-function ,(format nil "_Z~A~Av"
+                                                       (length function-name)
+                                                       function-name))
+                         :void))
        (eval-when (:compile-toplevel :load-toplevel :execute)
-         (define-foreign-library ,library
-          (:unix ,(format nil "~(~A~).so.2" library))
-          (t (:default ,(format nil "~(~A~)" library))))
-       (use-foreign-library ,library))
-       (defcvar (,variable ,variable-name :read-only t) :pointer)
-       (defcfun (,init-function ,(format nil "_Z~A~Av" (length function-name)
-                                         function-name))
-           :void))
-     (eval-startup (:compile-toplevel :execute)
-       (,init-function)
-       (init ,variable))
-     (define-classes-and-gfs ,package ,variable)))
+         (defparameter ,smoke-module (make-smoke-module)))
+       (eval-startup (:compile-toplevel :execute)
+                     (,init-function)
+                     (init ,variable ,smoke-module))
+       (define-classes-and-gfs ,package ,smoke-module))))
          
 
 (defun fgrep-classes (smoke str)
diff -rN -u old-smoke/src/using-type.lisp new-smoke/src/using-type.lisp
--- old-smoke/src/using-type.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/src/using-type.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,3 +1,5 @@
+;;; NOTE -using-type is disabled for now, since it is not used.
+
 (in-package :smoke)
 
 (defmacro with-object-as-object (object &body body)
@@ -15,8 +17,8 @@
 
 (defun typep-using-type (object-type type)
   "Returns true when OBJECT-TYPE is a subtype of TYPE,
-false when it is not"; and :MAYBE when the relationship
-;could not be determined."
+false when it is not; and :MAYBE when the relationship
+could not be determined."
   (declare (values (member t nil :maybe)))
   (multiple-value-bind (subtype-p valid-p)
       (subtypep object-type type)
@@ -55,6 +57,7 @@
      (with-object-as-object ,object
        (defun ,name ,lambda-list
          ,@body))
+     #+nil 
      (with-object-as-type ,object
        (defun ,(symbolicate name '-using-type) ,lambda-list
          ,@body))))
@@ -69,6 +72,7 @@
                        `(function ,name)))
             (defun ,name ,lambda-list
               ,@body))
+          #+nil
           (macrolet ((call-using-types (function-name &rest args)
                        `(,(symbolicate function-name '-using-types)
                           ,@args))
diff -rN -u old-smoke/test.lisp new-smoke/test.lisp
--- old-smoke/test.lisp	2014-10-01 19:32:19.000000000 +0200
+++ new-smoke/test.lisp	2014-10-01 19:32:20.000000000 +0200
@@ -1,5 +1,5 @@
 #|
-sbcl --noinform --noprint --disable-debugger --load $0 --end-toplevel-options "$@" || exit 1
+MALLOC_CHECK_=3 sbcl --noinform --disable-debugger --noprint --load $0 --end-toplevel-options "$@" || exit 1
 sh ./test-bundle.sh || exit 2
 exit 0
 # do not use --script to allow loading mudballs with ${HOME}/.sbclrc
@@ -21,7 +21,9 @@
                system-name))
 
 (load-sysdef-file :smoke)
-(mb:clean :smoke)
+;(mb:load :FiveAm)
+;(setf 5am:*debug-on-failure* t)
+;(setf 5am:*debug-on-error* t)
 (mb:test :smoke)
 
 (sb-ext:quit)