Changeset 14202

Timestamp:

Aug 21, 2010, 3:40:26 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.

File:

• trunk/source/objc-bridge/objc-clos.lisp (modified) (8 diffs)

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

@@ -22 +22 @@
 ;;;  - Variable arity ObjC methods
 ;;;  - Pass-by-ref structures need to keep track of IN, OUT, IN/OUT info
+
 ;;;  - Need to canonicalize and retain every returned :ID
 ;;;  - Support :BEFORE, :AFTER and :AROUND for ObjC methods
@@ -72 +73 @@
 
 (defvar *objc-object-slot-vectors* (make-hash-table :test #'eql))
-(defvar *objc-canonical-instances* (make-hash-table :test #'eql :weak :value))
-
-(defun raw-macptr-for-instance (instance)
-  (let* ((p (%null-ptr)))
-    (%set-macptr-domain p 1)            ; not an ObjC object, but EQL to one
-    (%setf-macptr p instance)
-    p))
-
-(defun register-canonical-objc-instance (instance raw-ptr)
-  ;(terminate-when-unreachable instance)
-  ;(retain-objc-instance instance)
-  (setf (gethash raw-ptr *objc-canonical-instances*) instance))
-
-(defun canonicalize-objc-instance (instance)
-  (or (gethash instance *objc-canonical-instances*)
-      (register-canonical-objc-instance
-       (setq instance (%inc-ptr instance 0))
-       (raw-macptr-for-instance instance))))
+
 
 
@@ -153 +137 @@
   (remhash p *objc-object-slot-vectors*))
 
+(defun objc:remove-lisp-slots (p)
+  (%remove-lisp-slot-vector p))
+
 (defun %objc-domain-slots-vector (p)
        (let* ((type (%macptr-type p))
@@ -161 +148 @@
           (#.objc-flag-instance (or (gethash p *objc-object-slot-vectors*)
                                     ; try to allocate the slot vector on demand
-                                    (let* ((raw-ptr (raw-macptr-for-instance p))
-                                           (slot-vector (create-foreign-instance-slot-vector (class-of p))))
+                                    (let* ((slot-vector (create-foreign-instance-slot-vector (class-of p))))
                                       (when slot-vector
-                                        (setf (slot-vector.instance slot-vector) raw-ptr)
-                                        (setf (gethash raw-ptr *objc-object-slot-vectors*) slot-vector)
-                                        (register-canonical-objc-instance p raw-ptr)
+                                        (setf (slot-vector.instance slot-vector) p)
+                                        (setf (gethash p *objc-object-slot-vectors*) slot-vector)
                                         (initialize-instance p))
                                       slot-vector)
@@ -775 +760 @@
           (let* ((slot-vector (create-foreign-instance-slot-vector class)))
             (when slot-vector
-              (let* ((raw-ptr (raw-macptr-for-instance instance)))
-                (setf (slot-vector.instance slot-vector) raw-ptr)
-                (setf (gethash raw-ptr *objc-object-slot-vectors*) slot-vector)
-                (register-canonical-objc-instance instance raw-ptr))))))
+              (setf (slot-vector.instance slot-vector) instance)
+              (setf (gethash instance *objc-object-slot-vectors*) slot-vector)))))
     instance))
 
@@ -790 +773 @@
   (apply #'shared-initialize instance nil initargs))
 
-(defmethod initialize-instance :after ((class objc:objc-class) &rest initargs)
-  (declare (ignore initargs))
+(defmethod initialize-instance :after ((class objc:objc-class) &key name &allow-other-keys)
   (unless (slot-value class 'foreign)
     #-(or apple-objc-2.0 cocotron-objc)
@@ -798 +780 @@
       (%add-objc-class class ivars instance-size))
     #+(or apple-objc-2.0 cocotron-objc)
-    (%add-objc-class class)))
+    (%add-objc-class class)
+    (setf (find-class name) class)
+    (ensure-dealloc-method-for-class class)))
 
 (defmethod shared-initialize ((instance objc:objc-object) slot-names 
@@ -871 +855 @@
         (progn
           (apply #'reinitialize-instance class initargs)
-          (setf (find-class name) class))
+          (setf (find-class name) class)
+          (ensure-dealloc-method-for-class class)
+          class)
         (error "Can't change metaclass of ~s to ~s." class metaclass)))))