Changeset 14289

Timestamp:

Sep 19, 2010, 10:30:51 PM (14 years ago)

Author:

Gary Byers

Message:

Use a copy of the foreign instance pointer as a key in the
*OBJC-OBJECT-SLOT-VECTORS* hash table and as the value of
slot-vector.instance.

File:

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

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

@@ -141 +141 @@
 
 (defun %objc-domain-slots-vector (p)
-       (let* ((type (%macptr-type p))
-             (flags (ldb objc-type-flags type))
-             (index (ldb objc-type-index type)))
-        (declare (fixnum type flags index))
-        (ecase flags
-          (#.objc-flag-instance (or (gethash p *objc-object-slot-vectors*)
-                                    ; try to allocate the slot vector on demand
-                                    (let* ((slot-vector (create-foreign-instance-slot-vector (class-of p))))
-                                      (when slot-vector
-                                        (setf (slot-vector.instance slot-vector) p)
-                                        (setf (gethash p *objc-object-slot-vectors*) slot-vector)
-                                        (initialize-instance p))
-                                      slot-vector)
-                                    (error "~s has no slots." p)))
-          (#.objc-flag-class (id->objc-class-slots-vector index))
-          (#.objc-flag-metaclass (id->objc-metaclass-slots-vector index)))))
+  (let* ((type (%macptr-type p))
+         (flags (ldb objc-type-flags type))
+         (index (ldb objc-type-index type)))
+    (declare (fixnum type flags index))
+    (ecase flags
+      (#.objc-flag-instance (or (gethash p *objc-object-slot-vectors*)
+                                        ; try to allocate the slot vector on demand
+                                (let* ((slot-vector (create-foreign-instance-slot-vector (class-of p))))
+                                  (when slot-vector
+                                    (let* ((copy (%inc-ptr p)))
+                                      (setf (slot-vector.instance slot-vector) copy)
+                                      (setf (gethash copy *objc-object-slot-vectors*) slot-vector))
+                                    (initialize-instance p))
+                                  slot-vector)
+                                (error "~s has no slots." p)))
+      (#.objc-flag-class (id->objc-class-slots-vector index))
+      (#.objc-flag-metaclass (id->objc-metaclass-slots-vector index)))))
 
 (defun %objc-domain-class-ordinal (p)
@@ -752 +753 @@
         (let* ((slot-vector (create-foreign-instance-slot-vector class)))
           (when slot-vector
-            (setf (slot-vector.instance slot-vector) instance)
-            (setf (gethash instance *objc-object-slot-vectors*) slot-vector)))))
+            (let* ((copy (%inc-ptr instance)))
+              (setf (slot-vector.instance slot-vector) copy)
+            (setf (gethash copy *objc-object-slot-vectors*) slot-vector))))))
   instance)