Sun Jan 10 09:49:36 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Support modular smoke & cleanup.

--- old-smoke/cl-smoke.smoke.asd 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/cl-smoke.smoke.asd 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,62 @@

+(defsystem :cl-smoke.smoke

+ :name :cl-smoke.smoke

+ :version (0 0 1)

+ :author "Tobias Rautenkranz"

+ :license "GPL with linking exception"

+ :description "Smoke bindings. Provides the base functionality to

+implement bindings using the various Smoke modules."

+ :depends-on

+ (:cffi :closer-mop :alexandria :trivial-garbage :bordeaux-threads)

+

+ :components

+ ((:module :src :components

+ ((:file "package")

+ (:file "using-type" :depends-on ("package"))

+ (:file "overload-resolution" :depends-on ("package" "smoke" "using-type"))

+ #+sbcl (:file "sb-optimize" :depends-on ("overload-resolution"))

+ (:file "smoke" :depends-on (:libsmoke :objects "clos"))

+ (:file "object-map" :depends-on (:objects :utils))

+ (:file "class-map" :depends-on ("package"))

+ (:file "bindings" :depends-on ("package" :utils))

+ (:file "cxx-method" :depends-on ("package"))

+ (:file "clos" :depends-on (:libsmoke "cxx-method" :objects

+ "object-map" "class-map" "bindings"))

+ (:file "smoke-to-clos" :depends-on ("clos" "overload-resolution"))

+ (:module :objects

+ :serial t

+ :depends-on (:libsmoke :utils "bindings")

+ :components

+ ((:file "object") (:file "enum" :depends-on ("object"))

+ (:file "type" :depends-on ("enum"))

+ (:file "method" :depends-on ("type"))

+ (:file "class" :depends-on ("method"))

+ (:file "instance" :depends-on ("class"))

+ (:file "stack" :depends-on ("instance"))))

+ (:module :libsmoke

+ :depends-on ("package")

+ :components

+ ((:file "smoke")

+ (:file "class" :depends-on ("smoke"))

+ (:file "stack" :depends-on ("class"))

+ (:file "method" :depends-on ("stack"))

+ (:file "type" :depends-on ("method"))))

+ (:module :utils

+ :depends-on ("package")

+ :components

+ ((:file "get-value")

+ #+sbcl (:file "sbcl-bundle")

+ (:module :image :components

+ ((:file "image" :depends-on (:impl))

+ (:module :impl

+ :components

+ (#+sbcl (:file "sbcl")

+ #+openmcl (:file "ccl")

+ #+(not (or sbcl openmcl))

+ (:file "not-implemented")))))))))))

+

+(defmethod operation-done-p ((o test-op) (c (eql (find-system :cl-smoke.smoke))))

+ nil)

+

+(defmethod perform ((operation test-op) (c (eql (find-system :cl-smoke.smoke))))

+ (operate 'asdf:load-op :cl-smoke.qt.tests)

+ (operate 'asdf:test-op :cl-smoke.qt.tests))

--- old-smoke/smoke.asd 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/smoke.asd 1970-01-01 01:00:00.000000000 +0100

@@ -1,63 +0,0 @@

-(defpackage smoke-system

- (:use :cl :asdf))

-

-(in-package smoke-system)

-

-(asdf:defsystem :smoke

- :name :smoke

- :version (0 0 1)

- :author "Tobias Rautenkranz"

- :license "GPL with linking exception"

- :description "Smoke bindings. Provides the base functionality to

-implement bindings using the various Smoke modules."

- :depends-on

- (:cffi :closer-mop :alexandria :trivial-garbage :bordeaux-threads)

-

- :components

- ((:module :src :components

- ((:file "package")

- (:file "using-type" :depends-on ("package"))

- (:file "overload-resolution" :depends-on ("package" "smoke" "using-type"))

- #+sbcl (:file "sb-optimize" :depends-on ("overload-resolution"))

- (:file "smoke" :depends-on (:smoke-c :objects "clos"))

- (:file "object-map" :depends-on (:objects :utils))

- (:file "class-map" :depends-on ("package"))

- (:file "bindings" :depends-on ("package"))

- (:file "cxx-method" :depends-on ("package"))

- (:file "clos" :depends-on

- (:smoke-c "cxx-method" :objects "object-map" "class-map" "bindings"))

- (:file "smoke-to-clos" :depends-on ("clos" "overload-resolution"))

- (:module :objects

- :serial t

- :depends-on (:smoke-c :utils "bindings")

- :components

- ((:file "object") (:file "enum" :depends-on ("object"))

- (:file "type" :depends-on ("enum"))

- (:file "method" :depends-on ("type"))

- (:file "class" :depends-on ("method"))

- (:file "instance" :depends-on ("class"))

- (:file "stack" :depends-on ("instance"))))

- (:module :smoke-c

- :depends-on ("package")

- :components

- ((:file "smoke-c") (:file "class" :depends-on ("smoke-c"))

- (:file "stack" :depends-on ("class"))

- (:file "method" :depends-on ("stack"))

- (:file "type" :depends-on ("method"))))

- (:module :utils

- :depends-on ("package")

- :components

- ((:file "get-value")

- #+sbcl (:file "sbcl-bundle")

- (:module :image :components

- ((:file "image" :depends-on (:impl))

- (:module :impl

- :components

- (#+sbcl (:file "sbcl")

- #+openmcl (:file "ccl")

- #+(not (or sbcl openmcl))

- (:file "not-implemented")))))))))))

-

-(defmethod asdf:perform ((operation test-op) (c (eql (find-system :smoke))))

- (operate 'asdf:load-op :qt)

- (operate 'asdf:test-op :qt))

--- old-smoke/src/CMakeLists.txt 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/CMakeLists.txt 2014-10-30 07:05:39.000000000 +0100

@@ -1 +1 @@

-add_subdirectory(smoke-c)

+add_subdirectory(libsmoke)

--- old-smoke/src/bindings.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/bindings.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -1,27 +1,5 @@

(in-package :smoke)

-(defvar *bindings* (make-hash-table)

- "The Smoke C++ binding classes to which virtual method calls are dispatched.")

-

-;; FIXME is this lock needed? (The user may not have to

-;; load additional modules while threads are running.

-(defvar *bindings-lock* (make-lock "bindings-lock"))

-

-(defun binding (smoke)

- "Returns the Smoke binding for the Smoke module SMOKE."

- (with-lock-held (*bindings-lock*)

- (multiple-value-bind (value present-p)

- (gethash (pointer-address smoke) *bindings*)

- (assert (eql t present-p)

- ()

- "No binding for ~A." smoke)

- value)))

-

-(defun (setf binding) (binding smoke)

- (with-lock-held (*bindings-lock*)

- (setf (gethash (pointer-address smoke) *bindings*)

- binding)))

-

(defstruct smoke-array

"A C array."

(pointer (null-pointer) :type foreign-pointer)

@@ -45,6 +23,9 @@

(defvar *smoke-modules* (make-hash-table)

"All loaded Smoke modules.")

+(eval-on-save ()

+ (clrhash *smoke-modules*))

+

(defmethod print-object ((smoke-module smoke-module) stream)

(if (null-pointer-p (smoke-module-pointer smoke-module))

(call-next-method)

--- old-smoke/src/clos.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/clos.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -202,26 +202,30 @@

(defun make-smoke-classes (package smoke)

"Constructs a lisp class in PACKAGE for each one in the Smoke module SMOKE."

(declare (optimize (speed 3)))

- (let ((*package* (find-package package)))

+ (let ((impl-package *package*)

+ (*package* (find-package package)))

(add-id-class-map smoke)

(map-classes

#'(lambda (class)

- (unless (or (external-p class)

- (and (eq package :cl-smoke.qt)

- (string/= (smoke-get-module-name

- (smoke-module-pointer smoke))

- "qt")

- (string= (name class) "QGlobalSpace")))

+ (unless (external-p class)

(with-simple-restart (skip "Skip generating class ~A" (name class))

- (add-id class

- (closer-mop:ensure-class (lispify (name class))

- :direct-superclasses

- (mapcar #'smoke-class-symbol

- (smoke-class-direct-superclasses class))

- :id (id class)

- :smoke (smoke class)

- :metaclass 'smoke-standard-class))

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

+ (let ((class-name

+ ;; There is a QGlobalSpace class per Smoke module.

+ ;; Put it in *package* and not PACKAGE to avoid

+ ;; clashes between multiple modules.

+ (if (string= "QGlobalSpace" (name class))

+ (lispify "QGlobalSpace" impl-package)

+ (lispify (name class)))))

+ (add-id class

+ (closer-mop:ensure-class class-name

+ :direct-superclasses

+ (mapcar #'smoke-class-symbol

+ (smoke-class-direct-superclasses class))

+ :id (id class)

+ :smoke (smoke class)

+ :metaclass 'smoke-standard-class))

+ (when (eql (symbol-package class-name) *package*)

+ (export class-name))))))

smoke)))

(defclass smoke-gf (cxx-generic-function)

--- old-smoke/src/libsmoke/CMakeLists.txt 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/CMakeLists.txt 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,25 @@

+find_package(Qt4 REQUIRED)

+set(QT_DONT_USE_QTGUI true)

+include(${QT_USE_FILE})

+

+include(CheckCXXCompilerFlag)

+check_cxx_compiler_flag("-fvisibility=hidden" CXX_VISIBILITY)

+if(CXX_VISIBILITY)

+ set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fvisibility=hidden -fvisibility-inlines-hidden")

+endif(CXX_VISIBILITY)

+

+set(SMOKE_C_SOURCES smoke.cpp smokebinding.cpp)

+add_library(clsmoke MODULE ${SMOKE_C_SOURCES})

+set_target_properties(clsmoke

+ PROPERTIES

+ SOVERSION "0.0"

+ VERSION "0.0.1")

+

+add_library(clsmokeutil MODULE smoke_util.cpp)

+set_target_properties(clsmokeutil

+ PROPERTIES

+ SOVERSION "0.0"

+ VERSION "0.0.1")

+

+install(TARGETS clsmoke clsmokeutil

+ LIBRARY DESTINATION lib)

--- old-smoke/src/libsmoke/cl_smoke.h 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/cl_smoke.h 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,62 @@

+#ifndef CL_SMOKE_H

+#define CL_SMOKE_H

+

+#include <smoke.h>

+

+#if defined _WIN32 || defined __CYGWIN__

+ #define CL_SMOKE_EXPORT __declspec(dllexport)

+#else

+ #if __GNUC__ >= 4

+ #define CL_SMOKE_EXPORT __attribute__((visibility("default")))

+ #else

+ #define CL_SMOKE_EXPORT

+ #endif

+#endif

+

+/** @brief cl-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;

+

+/** Casts the void pointer smoke_binding to the Binding class.

+ * @param smoke the smoke binding

+ *

+ * @return pointer to the Binding instance

+ */

+static inline

+Binding*

+get_smoke_binding(smoke_binding binding)

+{

+ return static_cast<Binding*>(binding);

+}

+

+/** Casts the void pointer smoke to the Smoke class.

+ * @param smoke the Smoke module

+ *

+ * @return pointer to the Smoke module.

+ */

+static inline

+Smoke*

+get_smoke(void* smoke)

+{

+ return static_cast<Smoke*>(smoke);

+}

+} // namespace cl_smoke

+

+#endif // CL_SMOKE_H

--- old-smoke/src/libsmoke/class.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/class.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,43 @@

+(in-package #:smoke)

+

+(defcenum smoke-class-flags

+ "Class properties"

+ (:constructor #x01)

+ (:copy-constructor #x02)

+ (:virtual-destructor #x04)

+ (:undefined #x10))

+

+(defcstruct smoke-class

+ "Describe a class"

+ (name :string)

+ (external cxx-bool)

+ (parents smoke-index)

+ (class-function :pointer)

+ (enum-function :pointer)

+ (flags :unsigned-short)

+ (size :unsigned-int))

+

+(defcfun (smoke-find-class "cl_smoke_find_class") :void

+ (m :pointer smoke-module-index)

+ (smoke :pointer)

+ (name :string))

+

+(defcfun (smoke-class-id "cl_smoke_class_id") smoke-index

+ (smoke :pointer)

+ (name :string))

+

+(defcfun (smoke-get-class "cl_smoke_get_class") (:pointer smoke-class)

+ (smoke :pointer)

+ (class smoke-index))

+

+(defcfun (smoke-is-derived-from "cl_smoke_is_derived_from") :boolean

+ (smoke :pointer)

+ (class smoke-index)

+ (smoke-base :pointer)

+ (base-class smoke-index))

+

+(defcfun (smoke-cast "cl_smoke_cast") :pointer

+ (smoke :pointer)

+ (object :pointer)

+ (from smoke-index)

+ (to smoke-index))

--- old-smoke/src/libsmoke/method.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/method.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,41 @@

+(in-package #:smoke)

+

+(defcenum smoke-method-flags

+ "Method flags"

+ (:static #x01)

+ (:const #x02)

+ (:copy-constructor #x04)

+ (:internal #x08)

+ (:enum #x10)

+ (:constructor #x20)

+ (:destructor #x40)

+ (:protected #x80)

+ (:attribute #x100)

+ (:property #x200)

+ (:virtual #x400)

+ (:purevirtual #x800)

+ (:signal #x1000)

+ (:slot #x2000))

+

+(defcstruct smoke-method

+ "Describe a method"

+ (class smoke-index)

+ (name smoke-index)

+ (arguments smoke-index)

+ (num-args :unsigned-char)

+ (flags :unsigned-short)

+ (return-type smoke-index)

+ (method smoke-index))

+

+(defcstruct smoke-method-map

+ "Maps a munged method."

+ (class-id smoke-index)

+ (name smoke-index)

+ (method smoke-index))

+

+(declaim (inline smoke-find-method))

+(defcfun (smoke-find-method "cl_smoke_find_method") :void

+ (m :pointer smoke-module-index)

+ (smoke :pointer)

+ (class smoke-index)

+ (method :string))

--- old-smoke/src/libsmoke/smoke.cpp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/smoke.cpp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,242 @@

+#include "cl_smoke.h"

+#include "smokebinding.h"

+

+#include <smoke.h>

+#include <QtGlobal>

+

+/** @file

+ * @brief C wrapper the Smoke bindings.

+ */

+

+using namespace cl_smoke;

+

+extern "C" {

+

+/** Returns the Smoke module of a Smoke binding.

+ * @related cl_smoke::Binding

+ * @param binding the Binding

+ *

+ * @return the Smoke module

+ */

+CL_SMOKE_EXPORT void*

+cl_smoke_get_smoke(smoke_binding binding)

+{

+ return get_smoke_binding(binding)->get_smoke();

+}

+

+/** Creates a new Smoke binding.

+ * The binding is allocated on the heap an can be freed with smoke_destruct().

+ * @related cl_smoke::Binding

+ * @param smoke pointer to a Smoke module instance

+ * @param destruct callback for object destruction

+ * @param dispatch method dispatch callback

+ *

+ * @return a pointer to a new Smoke binding.

+ */

+CL_SMOKE_EXPORT smoke_binding

+cl_smoke_init(void* smoke, void* destruct, void* dispatch)

+{

+ return new Binding(static_cast<Smoke*>(smoke),

+ reinterpret_cast<Binding::destructed>(destruct),

+ reinterpret_cast<Binding::dispatch_method>(dispatch));

+}

+

+/** Deletes the smoke binding.

+ * @related cl_smoke::Binding

+ */

+CL_SMOKE_EXPORT void

+cl_smoke_destruct(smoke_binding binding)

+{

+ delete get_smoke_binding(binding)->get_smoke();

+ delete get_smoke_binding(binding);

+}

+

+/** Gets a Smoke modules name.

+ * @param smoke the Smoke module

+ *

+ * @return the module name

+ */

+CL_SMOKE_EXPORT const char*

+cl_smoke_get_module_name(void* smoke)

+{

+ 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

+///////////////////////////

+

+/** Finds a class.

+ * @param c pointer to write the result to

+ * @param smoke the smoke module

+ * @param name the name of the class

+ */

+CL_SMOKE_EXPORT void

+cl_smoke_find_class(Smoke::ModuleIndex* c, void* smoke, const char* name)

+{

+ *c = get_smoke(smoke)->findClass(name);

+}

+

+/** Gets the class ID for a Smoke module.

+ * @param smoke the Smoke module

+ * @param name the class name

+ *

+ * @return the class ID in the supplied Smoke module

+ */

+CL_SMOKE_EXPORT Smoke::Index

+cl_smoke_class_id(void* smoke, const char* name)

+{

+ Smoke::ModuleIndex m = get_smoke(smoke)->idClass(name, true);

+ Q_ASSERT(m.smoke == smoke);

+

+ return m.index;

+}

+

+/** Gets a class

+ * @param smoke the smoke binding

+ * @param class_index the index of the class

+ *

+ * @return A pointer to the class into the array of class structs

+ */

+CL_SMOKE_EXPORT const struct Smoke::Class*

+cl_smoke_get_class(void* smoke, Smoke::Index class_index)

+{

+ Q_ASSERT(class_index >= 0 && class_index <= get_smoke(smoke)->numClasses);

+ return &get_smoke(smoke)->classes[class_index];

+}

+

+/** Determines werter a class is from a base class.

+ * @param smoke the Smoke module of @a class_index

+ * @param class_index the class index

+ * @param smoke_base the Smoke module of the base class @a base_index

+ * @param base_index the index of the base class

+ *

+ * @return Returns 0 when the class is not derived from the base class and nonzero value otherwise.

+ */

+CL_SMOKE_EXPORT int

+cl_smoke_is_derived_from(void* smoke, Smoke::Index class_index, void* smoke_base,

+ Smoke::Index base_index)

+{

+ Q_ASSERT(!smoke_get_class(smoke, class_index)->external);

+ Q_ASSERT(!smoke_get_class(smoke_base, base_index)->external);

+

+ return get_smoke(smoke)->isDerivedFrom(get_smoke(smoke), class_index,

+ get_smoke(smoke_base), base_index);

+}

+

+//////////////////////////////

+/// Method

+//////////////////////////////

+

+/** Finds a method of a class.

+ * @param m pointer to write the result to

+ * @param smoke the smoke binding

+ * @param class_index index of the class

+ * @param method_name method name

+ */

+CL_SMOKE_EXPORT void

+cl_smoke_find_method(Smoke::ModuleIndex* m, void* smoke,

+ Smoke::Index class_index, const char* method_name)

+{

+ *m = get_smoke(smoke)->findMethod(get_smoke(smoke)->className(class_index),

+ method_name);

+ if(m->index > 0)

+ m->index = m->smoke->methodMaps[m->index].method;

+}

+

+///////////////////////////

+/// Type

+//////////////////////////

+

+/** Gets the index of a type.

+ * @param smoke the Smoke module

+ * @param name the types name

+ *

+ * @return the index of the type

+ */

+CL_SMOKE_EXPORT Smoke::Index

+cl_smoke_find_type(void* smoke, const char* name)

+{

+ return get_smoke(smoke)->idType(name);

+}

+

+/** Casts an object.

+ * @param smoke the Smoke module

+ * @param object the objec

+ * @param from the class index of @a object

+ * @param to the class index to cast to

+ *

+ * @return the casted object

+ */

+CL_SMOKE_EXPORT void*

+cl_smoke_cast(void* smoke, void* object, Smoke::Index from, Smoke::Index to)

+{

+ 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);

+}

+

+} // extern "C"

--- old-smoke/src/libsmoke/smoke.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/smoke.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,81 @@

+(in-package #:smoke)

+

+;; Load the qt smoke binding to prevent undefined aliens.

+(eval-when (:load-toplevel :compile-toplevel :execute)

+ (define-foreign-library libsmokeqt

+ (:unix "libsmokeqtcore.so.3")

+ (t (:default "libsmokeqt")))

+ (define-foreign-library libclsmoke

+ (:unix "libclsmoke.so")

+ (t (:default "libclsmoke")))

+ (define-foreign-library libclsmokeutil

+ (:unix "libclsmokeutil.so")

+ (t (:default "libclsmokeutil")))

+ (use-foreign-library libsmokeqt)

+ (use-foreign-library libclsmoke))

+

+

+(eval-when (:load-toplevel :compile-toplevel :execute)

+ (use-foreign-library libclsmokeutil)

+ (defcfun (smoke-sizeof-bool "cl_smoke_sizeof_bool") :int)

+ (defun cffi-bool-type ()

+ "Returns a cffi unsigned int type with the same size as a C++ bool."

+ (load-foreign-library 'libclsmokeutil)

+ (intern (format nil "UINT~A" (* 8 (smoke-sizeof-bool)))

+ (find-package :keyword)))

+

+ (defmacro defcxxbool ()

+ `(defctype cxx-bool (:boolean ,(cffi-bool-type)))))

+

+(defcxxbool)

+

+;(close-foreign-library 'libclsmokeutil)

+

+(defctype smoke-binding :pointer

+ "A Smoke binding")

+

+(defctype smoke-index :short

+ "An index")

+

+(deftype smoke-index (&optional (lower -32768) (upper 32767))

+ "Smoke index."

+ `(integer ,lower ,upper))

+

+(defcfun (smoke-init "cl_smoke_init") smoke-binding

+ (smoke :pointer)

+ (destruct :pointer)

+ (dispatch :pointer))

+

+(defcfun (smoke-destruct "cl_smoke_destruct") :void

+ (smoke smoke-binding))

+

+;; Smoke::ModuleIndex is a POD-struct.

+;; Thus we can treat it as a C struct.

+(defcstruct smoke-module-index

+ (smoke :pointer)

+ (index smoke-index))

+

+(declaim (inline smoke-get-smoke))

+(defcfun (smoke-get-smoke "cl_smoke_get_smoke") :pointer

+ (smoke-binding smoke-binding))

+

+(defcfun (smoke-get-module-name "cl_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))

--- old-smoke/src/libsmoke/smoke_util.cpp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/smoke_util.cpp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,27 @@

+#if defined _WIN32 || defined __CYGWIN__

+ #define CL_SMOKE_EXPORT __declspec(dllexport)

+#else

+ #if __GNUC__ >= 4

+ #define CL_SMOKE_EXPORT __attribute__((visibility("default")))

+ #else

+ #define CL_SMOKE_EXPORT

+ #endif

+#endif

+

+/** @file

+ * \@brief Utility functions

+ */

+

+extern "C" {

+

+/** Gets the size of the C++ bool type in bytes.

+ *

+ * @return the size of bool

+ */

+CL_SMOKE_EXPORT int

+cl_smoke_sizeof_bool()

+{

+ return sizeof(bool);

+}

+

+} // extern "C"

--- old-smoke/src/libsmoke/smokebinding.cpp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/smokebinding.cpp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,87 @@

+#include "smokebinding.h"

+

+#include <QtGlobal>

+#include <QDebug>

+

+namespace cl_smoke

+{

+

+/** @class Binding

+ * @brief The Smoke binding.

+ */

+

+

+/** @typedef Binding::destructed

+ * Callback when a Smoke object is destructed.

+ *

+ * @param class_index Index of the object's class.

+ * @param object pointer to the object

+ */

+

+

+/** @typedef Binding::dispatch_method

+ * Callback when a Smoke method gets called.

+ *

+ * @param binding Smoke binding of @a object

+ * @param method index of the method

+ * @param object the object for which the method is called

+ * @param args the arguments to the method

+ * @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.

+ */

+

+/** Constructor.

+ * @param smoke the Smoke module

+ * @param destruct destruct callback

+ * @param dispatch method dispatch callback

+ */

+Binding::Binding(Smoke *smoke, destructed destruct,

+ dispatch_method dispatch)

+ : SmokeBinding(smoke),

+ destruct(destruct),

+ dispatch(dispatch)

+{

+ Q_ASSERT(smoke);

+ Q_ASSERT(destruct);

+ Q_ASSERT(dispatch);

+}

+

+/** Invoked when a Smoke object is destructed. */

+void

+Binding::deleted(Smoke::Index, void *object)

+{

+ destruct(object);

+}

+

+/** Invoked when a Smoke method gets called. */

+bool

+Binding::callMethod(Smoke::Index method, void* object,

+ Smoke::Stack stack, bool abstract)

+{

+ int ret = dispatch(this, method, object, stack, abstract);

+ Q_ASSERT( !abstract || ret );

+

+ return ret;

+}

+

+/**

+ * @todo Returning a const char* would be better

+ */

+char*

+Binding::className(Smoke::Index classId)

+{

+ return const_cast<char*>(smoke->classes[classId].className);

+}

+

+/** Gets the Smoke instance associated with the binding.

+ * @return a pointer to the Smoke instance

+ */

+Smoke*

+Binding::get_smoke() const

+{

+ return smoke;

+}

+

+} // namespace cl_smoke

--- old-smoke/src/libsmoke/smokebinding.h 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/smokebinding.h 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,39 @@

+#ifndef SMOKEBINDING_H

+#define SMOKEBINDING_H

+

+#include <smoke.h>

+

+namespace cl_smoke

+{

+

+class Binding : public SmokeBinding

+{

+ public:

+ typedef void (*destructed)(void* object);

+

+ typedef int (*dispatch_method)(Binding* binding, Smoke::Index method,

+ void* object, Smoke::Stack args, int abstract);

+

+ Binding(Smoke *smoke, destructed destruct, dispatch_method dispatch);

+

+ virtual void

+ deleted(Smoke::Index classId, void *object);

+

+ virtual bool

+ callMethod(Smoke::Index method, void* object,

+ Smoke::Stack stack, bool abstract);

+

+ virtual char*

+ className(Smoke::Index classId);

+

+ Smoke*

+ get_smoke() const;

+

+ private:

+ const destructed destruct;

+ const dispatch_method dispatch;

+};

+

+} // namespace cl_smoke

+

+#endif // SMOKEBINDING_H

--- old-smoke/src/libsmoke/stack.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/stack.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,21 @@

+(in-package #:smoke)

+

+(defcunion smoke-stack-item

+ "A variable on the Smoke stack"

+ (voidp :pointer)

+ (bool cxx-bool)

+ (char :char)

+ (uchar :unsigned-char)

+ (short :short)

+ (ushort :unsigned-short)

+ (int :int)

+ (uint :unsigned-int)

+ (long :long)

+ (ulong :unsigned-long)

+ (float :float)

+ (double :double)

+ (enum-value :long)

+ (class :pointer))

+

+(defctype smoke-stack (:pointer smoke-stack-item)

+ "A Smoke call stack.")

--- old-smoke/src/libsmoke/type.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-smoke/src/libsmoke/type.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -0,0 +1,20 @@

+(in-package #:smoke)

+

+(defcenum smoke-type-flags

+ "Type properties"

+ (:type-id #x0F)

+

+ (:stack #x10)

+ (:pointer #x20)

+ (:reference #x30)

+

+ (:const #x40))

+

+(defcstruct smoke-type

+ (name :string)

+ (class smoke-index)

+ (flags :unsigned-short))

+

+(defcfun (smoke-find-type "cl_smoke_find_type") smoke-index

+ (smoke :pointer)

+ (name :string))

--- old-smoke/src/object-map.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/object-map.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -38,8 +38,9 @@

transferred to C++.")

(eval-on-save ()

+ (tg:gc :full t) ;; Try to get all #'smoke::make-auto-pointer

(loop for object being the hash-value of *object-map* do

- (warn "life object ~A" object)

+ (warn "life object ~A ~A" object (pointer object))

(remove-finalizer object)

(setf (slot-value object 'pointer) (null-pointer)))

(clrhash *object-map*))

--- old-smoke/src/smoke-c/CMakeLists.txt 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/CMakeLists.txt 1970-01-01 01:00:00.000000000 +0100

@@ -1,25 +0,0 @@

-find_package(Qt4 REQUIRED)

-set(QT_DONT_USE_QTGUI true)

-include(${QT_USE_FILE})

-

-include(CheckCXXCompilerFlag)

-check_cxx_compiler_flag("-fvisibility=hidden" CXX_VISIBILITY)

-if(CXX_VISIBILITY)

- set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fvisibility=hidden -fvisibility-inlines-hidden")

-endif(CXX_VISIBILITY)

-

-set(SMOKE_C_SOURCES smoke-c.cpp csmokebinding.cpp)

-add_library(smoke-c MODULE ${SMOKE_C_SOURCES})

-set_target_properties(smoke-c

- PROPERTIES

- SOVERSION "0.0"

- VERSION "0.0.1")

-

-add_library(smoke-c-util MODULE smoke-c-util.cpp)

-set_target_properties(smoke-c-util

- PROPERTIES

- SOVERSION "0.0"

- VERSION "0.0.1")

-

-install(TARGETS smoke-c smoke-c-util

- LIBRARY DESTINATION lib)

--- old-smoke/src/smoke-c/cl_smoke.h 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/cl_smoke.h 1970-01-01 01:00:00.000000000 +0100

@@ -1,62 +0,0 @@

-#ifndef CL_SMOKE_H

-#define CL_SMOKE_H

-

-#include <smoke.h>

-

-#if defined _WIN32 || defined __CYGWIN__

- #define CL_SMOKE_EXPORT __declspec(dllexport)

-#else

- #if __GNUC__ >= 4

- #define CL_SMOKE_EXPORT __attribute__((visibility("default")))

- #else

- #define CL_SMOKE_EXPORT

- #endif

-#endif

-

-/** @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;

-

-/** Casts the void pointer smoke_binding to the Binding class.

- * @param smoke the smoke binding

- *

- * @return pointer to the Binding instance

- */

-static inline

-Binding*

-get_smoke_binding(smoke_binding binding)

-{

- return static_cast<Binding*>(binding);

-}

-

-/** Casts the void pointer smoke to the Smoke class.

- * @param smoke the Smoke module

- *

- * @return pointer to the Smoke module.

- */

-static inline

-Smoke*

-get_smoke(void* smoke)

-{

- return static_cast<Smoke*>(smoke);

-}

-} // namespace cl_smoke

-

-#endif // CL_SMOKE_H

--- old-smoke/src/smoke-c/class.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/class.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,43 +0,0 @@

-(in-package #:smoke)

-

-(defcenum smoke-class-flags

- "Class properties"

- (:constructor #x01)

- (:copy-constructor #x02)

- (:virtual-destructor #x04)

- (:undefined #x10))

-

-(defcstruct smoke-class

- "Describe a class"

- (name :string)

- (external cxx-bool)

- (parents smoke-index)

- (class-function :pointer)

- (enum-function :pointer)

- (flags :unsigned-short)

- (size :unsigned-int))

-

-(defcfun smoke-find-class :void

- (m :pointer smoke-module-index)

- (smoke :pointer)

- (name :string))

-

-(defcfun smoke-class-id smoke-index

- (smoke :pointer)

- (name :string))

-

-(defcfun smoke-get-class (:pointer smoke-class)

- (smoke :pointer)

- (class smoke-index))

-

-(defcfun smoke-is-derived-from :boolean

- (smoke :pointer)

- (class smoke-index)

- (smoke-base :pointer)

- (base-class smoke-index))

-

-(defcfun smoke-cast :pointer

- (smoke :pointer)

- (object :pointer)

- (from smoke-index)

- (to smoke-index))

--- old-smoke/src/smoke-c/csmokebinding.cpp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/csmokebinding.cpp 1970-01-01 01:00:00.000000000 +0100

@@ -1,87 +0,0 @@

-#include "csmokebinding.h"

-

-#include <QtGlobal>

-#include <QDebug>

-

-namespace cl_smoke

-{

-

-/** @class Binding

- * @brief The Smoke binding.

- */

-

-

-/** @typedef Binding::destructed

- * Callback when a Smoke object is destructed.

- *

- * @param class_index Index of the object's class.

- * @param object pointer to the object

- */

-

-

-/** @typedef Binding::dispatch_method

- * Callback when a Smoke method gets called.

- *

- * @param binding Smoke binding of @a object

- * @param method index of the method

- * @param object the object for which the method is called

- * @param args the arguments to the method

- * @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.

- */

-

-/** Constructor.

- * @param smoke the Smoke module

- * @param destruct destruct callback

- * @param dispatch method dispatch callback

- */

-Binding::Binding(Smoke *smoke, destructed destruct,

- dispatch_method dispatch)

- : SmokeBinding(smoke),

- destruct(destruct),

- dispatch(dispatch)

-{

- Q_ASSERT(smoke);

- Q_ASSERT(destruct);

- Q_ASSERT(dispatch);

-}

-

-/** Invoked when a Smoke object is destructed. */

-void

-Binding::deleted(Smoke::Index, void *object)

-{

- destruct(object);

-}

-

-/** Invoked when a Smoke method gets called. */

-bool

-Binding::callMethod(Smoke::Index method, void* object,

- Smoke::Stack stack, bool abstract)

-{

- int ret = dispatch(this, method, object, stack, abstract);

- Q_ASSERT( !abstract || ret );

-

- return ret;

-}

-

-/**

- * @todo Returning a const char* would be better

- */

-char*

-Binding::className(Smoke::Index classId)

-{

- return const_cast<char*>(smoke->classes[classId].className);

-}

-

-/** Gets the Smoke instance associated with the binding.

- * @return a pointer to the Smoke instance

- */

-Smoke*

-Binding::get_smoke() const

-{

- return smoke;

-}

-

-} // namespace cl_smoke

--- old-smoke/src/smoke-c/csmokebinding.h 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/csmokebinding.h 1970-01-01 01:00:00.000000000 +0100

@@ -1,39 +0,0 @@

-#ifndef CSMOKEBINDING_H

-#define CSMOKEBINDING_H

-

-#include <smoke.h>

-

-namespace cl_smoke

-{

-

-class Binding : public SmokeBinding

-{

- public:

- typedef void (*destructed)(void* object);

-

- typedef int (*dispatch_method)(Binding* binding, Smoke::Index method,

- void* object, Smoke::Stack args, int abstract);

-

- Binding(Smoke *smoke, destructed destruct, dispatch_method dispatch);

-

- virtual void

- deleted(Smoke::Index classId, void *object);

-

- virtual bool

- callMethod(Smoke::Index method, void* object,

- Smoke::Stack stack, bool abstract);

-

- virtual char*

- className(Smoke::Index classId);

-

- Smoke*

- get_smoke() const;

-

- private:

- const destructed destruct;

- const dispatch_method dispatch;

-};

-

-} // namespace cl_smoke

-

-#endif // CSMOKEBINDING_H

--- old-smoke/src/smoke-c/method.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/method.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,41 +0,0 @@

-(in-package #:smoke)

-

-(defcenum smoke-method-flags

- "Method flags"

- (:static #x01)

- (:const #x02)

- (:copy-constructor #x04)

- (:internal #x08)

- (:enum #x10)

- (:constructor #x20)

- (:destructor #x40)

- (:protected #x80)

- (:attribute #x100)

- (:property #x200)

- (:virtual #x400)

- (:purevirtual #x800)

- (:signal #x1000)

- (:slot #x2000))

-

-(defcstruct smoke-method

- "Describe a method"

- (class smoke-index)

- (name smoke-index)

- (arguments smoke-index)

- (num-args :unsigned-char)

- (flags :unsigned-short)

- (return-type smoke-index)

- (method smoke-index))

-

-(defcstruct smoke-method-map

- "Maps a munged method."

- (class-id smoke-index)

- (name smoke-index)

- (method smoke-index))

-

-(declaim (inline smoke-find-method))

-(defcfun smoke-find-method :void

- (m :pointer smoke-module-index)

- (smoke :pointer)

- (class smoke-index)

- (method :string))

--- old-smoke/src/smoke-c/smoke-c-util.cpp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/smoke-c-util.cpp 1970-01-01 01:00:00.000000000 +0100

@@ -1,27 +0,0 @@

-#if defined _WIN32 || defined __CYGWIN__

- #define CL_SMOKE_EXPORT __declspec(dllexport)

-#else

- #if __GNUC__ >= 4

- #define CL_SMOKE_EXPORT __attribute__((visibility("default")))

- #else

- #define CL_SMOKE_EXPORT

- #endif

-#endif

-

-/** @file

- * \@brief Utility functions

- */

-

-extern "C" {

-

-/** Gets the size of the C++ bool type in bytes.

- *

- * @return the size of bool

- */

-CL_SMOKE_EXPORT int

-smoke_sizeof_bool()

-{

- return sizeof(bool);

-}

-

-} // extern "C"

--- old-smoke/src/smoke-c/smoke-c.cpp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/smoke-c.cpp 1970-01-01 01:00:00.000000000 +0100

@@ -1,242 +0,0 @@

-#include "csmokebinding.h"

-#include "cl_smoke.h"

-

-#include <smoke.h>

-

-#include <QtGlobal>

-

-/** @file

- * @brief C wrapper the Smoke bindings.

- */

-

-using namespace cl_smoke;

-

-extern "C" {

-

-/** Returns the Smoke module of a Smoke binding.

- * @related cl_smoke::Binding

- * @param binding the Binding

- *

- * @return the Smoke module

- */

-CL_SMOKE_EXPORT void*

-smoke_get_smoke(smoke_binding binding)

-{

- return get_smoke_binding(binding)->get_smoke();

-}

-

-/** Creates a new Smoke binding.

- * The binding is allocated on the heap an can be freed with smoke_destruct().

- * @related cl_smoke::Binding

- * @param smoke pointer to a Smoke module instance

- * @param destruct callback for object destruction

- * @param dispatch method dispatch callback

- *

- * @return a pointer to a new Smoke binding.

- */

-CL_SMOKE_EXPORT smoke_binding

-smoke_init(void* smoke, void* destruct, void* dispatch)

-{

- return new Binding(static_cast<Smoke*>(smoke),

- reinterpret_cast<Binding::destructed>(destruct),

- reinterpret_cast<Binding::dispatch_method>(dispatch));

-}

-

-/** Deletes the smoke binding.

- * @related cl_smoke::Binding

- */

-CL_SMOKE_EXPORT void

-smoke_destruct(smoke_binding binding)

-{

- delete get_smoke_binding(binding)->get_smoke();

- delete get_smoke_binding(binding);

-}

-

-/** Gets a Smoke modules name.

- * @param smoke the Smoke module

- *

- * @return the module name

- */

-CL_SMOKE_EXPORT const char*

-smoke_get_module_name(void* smoke)

-{

- 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

-///////////////////////////

-

-/** Finds a class.

- * @param c pointer to write the result to

- * @param smoke the smoke module

- * @param name the name of the class

- */

-CL_SMOKE_EXPORT void

-smoke_find_class(Smoke::ModuleIndex* c, void* smoke, const char* name)

-{

- *c = get_smoke(smoke)->findClass(name);

-}

-

-/** Gets the class ID for a Smoke module.

- * @param smoke the Smoke module

- * @param name the class name

- *

- * @return the class ID in the supplied Smoke module

- */

-CL_SMOKE_EXPORT Smoke::Index

-smoke_class_id(void* smoke, const char* name)

-{

- Smoke::ModuleIndex m = get_smoke(smoke)->idClass(name, true);

- Q_ASSERT(m.smoke == smoke);

-

- return m.index;

-}

-

-/** Gets a class

- * @param smoke the smoke binding

- * @param class_index the index of the class

- *

- * @return A pointer to the class into the array of class structs

- */

-CL_SMOKE_EXPORT const struct Smoke::Class*

-smoke_get_class(void* smoke, Smoke::Index class_index)

-{

- Q_ASSERT(class_index >= 0 && class_index <= get_smoke(smoke)->numClasses);

- return &get_smoke(smoke)->classes[class_index];

-}

-

-/** Determines werter a class is from a base class.

- * @param smoke the Smoke module of @a class_index

- * @param class_index the class index

- * @param smoke_base the Smoke module of the base class @a base_index

- * @param base_index the index of the base class

- *

- * @return Returns 0 when the class is not derived from the base class and nonzero value otherwise.

- */

-CL_SMOKE_EXPORT int

-smoke_is_derived_from(void* smoke, Smoke::Index class_index, void* smoke_base, Smoke::Index base_index)

-{

- Q_ASSERT(!smoke_get_class(smoke, class_index)->external);

- Q_ASSERT(!smoke_get_class(smoke_base, base_index)->external);

-

- return get_smoke(smoke)->isDerivedFrom(get_smoke(smoke), class_index,

- get_smoke(smoke_base), base_index);

-}

-

-//////////////////////////////

-/// Method

-//////////////////////////////

-

-/** Finds a method of a class.

- * @param m pointer to write the result to

- * @param smoke the smoke binding

- * @param class_index index of the class

- * @param method_name method name

- */

-CL_SMOKE_EXPORT void

-smoke_find_method(Smoke::ModuleIndex* m, void* smoke,

- Smoke::Index class_index, const char* method_name)

-{

- *m = get_smoke(smoke)->findMethod(get_smoke(smoke)->className(class_index),

- method_name);

- if(m->index > 0)

- m->index = m->smoke->methodMaps[m->index].method;

-}

-

-///////////////////////////

-/// Type

-//////////////////////////

-

-/** Gets the index of a type.

- * @param smoke the Smoke module

- * @param name the types name

- *

- * @return the index of the type

- */

-CL_SMOKE_EXPORT Smoke::Index

-smoke_find_type(void* smoke, const char* name)

-{

- return get_smoke(smoke)->idType(name);

-}

-

-/** Casts an object.

- * @param smoke the Smoke module

- * @param object the objec

- * @param from the class index of @a object

- * @param to the class index to cast to

- *

- * @return the casted object

- */

-CL_SMOKE_EXPORT void*

-smoke_cast(void* smoke, void* object, Smoke::Index from, Smoke::Index to)

-{

- 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);

-}

-

-} // extern "C"

--- old-smoke/src/smoke-c/smoke-c.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/smoke-c.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,81 +0,0 @@

-(in-package #:smoke)

-

-;; Load the qt smoke binding to prevent undefined aliens.

-(eval-when (:load-toplevel :compile-toplevel :execute)

- (define-foreign-library libsmokeqt

- (:unix "libsmokeqt.so.3")

- (t (:default "libsmokeqt")))

- (define-foreign-library libsmoke-c

- (:unix "libsmoke-c.so")

- (t (:default "libsmoke-c")))

- (define-foreign-library libsmoke-c-util

- (:unix "libsmoke-c-util.so")

- (t (:default "libsmoke-c-util")))

- (use-foreign-library libsmokeqt)

- (use-foreign-library libsmoke-c))

-

-

-(eval-when (:load-toplevel :compile-toplevel :execute)

- (use-foreign-library libsmoke-c-util)

- (defcfun smoke-sizeof-bool :int)

- (defun cffi-bool-type ()

- "Returns a cffi unsigned int type with the same size as a C++ bool."

- (load-foreign-library 'libsmoke-c-util)

- (intern (format nil "UINT~A" (* 8 (smoke-sizeof-bool)))

- (find-package :keyword)))

-

- (defmacro defcxxbool ()

- `(defctype cxx-bool (:boolean ,(cffi-bool-type)))))

-

-(defcxxbool)

-

-;(close-foreign-library 'libsmoke-c-util)

-

-(defctype smoke-binding :pointer

- "A Smoke binding")

-

-(defctype smoke-index :short

- "An index")

-

-(deftype smoke-index (&optional (lower -32768) (upper 32767))

- "Smoke index."

- `(integer ,lower ,upper))

-

-(defcfun smoke-init smoke-binding

- (smoke :pointer)

- (destruct :pointer)

- (dispatch :pointer))

-

-(defcfun smoke-destruct :void

- (smoke smoke-binding))

-

-;; Smoke::ModuleIndex is a POD-struct.

-;; Thus we can treat it as a C struct.

-(defcstruct smoke-module-index

- (smoke :pointer)

- (index smoke-index))

-

-(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))

--- old-smoke/src/smoke-c/stack.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/stack.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,21 +0,0 @@

-(in-package #:smoke)

-

-(defcunion smoke-stack-item

- "A variable on the Smoke stack"

- (voidp :pointer)

- (bool cxx-bool)

- (char :char)

- (uchar :unsigned-char)

- (short :short)

- (ushort :unsigned-short)

- (int :int)

- (uint :unsigned-int)

- (long :long)

- (ulong :unsigned-long)

- (float :float)

- (double :double)

- (enum-value :long)

- (class :pointer))

-

-(defctype smoke-stack (:pointer smoke-stack-item)

- "A Smoke call stack.")

--- old-smoke/src/smoke-c/type.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-c/type.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,20 +0,0 @@

-(in-package #:smoke)

-

-(defcenum smoke-type-flags

- "Type properties"

- (:type-id #x0F)

-

- (:stack #x10)

- (:pointer #x20)

- (:reference #x30)

-

- (:const #x40))

-

-(defcstruct smoke-type

- (name :string)

- (class smoke-index)

- (flags :unsigned-short))

-

-(defcfun smoke-find-type smoke-index

- (smoke :pointer)

- (name :string))

--- old-smoke/src/smoke-to-clos.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke-to-clos.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -18,7 +18,7 @@

package))))

(values

(if (= 8 (type-id (return-type method)))

- `(define-constant ,symbol ;; a long not really an enum.

+ `(define-constant ,symbol ;; a long, not really an enum.

,(enum-call method))

`(define-constant ,symbol

(make-instance 'enum

@@ -52,11 +52,16 @@

`(defun ,name ,(if (< argument-count 0)

'(&rest args)

(make-lambda argument-count))

- (call-using-args (find-class (quote ,(lispify (name class) package)))

- ,method-name

- ,(if (< argument-count 0)

- 'args

- `(list ,@(make-lambda argument-count)))))

+ (call-using-args

+ (find-class (quote ,(lispify (name class)

+ (if (string= (name class)

+ "QGlobalSpace")

+ *package* ;; See #'MAKE-SMOKE-CLASSES

+ package))))

+ ,method-name

+ ,(if (< argument-count 0)

+ 'args

+ `(list ,@(make-lambda argument-count)))))

name)))

(defun ensure-generic-methods (symbols-names)

@@ -108,7 +113,10 @@

(exports))

(map-methods

#'(lambda (method)

- (when (enum-p method)

+ (when (and (enum-p method)

+ ;; qt.network has QIODevice::NotOpen(), but the

+ ;; class is external (workaround).

+ (not (external-p (get-class method))))

(multiple-value-bind (def export) (constant-definition package method smoke)

(push def

constants)

@@ -131,8 +139,12 @@

(when (static-p method)

(let* ((function-symbol (static-method-symbol package method))

(methods (gethash function-symbol function-symbols)))

- (setf (gethash function-symbol function-symbols)

- (if methods (- (id method)) (id method)))))))

+ (unless (fboundp function-symbol) ;; do not overwrite

+ ;; existing functions e.g. qInstallMsgHandler of

+ ;; qt.core with that of qt.gui which causes a

+ ;; segfault when loading from an saved image.

+ (setf (gethash function-symbol function-symbols)

+ (if methods (- (id method)) (id method))))))))

(eval smoke))

(loop for id being the hash-values of function-symbols do

(let ((method (make-smoke-method

@@ -149,10 +161,8 @@

(push export exports))))

`(progn (check-recompile ,smoke)

,@functions

- (eval-startup (:load-toplevel :execute)

- ;; eval on startup for class map.

- (make-smoke-classes ,package ,smoke))

(eval-when (:load-toplevel :execute)

+ (make-smoke-classes ,package ,smoke)

(ensure-generic-methods ',(hash-table-alist generics)))

,@constants

(eval-when (:load-toplevel :execute)

--- old-smoke/src/smoke.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/src/smoke.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -1,4 +1,4 @@

-;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

+;;; Copyright (C) 2009, 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

;;;

;;; This program is free software: you can redistribute it and/or modify

;;; it under the terms of the GNU General Public License as published by

@@ -102,17 +102,17 @@

(defun init (smoke module)

"Returns the a new Smoke binding for the Smoke module SMOKE."

- (use-foreign-library libsmoke-c)

+ (use-foreign-library libclsmoke)

(let* ((binding (smoke-init smoke (callback destructed)

(callback dispatch-method))))

- (setf (binding smoke) binding

- (smoke-module-pointer module) smoke

+ (setf (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)))

+ ;; Used by make-load-form for enums to reference the smoke module.

(defun register-smoke-module-var (symbol)

"Registers SYMBOL of a variable containing a pointer to a Smoke module."

(setf (gethash (pointer-address (smoke-module-pointer (eval symbol)))

@@ -145,7 +145,6 @@

(defun all-methods (name)

"Returns a list of all methods named NAME."

- ;;FIXME speed this up, needed by (mb:document :smoke).

(declare (optimize (speed 3)))

(with-foreign-string (name name)

(let ((methods))

--- old-smoke/test-bundle.sh 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/test-bundle.sh 2014-10-30 07:05:39.000000000 +0100

@@ -5,7 +5,7 @@

exit 1

fi

-MALLOC_CHECK_=3 sbcl --eval '(require :qt.tests)' \

+MALLOC_CHECK_=3 sbcl --eval '(require :cl-smoke.qt.tests)' \

--eval '(smoke:save-bundle "qt.test.run")' \

--eval '(quit)' || exit 1

--- old-smoke/test.lisp 2014-10-30 07:05:39.000000000 +0100

+++ new-smoke/test.lisp 2014-10-30 07:05:39.000000000 +0100

@@ -8,7 +8,7 @@

"###############

## Testing sbcl image

################"

-sh ./test-bundle.sh || exit 2

+ sh ./test-bundle.sh || exit 2

echo \

"###############

## Testing ccl

@@ -18,8 +18,9 @@

# Used for testing on darcs record.

|#

-(asdf:operate 'asdf:load-op :smoke)

-(asdf:operate 'asdf:test-op :smoke)

+(require :asdf)

+(asdf:operate 'asdf:load-op :cl-smoke.smoke)

+(asdf:operate 'asdf:test-op :cl-smoke.smoke)

#+sbcl (sb-ext:quit)

#+ccl (ccl:quit)