Sun Jan 17 22:04:08 CET 2010 Tobias Rautenkranz * 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). diff -rN -u old-smoke/src/class-map.lisp new-smoke/src/class-map.lisp --- old-smoke/src/class-map.lisp 2014-10-30 08:08:35.000000000 +0100 +++ new-smoke/src/class-map.lisp 2014-10-30 08:08:35.000000000 +0100 @@ -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) diff -rN -u old-smoke/src/libsmoke/class.lisp new-smoke/src/libsmoke/class.lisp --- old-smoke/src/libsmoke/class.lisp 2014-10-30 08:08:35.000000000 +0100 +++ new-smoke/src/libsmoke/class.lisp 2014-10-30 08:08:35.000000000 +0100 @@ -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 diff -rN -u old-smoke/src/libsmoke/smoke.cpp new-smoke/src/libsmoke/smoke.cpp --- old-smoke/src/libsmoke/smoke.cpp 2014-10-30 08:08:35.000000000 +0100 +++ new-smoke/src/libsmoke/smoke.cpp 2014-10-30 08:08:35.000000000 +0100 @@ -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); } diff -rN -u old-smoke/src/objects/class.lisp new-smoke/src/objects/class.lisp --- old-smoke/src/objects/class.lisp 2014-10-30 08:08:35.000000000 +0100 +++ new-smoke/src/objects/class.lisp 2014-10-30 08:08:35.000000000 +0100 @@ -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)) diff -rN -u old-smoke/src/objects/method.lisp new-smoke/src/objects/method.lisp --- old-smoke/src/objects/method.lisp 2014-10-30 08:08:35.000000000 +0100 +++ new-smoke/src/objects/method.lisp 2014-10-30 08:08:35.000000000 +0100 @@ -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) 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:08:35.000000000 +0100 +++ new-smoke/src/smoke-to-clos.lisp 2014-10-30 08:08:35.000000000 +0100 @@ -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) diff -rN -u old-smoke/src/smoke.lisp new-smoke/src/smoke.lisp --- old-smoke/src/smoke.lisp 2014-10-30 08:08:35.000000000 +0100 +++ new-smoke/src/smoke.lisp 2014-10-30 08:08:35.000000000 +0100 @@ -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: