[Openmcl-cvs-notifications] r12207 - /trunk/source/objc-bridge/objc-support.lisp

[gb at clozure.com]

Author: gb
Date: Sat Jun  6 02:16:24 2009
New Revision: 12207

Log:
Try to deal better with instances of toll-free-bridged classes and
with instances that aren't heap-allocated in initialized-nsobject-p.

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

Modified: trunk/source/objc-bridge/objc-support.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/objc-bridge/objc-support.lisp (original)
+++ trunk/source/objc-bridge/objc-support.lisp Sat Jun  6 02:16:24 2009
@@ -384,18 +384,22 @@
 =

 (defparameter *objc-description-max-length* 1024 "Limit on the length of N=
SObject description strings if non-NIL.")
 =

+(defun %cf-instance-p (instance)
+  (> (objc-message-send instance "_cfTypeID" #>CFTypeID) 1))
 =

 (defun initialized-nsobject-p (nsobject)
   (or (objc-class-p nsobject)
       (objc-metaclass-p nsobject)
-      (let* ((class (#/class nsobject))
-             (isize (%objc-class-instance-size class)))
-        (declare (fixnum isize))
-        (do* ((i (record-length :id) (1+ i)))
-             ((=3D i isize))
-          (declare (fixnum i))
-          (unless (zerop (the (unsigned-byte 8) (%get-unsigned-byte nsobje=
ct i)))
-            (return t))))))
+      (let* ((cf-p (%cf-instance-p nsobject)) =

+             (isize (if cf-p (#_malloc_size nsobject) (%objc-class-instanc=
e-size (#/class nsobject))))
+             (skip (if cf-p (+ (record-length :id) 4 #+64-bit-target 4) (r=
ecord-length :id))))
+        (declare (fixnum isize skip))
+        (or (> skip isize)
+            (do* ((i skip (1+ i)))
+                 ((>=3D i isize))
+              (declare (fixnum i))
+              (unless (zerop (the (unsigned-byte 8) (%get-unsigned-byte ns=
object i)))
+                (return t)))))))
   =

 (defun nsobject-description (nsobject)
   "Returns a lisp string that describes nsobject.  Note that some