The Trunk: Tools-mtf.286.mcz

Matthew Fulmer uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mtf.286.mcz

==================== Summary ====================

Name: Tools-mtf.286
Author: mtf
Time: 12 December 2010, 1:38:22.668 pm
UUID: 464ae603-b549-43d1-9beb-d068d046465e
Ancestors: Tools-mtf.208, Tools-laza.285

fixed pointer chaser as described in http://bugs.squeak.org/view.php?id=7158

also added a cleanUp method  to DebuggerMethodMap to clear out the debugger method cache on cleanup

=============== Diff against Tools-laza.285 ===============

Item was added:
+ ----- Method: DebuggerMethodMap class>>cleanUp (in category 'class initialization') -----
+ cleanUp
+ self initialize!

Item was changed:
  ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
  contents
  | objects |
+ objects := Utilities pointersTo: item except: (Array with: self).
+ ^(objects reject: [:ea | ea class = self class or: [ea class = PointerExplorer]])
- objects := Utilities pointersTo: item except: (Array with: self with: model).
- ^(objects reject: [:ea | ea class = self class])
  collect: [:ea| self class with: ea name: ea identityHash asString model: item]!

Item was changed:
  ----- Method: PointerFinder class>>pointersTo:except: (in category 'utilities') -----
  pointersTo: anObject except: objectsToExclude
  "Find all occurrences in the system of pointers to the argument anObject.
  Remove objects in the exclusion list from the results."
 
+ ^ anObject inboundPointersExcluding: objectsToExclude!
- | results anObj lastObj |
- Smalltalk garbageCollect.
- "big collection shouldn't grow, so it's contents array is always the same"
- results := OrderedCollection new: 1000.
-
- "allObjectsDo: is expanded inline to keep spurious
- method and block contexts out of the results"
- anObj := self someObject.
- lastObj := Object new.
- [lastObj == anObj] whileFalse: [
- anObj isInMemory ifTrue: [
- (anObj pointsTo: anObject) ifTrue: [
- "exclude the results collector and contexts in call chain"
- ((anObj ~~ results collector) and:
- [(anObj ~~ objectsToExclude) and:
- [(anObj ~~ thisContext) and:
- [(anObj ~~ thisContext sender) and:
- [anObj ~~ thisContext sender sender]]]])
- ifTrue: [ results add: anObj ].
- ]].
- anObj := anObj nextObject.
- ].
- objectsToExclude do: [ :obj | results removeAllSuchThat: [ :el | el == obj]].
-
- ^ results asArray
- !

Item was changed:
  ----- Method: PointerFinder>>followObject: (in category 'application') -----
  followObject: anObject
+ anObject outboundPointersDo: [:ea |
+ (self follow: ea from: anObject)
- (self follow: anObject class from: anObject)
- ifTrue: [^ true].
- "Remove this after switching to new CompiledMethod format --bf 2/12/2006"
- anObject isCompiledMethod ifTrue: [
- 1 to: anObject numLiterals do:
- [:i |
- (self follow: (anObject literalAt: i) from: anObject)
- ifTrue: [^ true]].
- ^false].
- 1 to: anObject class instSize do:
- [:i |
- (self follow: (anObject instVarAt: i) from: anObject)
  ifTrue: [^ true]].
- 1 to: anObject basicSize do:
- [:i |
- (self follow: (anObject basicAt: i) from: anObject)
- ifTrue: [^ true]].
  ^ false!