Sun Jan 10 09:49:36 CET 2010 Tobias Rautenkranz * Support modular smoke & cleanup. diff -rN -u old-smoke/cl-smoke.smoke.asd new-smoke/cl-smoke.smoke.asd --- old-smoke/cl-smoke.smoke.asd 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/cl-smoke.smoke.asd 2014-10-30 08:09:01.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)) diff -rN -u old-smoke/smoke.asd new-smoke/smoke.asd --- old-smoke/smoke.asd 2014-10-30 08:09:01.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)) diff -rN -u old-smoke/src/CMakeLists.txt new-smoke/src/CMakeLists.txt --- old-smoke/src/CMakeLists.txt 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/src/CMakeLists.txt 2014-10-30 08:09:01.000000000 +0100 @@ -1 +1 @@ -add_subdirectory(smoke-c) +add_subdirectory(libsmoke) diff -rN -u old-smoke/src/bindings.lisp new-smoke/src/bindings.lisp --- old-smoke/src/bindings.lisp 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/src/bindings.lisp 2014-10-30 08:09:01.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) diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp --- old-smoke/src/clos.lisp 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/src/clos.lisp 2014-10-30 08:09:01.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) diff -rN -u old-smoke/src/libsmoke/CMakeLists.txt new-smoke/src/libsmoke/CMakeLists.txt --- old-smoke/src/libsmoke/CMakeLists.txt 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/CMakeLists.txt 2014-10-30 08:09:01.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) diff -rN -u old-smoke/src/libsmoke/cl_smoke.h new-smoke/src/libsmoke/cl_smoke.h --- 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 08:09:01.000000000 +0100 @@ -0,0 +1,62 @@ +#ifndef CL_SMOKE_H +#define CL_SMOKE_H + +#include + +#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); +} + +/** 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); +} +} // namespace cl_smoke + +#endif // CL_SMOKE_H diff -rN -u old-smoke/src/libsmoke/class.lisp new-smoke/src/libsmoke/class.lisp --- old-smoke/src/libsmoke/class.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/class.lisp 2014-10-30 08:09:01.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)) diff -rN -u old-smoke/src/libsmoke/method.lisp new-smoke/src/libsmoke/method.lisp --- old-smoke/src/libsmoke/method.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/method.lisp 2014-10-30 08:09:01.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)) diff -rN -u old-smoke/src/libsmoke/smoke.cpp new-smoke/src/libsmoke/smoke.cpp --- old-smoke/src/libsmoke/smoke.cpp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/smoke.cpp 2014-10-30 08:09:01.000000000 +0100 @@ -0,0 +1,242 @@ +#include "cl_smoke.h" +#include "smokebinding.h" + +#include +#include + +/** @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), + reinterpret_cast(destruct), + reinterpret_cast(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" diff -rN -u old-smoke/src/libsmoke/smoke.lisp new-smoke/src/libsmoke/smoke.lisp --- old-smoke/src/libsmoke/smoke.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/smoke.lisp 2014-10-30 08:09:01.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)) diff -rN -u old-smoke/src/libsmoke/smoke_util.cpp new-smoke/src/libsmoke/smoke_util.cpp --- 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 08:09:01.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" diff -rN -u old-smoke/src/libsmoke/smokebinding.cpp new-smoke/src/libsmoke/smokebinding.cpp --- old-smoke/src/libsmoke/smokebinding.cpp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/smokebinding.cpp 2014-10-30 08:09:01.000000000 +0100 @@ -0,0 +1,87 @@ +#include "smokebinding.h" + +#include +#include + +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(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 diff -rN -u old-smoke/src/libsmoke/smokebinding.h new-smoke/src/libsmoke/smokebinding.h --- old-smoke/src/libsmoke/smokebinding.h 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/smokebinding.h 2014-10-30 08:09:01.000000000 +0100 @@ -0,0 +1,39 @@ +#ifndef SMOKEBINDING_H +#define SMOKEBINDING_H + +#include + +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 diff -rN -u old-smoke/src/libsmoke/stack.lisp new-smoke/src/libsmoke/stack.lisp --- old-smoke/src/libsmoke/stack.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/stack.lisp 2014-10-30 08:09:01.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.") diff -rN -u old-smoke/src/libsmoke/type.lisp new-smoke/src/libsmoke/type.lisp --- old-smoke/src/libsmoke/type.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-smoke/src/libsmoke/type.lisp 2014-10-30 08:09:01.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)) diff -rN -u old-smoke/src/object-map.lisp new-smoke/src/object-map.lisp --- old-smoke/src/object-map.lisp 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/src/object-map.lisp 2014-10-30 08:09:01.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*)) diff -rN -u old-smoke/src/smoke-c/CMakeLists.txt new-smoke/src/smoke-c/CMakeLists.txt --- old-smoke/src/smoke-c/CMakeLists.txt 2014-10-30 08:09:01.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) 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-30 08:09:01.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 - -#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); -} - -/** 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); -} -} // namespace cl_smoke - -#endif // CL_SMOKE_H 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-30 08:09:01.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)) 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-30 08:09:01.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 -#include - -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(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 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-30 08:09:01.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 - -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 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-30 08:09:01.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)) diff -rN -u old-smoke/src/smoke-c/smoke-c-util.cpp new-smoke/src/smoke-c/smoke-c-util.cpp --- old-smoke/src/smoke-c/smoke-c-util.cpp 2014-10-30 08:09:01.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" 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-30 08:09:01.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 - -#include - -/** @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), - reinterpret_cast(destruct), - reinterpret_cast(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" 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-30 08:09:01.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)) diff -rN -u old-smoke/src/smoke-c/stack.lisp new-smoke/src/smoke-c/stack.lisp --- old-smoke/src/smoke-c/stack.lisp 2014-10-30 08:09:01.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.") 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-30 08:09:01.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)) diff -rN -u old-smoke/src/smoke-to-clos.lisp new-smoke/src/smoke-to-clos.lisp --- old-smoke/src/smoke-to-clos.lisp 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/src/smoke-to-clos.lisp 2014-10-30 08:09:01.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) diff -rN -u old-smoke/src/smoke.lisp new-smoke/src/smoke.lisp --- old-smoke/src/smoke.lisp 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/src/smoke.lisp 2014-10-30 08:09:01.000000000 +0100 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2009 Tobias Rautenkranz +;;; Copyright (C) 2009, 2010 Tobias Rautenkranz ;;; ;;; 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)) diff -rN -u old-smoke/test-bundle.sh new-smoke/test-bundle.sh --- old-smoke/test-bundle.sh 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/test-bundle.sh 2014-10-30 08:09:01.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 diff -rN -u old-smoke/test.lisp new-smoke/test.lisp --- old-smoke/test.lisp 2014-10-30 08:09:01.000000000 +0100 +++ new-smoke/test.lisp 2014-10-30 08:09:01.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)