Changeset 14203

Timestamp:

Aug 21, 2010, 3:40:40 AM (14 years ago)

Author:

Gary Byers

Message:

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.

Location:

trunk/source/objc-bridge

Files:

• objc-package.lisp (modified) (1 diff)
• objc-runtime.lisp (modified) (3 diffs)
• objc-support.lisp (modified) (1 diff)

trunk/source/objc-bridge/objc-package.lisp

@@ -45 +45 @@
            "OBJC-MESSAGE-SEND-SUPER" "OBJC-MESSAGE-SEND-SUPER-STRET"
            "LOAD-FRAMEWORK" "*OBJC-DESCRIPTION-MAX-LENGTH*"
+           "REMOVE-LISP-SLOTS"
            ))
 

trunk/source/objc-bridge/objc-runtime.lisp

@@ -2470 +2470 @@
     (#___objc_exec_class m)))
 
+
 #+(or apple-objc-2.0 cocotron-objc)
 (defun %add-objc-class (class)
@@ -2753 +2754 @@
 
 
+
+
+
+                                  
+                   
+                                
 
 
@@ -3083 +3090 @@
   #+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)

trunk/source/objc-bridge/objc-support.lisp

@@ -168 +168 @@
                      (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)