Changeset 14202


Ignore:
Timestamp:
Aug 21, 2010, 10:40:26 AM (9 years ago)
Author:
gb
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/objc-bridge/objc-clos.lisp

    r13067 r14202  
    2222;;;  - Variable arity ObjC methods
    2323;;;  - Pass-by-ref structures need to keep track of IN, OUT, IN/OUT info
     24
    2425;;;  - Need to canonicalize and retain every returned :ID
    2526;;;  - Support :BEFORE, :AFTER and :AROUND for ObjC methods
     
    7273
    7374(defvar *objc-object-slot-vectors* (make-hash-table :test #'eql))
    74 (defvar *objc-canonical-instances* (make-hash-table :test #'eql :weak :value))
    75 
    76 (defun raw-macptr-for-instance (instance)
    77   (let* ((p (%null-ptr)))
    78     (%set-macptr-domain p 1)            ; not an ObjC object, but EQL to one
    79     (%setf-macptr p instance)
    80     p))
    81 
    82 (defun register-canonical-objc-instance (instance raw-ptr)
    83   ;(terminate-when-unreachable instance)
    84   ;(retain-objc-instance instance)
    85   (setf (gethash raw-ptr *objc-canonical-instances*) instance))
    86 
    87 (defun canonicalize-objc-instance (instance)
    88   (or (gethash instance *objc-canonical-instances*)
    89       (register-canonical-objc-instance
    90        (setq instance (%inc-ptr instance 0))
    91        (raw-macptr-for-instance instance))))
     75
    9276
    9377
     
    153137  (remhash p *objc-object-slot-vectors*))
    154138
     139(defun objc:remove-lisp-slots (p)
     140  (%remove-lisp-slot-vector p))
     141
    155142(defun %objc-domain-slots-vector (p)
    156143       (let* ((type (%macptr-type p))
     
    161148          (#.objc-flag-instance (or (gethash p *objc-object-slot-vectors*)
    162149                                    ; try to allocate the slot vector on demand
    163                                     (let* ((raw-ptr (raw-macptr-for-instance p))
    164                                            (slot-vector (create-foreign-instance-slot-vector (class-of p))))
     150                                    (let* ((slot-vector (create-foreign-instance-slot-vector (class-of p))))
    165151                                      (when slot-vector
    166                                         (setf (slot-vector.instance slot-vector) raw-ptr)
    167                                         (setf (gethash raw-ptr *objc-object-slot-vectors*) slot-vector)
    168                                         (register-canonical-objc-instance p raw-ptr)
     152                                        (setf (slot-vector.instance slot-vector) p)
     153                                        (setf (gethash p *objc-object-slot-vectors*) slot-vector)
    169154                                        (initialize-instance p))
    170155                                      slot-vector)
     
    775760          (let* ((slot-vector (create-foreign-instance-slot-vector class)))
    776761            (when slot-vector
    777               (let* ((raw-ptr (raw-macptr-for-instance instance)))
    778                 (setf (slot-vector.instance slot-vector) raw-ptr)
    779                 (setf (gethash raw-ptr *objc-object-slot-vectors*) slot-vector)
    780                 (register-canonical-objc-instance instance raw-ptr))))))
     762              (setf (slot-vector.instance slot-vector) instance)
     763              (setf (gethash instance *objc-object-slot-vectors*) slot-vector)))))
    781764    instance))
    782765
     
    790773  (apply #'shared-initialize instance nil initargs))
    791774
    792 (defmethod initialize-instance :after ((class objc:objc-class) &rest initargs)
    793   (declare (ignore initargs))
     775(defmethod initialize-instance :after ((class objc:objc-class) &key name &allow-other-keys)
    794776  (unless (slot-value class 'foreign)
    795777    #-(or apple-objc-2.0 cocotron-objc)
     
    798780      (%add-objc-class class ivars instance-size))
    799781    #+(or apple-objc-2.0 cocotron-objc)
    800     (%add-objc-class class)))
     782    (%add-objc-class class)
     783    (setf (find-class name) class)
     784    (ensure-dealloc-method-for-class class)))
    801785
    802786(defmethod shared-initialize ((instance objc:objc-object) slot-names
     
    871855        (progn
    872856          (apply #'reinitialize-instance class initargs)
    873           (setf (find-class name) class))
     857          (setf (find-class name) class)
     858          (ensure-dealloc-method-for-class class)
     859          class)
    874860        (error "Can't change metaclass of ~s to ~s." class metaclass)))))
    875861
Note: See TracChangeset for help on using the changeset viewer.