[Openmcl-cvs-notifications] r14203 - in /trunk/source/objc-bridge: objc-package.lisp objc-runtime.lisp objc-support.lisp

[gb at clozure.com]

Author: gb
Date: Sat Aug 21 05:40:40 2010
New Revision: 14203

Log:
Don't canonicalize objc instances.  (That was once intended to help
with retain/release, but it wasn't viable.)

Don't try to override -[NSObject dealloc]; that indeed seemed to
cause problems with (lisp and foreign) thread termination.

Define and export OBJC:REMOVE-LISP-SLOTS.  Ensure that ObjC classes
that introduce lisp slots have an automatically generated #/dealloc
method that removes lisp slot vectors from the hash table that
maintains them.  (Classes can and sometimes should override this
method; user-defined #/dealloc methods should call OBJC:REMOVE-LISP-SLOTS
as well as calling the next method, after doing other class-specific
cleanup.

Modified:
    trunk/source/objc-bridge/objc-package.lisp
    trunk/source/objc-bridge/objc-runtime.lisp
    trunk/source/objc-bridge/objc-support.lisp

Modified: trunk/source/objc-bridge/objc-package.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/objc-bridge/objc-package.lisp (original)
+++ trunk/source/objc-bridge/objc-package.lisp Sat Aug 21 05:40:40 2010
@@ -44,6 +44,7 @@
            "OBJC-MESSAGE-SEND" "OBJC-MESSAGE-SEND-STRET"
            "OBJC-MESSAGE-SEND-SUPER" "OBJC-MESSAGE-SEND-SUPER-STRET"
            "LOAD-FRAMEWORK" "*OBJC-DESCRIPTION-MAX-LENGTH*"
+           "REMOVE-LISP-SLOTS"
            ))
 =

 =


Modified: trunk/source/objc-bridge/objc-runtime.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/objc-bridge/objc-runtime.lisp (original)
+++ trunk/source/objc-bridge/objc-runtime.lisp Sat Aug 21 05:40:40 2010
@@ -2468,6 +2468,7 @@
 	  (pref class :objc_class.info) (logior #$_CLS_RESOLV (pref class :objc_c=
lass.info)))
     (#___objc_exec_class m)))
 =

+
 #+(or apple-objc-2.0 cocotron-objc)
 (defun %add-objc-class (class)
   (#_objc_registerClassPair class))
@@ -2751,6 +2752,12 @@
     =

 =

 =

+
+
+
+                                  =

+                   =

+                                =

 =

 =

 ;;; If any of the argspecs denote a value of type :<BOOL>, push an
@@ -3081,7 +3088,7 @@
   #+(or apple-objc cocotron-objc) (#_method_getNumberOfArguments m)
   #+gnu-objc (#_method_get_number_of_arguments m))
 =

-#+(or apple-objc cocotron-objc)
+#+(and bad-idea (or apple-objc cocotron-objc))
 (progn
 (defloadvar *original-deallocate-hook* nil)
 =


Modified: trunk/source/objc-bridge/objc-support.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/objc-bridge/objc-support.lisp (original)
+++ trunk/source/objc-bridge/objc-support.lisp Sat Aug 21 05:40:40 2010
@@ -167,7 +167,27 @@
              (format s "Objective-C runtime exception: ~&~a"
                      (nsobject-description (ns-exception c))))))
 =

-
+(defun ensure-dealloc-method-for-class (class)
+  (let* ((direct-slots (class-direct-slots class))
+         (effective-slots (class-slots class)))
+    (when (and (dolist (d direct-slots)
+                 (when (and (typep d 'standard-direct-slot-definition)
+                            (eq :instance (slot-definition-allocation d)))
+                   (return t)))
+               (dolist (e effective-slots t)
+                 (when (and (typep e 'standard-effective-slot-definition)
+                            (eq :instance (slot-definition-allocation e))
+                            (not (find (slot-definition-name e)
+                                       direct-slots
+                                         :key #'slot-definition-name
+                                         :test #'eq)))
+                   (return))))
+      (eval `(objc:defmethod (#/dealloc :void) ((self ,(class-name class)))
+              (objc:remove-lisp-slots self)
+              (call-next-method))))))
+
+(eval-when (:compile-toplevel :execute)
+  (declaim (ftype (function (&rest t) t) objc-callback-error-return)))
 =

 (defclass ns-lisp-exception (ns::ns-exception)
     ((condition :initarg :condition :initform nil :reader ns-lisp-exceptio=
n-condition))