hg/stx-libtool: comparison MemoryUsageView.st

equal deleted inserted replaced

-:57c1ccc3d7e0
+:7b48409ae088
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libtool/MemoryUsageView.st,v 1.3 1994-10-28 03:30:32 claus Exp $
+$Header: /cvs/stx/stx/libtool/MemoryUsageView.st,v 1.4 1994-11-17 14:46:57 claus Exp $
 "
 !
 documentation
 "
 	 special kludge
 	"
 	(className startsWith:'<') ifFalse:[
 	    (className startsWith:'all') ifFalse:[
 		class := Smalltalk at:className asSymbol.
-		class allInstances inspect
+		self withCursor:(Cursor questionMark) do:[
+		    |insts|
+		    insts := class allInstances.
+		    insts size > 500 ifTrue:[
+			(self confirm:'there are ' , insts size printString , ' instances.\\Do you really want to see them all ?' withCRs)
+			ifFalse:[^ self]
+		    ].
+		    insts inspect
+		]
+	    ]
+	]
+]
+!
+inspectOwners
+|line className class|
+line := list selectionValue.
+(line notNil and:[line notEmpty]) ifTrue:[
+	className := line asCollectionOfWords first.
+	"
+	 special kludge
+	"
+	(className startsWith:'<') ifFalse:[
+	    (className startsWith:'all') ifFalse:[
+		class := Smalltalk at:className asSymbol.
+		self withCursor:(Cursor questionMark) do:[
+		    |owners dict|
+		    owners := (ObjectMemory whoReferencesInstancesOf:class).
+		    owners isNil ifTrue:[
+			self information:'no owners found - next GC should remove it'.
+			^ self
+		    ].
+		    owners := owners asOrderedCollection.
+		    owners size > 500 ifTrue:[
+			(self confirm:'there are ' , owners size printString , ' owners.\\Do you really want to see them all ?' withCRs)
+			ifFalse:[^ self]
+		    ].
+		    dict := IdentityDictionary new.
+		    owners do:[:owner |
+			|set names oClass s|
+			"
+			 skip weakArrays ... (they dont count)
+			"
+			(owner isMemberOf:WeakArray) ifFalse:[
+			    set := Set new.
+			    names := owner class allInstVarNames.
+			    oClass := owner class.
+			    1 to:oClass instSize do:[:i |
+				((owner instVarAt:i) isMemberOf:class) ifTrue:[
+				    set add:(names at:i).
+				].
+			    ].
+			    oClass isVariable ifTrue:[
+				oClass isPointers ifTrue:[
+				    1 to:owner basicSize do:[:i |
+					((owner basicAt:i) isMemberOf:class) ifTrue:[
+					    set add:i
+					]
+				    ]
+				]
+			    ].
+			    "
+			     put a describing string into the dictionary
+			    "
+			    s := 'references in: '.
+			    set do:[:name |
+					name isString ifTrue:[
+					    s := s , name , ' '
+					] ifFalse:[
+					    s := s , '[' , name printString , '] '
+					]
+				   ].
+			    dict at:owner put:s.
+"/                            dict at:owner put:set
+			]
+		    ].
+		    dict inspect
+		]
 	    ]
 	]
 ]
 !
 !MemoryUsageView methodsFor:'private'!
 updateDisplay
 "update the displayed list"
-|classNames counts sumSizes percents avgSizes rawData l line allMemory overAllCount overAllAvgSize|
 windowGroup withCursor:Cursor wait do:[
+	|classNames counts sumSizes percents avgSizes rawData
+	 l line allMemory overAllCount overAllAvgSize|
 	rawData := info asSortedCollection:sortBlock.
 "/        "this avoids getting a sorted collection in the collect: below"
 "/        rawData := rawData asArray.
+"/ collect: has been fixed ...
 	classNames := rawData collect:[:i |
 	    |cls|
 	    cls := i at:1.
 	].
 	counts := rawData collect:[:i | (i at:2) ].
 	sumSizes := rawData collect:[:i | (i at:3) ].
 	allMemory := ObjectMemory bytesUsed.
-	percents := sumSizes collect:[:sz | (sz / allMemory * 100 * 10) rounded / 10.0].
+	percents := sumSizes collect:[:sz | (sz asFloat / allMemory * 1000) rounded / 10.0].
 	avgSizes := (1 to:sumSizes size) collect:[:i | (((sumSizes at:i) / (counts at:i)) * 10) rounded / 10.0].
 	l := OrderedCollection new.
 	1 to:classNames size do:[:i |
+	    |line|
 	    line := (classNames at:i) printStringPaddedTo:30 with:Character space.
 	    line := line , ((counts at:i) printStringLeftPaddedTo:10).
 	    line := line , ((avgSizes at:i) printStringLeftPaddedTo:10).
 	    line := line , ((sumSizes at:i) printStringLeftPaddedTo:10).
 	    line := line , ((percents at:i) printStringLeftPaddedTo:7).
 !
 updateInfo
 "scan all memory and collect the information"
-|myProcess myPriority|
 windowGroup withCursor:Cursor questionMark do:[
+	|myProcess myPriority|
-	info := IdentityDictionary new:600.
 	"find all objects, collect stuff in info"
 	"
 	 this is a time consuming operation; therefore lower my priority ...
 	"
 	myProcess := Processor activeProcess.
 	myPriority := myProcess priority.
 	myProcess priority:(Processor userBackgroundPriority).
+	info := IdentityDictionary new:600.
 	[
 	    ObjectMemory allObjectsDo:[:o |
 		|i class|
 			class := Class
 		    ]
 		] ifFalse:[
 		    class := o class.
 		].
-		(info includesKey:class) ifFalse:[
+		i := info at:class ifAbsent:[].
-		    info at:class put:(Array with:class
+		i isNil ifTrue:[
-					     with:1
+		    i := Array with:class with:1 with:(ObjectMemory sizeOf:o).
-					     with:(ObjectMemory sizeOf:o))
+		    info at:class put:i.
-		] ifTrue:[
+		] ifFalse:[
-		    i := info at:class.
 		    i at:2 put:((i at:2) + 1).
 		    i at:3 put:((i at:3) + (ObjectMemory sizeOf:o))
 		]
 	    ].
 	] valueNowOrOnUnwindDo:[
 self extent:((font widthOf:headLine) + (device horizontalPixelPerMillimeter * 15) rounded) @ self height.
 helpView := ScrollableView for:SelectionInListView in:self.
 helpView origin:(0.0 @ l height) corner:1.0 @ 1.0.
-l origin:(helpView scrollBar width @ 0.0).
 list := helpView scrolledView.
+l origin:(list originRelativeTo:self) x @ 0.0.
 list font:(self font).
+l font:(self font).
 list middleButtonMenu:(PopUpMenu
 				labels:(
 					resources array:#(
 					    'sort by class'
 					    'sort by inst count'
 					    'sort by memory usage'
 					    '-'
 					    'inspect instances'
+					    'owners'
 					    '-'
 					    'update'
 					))
 			     selectors:#(sortByClass
 					 sortByInstCount
 					 sortByMemoryUsage
 					 nil
 					 inspectInstances
+					 inspectOwners
 					 nil
 					 update
 					)
 				receiver:self
 				     for:list).
-"MemoryUsageView start"
+"
-! !
+MemoryUsageView open
+"
+! !

changeset 52	7b48409ae088
parent 49	6fe62433cfa3
child 57	36e13831b62d