Changeset 6610

Timestamp:

May 25, 2007, 5:10:12 AM (18 years ago)

Author:

Gary Byers

Message:

ALLOCATE-INSTANCE: don't make a slot-vector if #/init method made one.

File:

• branches/ide-1.0/ccl/examples/objc-clos.lisp (modified) (2 diffs)

branches/ide-1.0/ccl/examples/objc-clos.lisp

@@ -185 +185 @@
                                     ; 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))))
+                                           (slot-vector (create-foreign-instance-slot-vector (class-of p))))
                                       (when slot-vector
                                         (setf (slot-vector.instance slot-vector) raw-ptr)
@@ -748 +747 @@
             (send-objc-init-message (allocate-objc-object class) ks vs))))
     (unless (%null-ptr-p instance)
-      (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)))))
+      (or (gethash instance *objc-object-slot-vectors*)
+          (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))))))
     instance))