[Openmcl-cvs-notifications] r7450 - /trunk/ccl/objc-bridge/objc-runtime.lisp

[gb at clozure.com]

Author: gb
Date: Mon Oct 15 14:43:44 2007
New Revision: 7450

Log:
When reviving ObjC classes, zero out the class/metaclass pointers of each
class if they were "dead macptrs".  We don't want to revive a pointer at
its old address, since that may accidentally conflict with some other
class's current address, causing grief and dispair and much gnashing of
teeth in GDB.

Modified:
    trunk/ccl/objc-bridge/objc-runtime.lisp

Modified: trunk/ccl/objc-bridge/objc-runtime.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/ccl/objc-bridge/objc-runtime.lisp (original)
+++ trunk/ccl/objc-bridge/objc-runtime.lisp Mon Oct 15 14:43:44 2007
@@ -601,8 +601,12 @@
       (let* ((c (id->objc-class i))
 	     (meta-id (objc-class-id->objc-metaclass-id i))
 	     (m (id->objc-metaclass meta-id)))
-	(%revive-macptr c)
-	(%revive-macptr m)
+        (unless (typep c 'macptr)
+          (%revive-macptr c)
+          (%setf-macptr c (%null-ptr)))
+        (unless (typep m 'macptr)
+          (%revive-macptr m)
+          (%setf-macptr m (%null-ptr)))
 	(unless (splay-tree-get class-map c)
 	  (%set-pointer-to-objc-class-address (objc-class-id-foreign-name i) c)
 	  ;; If the class is valid and the metaclass is still