Sun Jan 17 22:04:08 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix class-map image loading and use the new static smoke methods.

indClass() and isDerivedFrom() are now static (r1076132 and also in KDE 4.4).

--- old-smoke/src/class-map.lisp 2014-10-09 13:28:48.000000000 +0200

+++ new-smoke/src/class-map.lisp 2014-10-09 13:28:48.000000000 +0200

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

(defun id-class-map (smoke)

(let ((value (gethash (pointer-address (smoke-module-pointer smoke))

*smoke-id-class-map*)))

- (assert value ()

- "Unknown smoke module ~A ~A."

- smoke (smoke-get-module-name (smoke-module-pointer smoke)))

+ (assert value () "Unknown smoke module ~A." smoke)

value))

(defun (setf id-class-map) (new-value smoke)

--- old-smoke/src/libsmoke/class.lisp 2014-10-09 13:28:48.000000000 +0200

+++ new-smoke/src/libsmoke/class.lisp 2014-10-09 13:28:49.000000000 +0200

@@ -19,7 +19,6 @@

(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

--- old-smoke/src/libsmoke/smoke.cpp 2014-10-09 13:28:48.000000000 +0200

+++ new-smoke/src/libsmoke/smoke.cpp 2014-10-09 13:28:49.000000000 +0200

@@ -130,13 +130,12 @@

/** 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)

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

{

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

+ *c = Smoke::findClass(name);

}

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

@@ -182,7 +181,7 @@

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,

+ return Smoke::isDerivedFrom(get_smoke(smoke), class_index,

get_smoke(smoke_base), base_index);

}

--- old-smoke/src/objects/class.lisp 2014-10-09 13:28:48.000000000 +0200

+++ new-smoke/src/objects/class.lisp 2014-10-09 13:28:49.000000000 +0200

@@ -61,13 +61,10 @@

(/= 0 (get-class-flag class :virtual-destructor)))

(define-condition undefined-class (cell-error)

- ((smoke-name :initarg :smoke-name

- :initform nil

- :documentation "The name of the Smoke module"))

+ ()

(:report (lambda (condition stream)

- (format stream "No Smoke class named ~S in the Smoke module ~S."

- (cell-error-name condition)

- (slot-value condition 'smoke-name))))

+ (format stream "No Smoke class named ~S."

+ (cell-error-name condition))))

(:documentation "A undefined Smoke class"))

(define-condition lisp-module-not-loaded (error)

@@ -76,15 +73,15 @@

(format stream "The Lisp smoke module of the class ~A is not loaded."

(slot-value condition 'class-name)))))

-(defun make-smoke-class (smoke name)

- "Returns the class named NAME of the smoke module SMOKE.

+(defun make-smoke-class (name)

+ "Returns the class named NAME.

Signals an undefined-class condition when there is no class for NAME."

(with-foreign-object (c 'smoke-module-index)

(do () (nil)

- (smoke-find-class c (smoke-module-pointer smoke) name)

+ (smoke-find-class c name)

(restart-case

(if (null-pointer-p (foreign-slot-value c 'smoke-module-index 'smoke))

- (error (make-condition 'undefined-class :name name :smoke-name (smoke-get-module-name (smoke-module-pointer smoke))))

+ (error (make-condition 'undefined-class :name name))

(return))

(supply (new-name)

:report "Supply a new class name"

@@ -104,7 +101,7 @@

(defun real-class (class)

"Returns the same class like CLASS, but such that EXTERNAL-P returns NIL."

(if (external-p class)

- (handler-case (make-smoke-class (smoke class) (name class))

+ (handler-case (make-smoke-class (name class))

(undefined-class () class))

class))

--- old-smoke/src/objects/method.lisp 2014-10-09 13:28:48.000000000 +0200

+++ new-smoke/src/objects/method.lisp 2014-10-09 13:28:48.000000000 +0200

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

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

(smoke-method-smoke smoke-method)))

(null-pointer-p (smoke-method-pointer smoke-method)))

- (call-next-method)

+ (print-unreadable-object (smoke-method stream :type t)

+ (princ "no method" stream))

(print-unreadable-object (smoke-method stream :type t)

(princ (method-declaration smoke-method) stream))))

@@ -136,7 +137,8 @@

"public"))

(defun modifiers (method)

- (format nil "~A~:[~; static~]" (access method) (static-p method)))

+ (format nil "~:[~;virtual ~]~A~:[~; static~]"

+ (virtual-p method) (access method) (static-p method)))

(defun return-type (method)

"Returns the return type of METHOD."

@@ -209,6 +211,10 @@

"Returns T when METHOD is internal and NIL otherwise."

(/= 0 (get-method-flag method :internal)))

+(defun virtual-p (method)

+ "Returns T when METHOD is internal and NIL otherwise."

+ (/= 0 (get-method-flag method :virtual)))

+

(defmethod get-class ((method smoke-method))

(make-smoke-class-from-id

(smoke-method-smoke method)

--- old-smoke/src/smoke-to-clos.lisp 2014-10-09 13:28:48.000000000 +0200

+++ new-smoke/src/smoke-to-clos.lisp 2014-10-09 13:28:49.000000000 +0200

@@ -165,8 +165,13 @@

(push export exports))))

`(progn (check-recompile ,smoke)

,@functions

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

+ ;; FIXME when loading the Lisp image we no longer need to

+ ;; call #'ensure-class, but the class-map needs still

+ ;; to be populated by #'add-id-class-map and #'add-id;

+ ;; For now we ignore the negligible overhead.

+ (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-09 13:28:48.000000000 +0200

+++ new-smoke/src/smoke.lisp 2014-10-09 13:28:49.000000000 +0200

@@ -52,11 +52,6 @@

(defun smoke-call (class pointer method-name &optional (args nil))

(s-call (make-smoke-method-from-name class method-name) pointer args))

-(defun static-call (smoke class-name method-name &rest args)

- (s-call (make-smoke-method-from-name (make-smoke-class smoke class-name)

- method-name)

- (null-pointer) args))

-

(defun enum-call (method)

"Return the enum value for METHOD."

;; FIXME: