Object.st
changeset 16408 e8076fc8d337
parent 16401 ae4c51e826cb
child 16470 94bfe026a2cc
--- a/Object.st	Wed May 07 16:33:06 2014 +0200
+++ b/Object.st	Thu May 08 02:29:50 2014 +0200
@@ -492,7 +492,6 @@
     InfoPrinting := aBoolean
 ! !
 
-
 !Object class methodsFor:'queries'!
 
 isAbstract
@@ -515,8 +514,6 @@
 ! !
 
 
-
-
 !Object methodsFor:'Compatibility-Dolphin'!
 
 stbFixup: anSTBInFiler at: newObjectIndex
@@ -678,7 +675,6 @@
     "
 ! !
 
-
 !Object methodsFor:'accessing'!
 
 _at:index
@@ -1708,7 +1704,6 @@
     "
 ! !
 
-
 !Object methodsFor:'attributes access'!
 
 objectAttributeAt:attributeKey
@@ -1832,7 +1827,6 @@
 ! !
 
 
-
 !Object methodsFor:'change & update'!
 
 broadcast:aSelectorSymbol
@@ -2013,7 +2007,6 @@
     ^ aBlock ensure:[ self addDependent:someone ]
 ! !
 
-
 !Object methodsFor:'comparing'!
 
 = anObject
@@ -5148,7 +5141,7 @@
      will be a few more chances (and more interrupts) before the VM
      terminates the process."
 
-    |con remaining sender nSkipped|
+    |con remaining sender nSkipped caller level n|
 
     (con := thisContext) isRecursive ifFalse:[
 "/        Processor activeProcess usedStackSize < Processor activeProcess maximumStackSize ifTrue:[
@@ -5156,31 +5149,39 @@
 "/            'Stray recursionInterrupt ...' infoPrintCR.
 "/            ^ self
 "/        ].
-	ObjectMemory infoPrinting ifTrue:[
-	    'Object [info]: recursionInterrupt from:' printCR.
-	    con := con sender.
-	    remaining := 50.
-	    [con notNil and:[remaining > 0]] whileTrue:[
-		sender := con sender.
-		'| ' print. con fullPrint.
-
-		nSkipped := 0.
-		[sender notNil and:[sender sender notNil
-		and:[sender selector == con selector
-		and:[sender sender selector == con selector
-		and:[sender method == con method]]]]] whileTrue:[
-		    nSkipped := nSkipped + 1.
-		    con := sender.
-		    sender := con sender.
-		].
-		nSkipped > 0 ifTrue:[
-		    '| ... ***** ' print. nSkipped print. ' recursive contexts skipped *****' printCR.
-		].
-		con := sender.
-		remaining := remaining - 1
-	    ].
-	].
-	^ RecursionInterruptSignal raiseSignal
+        ObjectMemory infoPrinting ifTrue:[
+            level := 0.
+            caller := thisContext sender.
+            [caller notNil] whileTrue:[
+                level := level + 1.
+                caller := caller sender.
+            ].
+
+            'Object [info]: recursionInterrupt from:' printCR.
+            con := con sender.
+            remaining := 500.
+            n := 0.
+            [con notNil and:[remaining > 0]] whileTrue:[
+                sender := con sender.
+                '| ' print. con fullPrint.
+
+                nSkipped := 0.
+                [sender notNil and:[sender sender notNil
+                and:[sender selector == con selector
+                and:[sender sender selector == con selector
+                and:[sender method == con method]]]]] whileTrue:[
+                    nSkipped := nSkipped + 1.
+                    con := sender.
+                    sender := con sender.
+                ].
+                nSkipped > 0 ifTrue:[
+                    '| ... ***** ' print. nSkipped print. ' recursive contexts skipped *****' printCR.
+                ].
+                con := sender.
+                remaining := remaining - 1
+            ].
+        ].
+        ^ RecursionInterruptSignal raiseSignal
     ]
 
     "Modified: / 10.11.2001 / 15:15:56 / cg"
@@ -7800,7 +7801,6 @@
     ^ self
 ! !
 
-
 !Object methodsFor:'secure message sending'!
 
 ?: selector
@@ -8407,7 +8407,6 @@
     "
 ! !
 
-
 !Object methodsFor:'synchronized evaluation'!
 
 freeSynchronizationSemaphore
@@ -10095,16 +10094,14 @@
     ^ aVisitor visitObject:self with:aParameter
 ! !
 
-
-
 !Object class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.768 2014-05-06 20:22:12 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.769 2014-05-08 00:29:50 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.768 2014-05-06 20:22:12 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.769 2014-05-08 00:29:50 cg Exp $'
 !
 
 version_SVN