"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

'From Smalltalk/X, Version:2.10.3 on 30-sep-1994 at 11:13:14'!

StandardSystemView subclass:#MemoryUsageView
	 instanceVariableNames:'info list sortBlock'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Interface-Tools'
!

MemoryUsageView comment:'
 COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved
'!

!MemoryUsageView class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libtool/Attic/MemUsageV.st,v 1.4 1994-11-17 14:46:57 claus Exp $
"
!

documentation
"
    this view shows an overview over the memory usage of the system.
    usage:
	MemoryUsageView new open

    Since scanning all memory takes some time, this is not done
    automatically, but upon request. See the middlebuttonmenu-'update'
    function.
"
! !

!MemoryUsageView methodsFor:'menu actions'!

sortByClass
    self label:'Memory usage; by class'.
    sortBlock := [:a :b | (a at:1) name < (b at:1) name].
    self updateDisplay
!

sortByInstCount
    self label:'Memory usage; by instance count'.
    sortBlock := [:a :b | (a at:2) > (b at:2) ].
    self updateDisplay
!

sortByMemoryUsage
    self label:'Memory usage; by memory usage'.
    sortBlock := [:a :b | (a at:3) > (b at:3)].
    self updateDisplay
!

inspectInstances
    |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:[
		    |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
		]
	    ]
	]
    ]
!

update
    self updateInfo.
    self updateDisplay
! !

!MemoryUsageView methodsFor:'realization'!

realize
    super realize.
    self updateInfo.
    self sortByClass.
! !

!MemoryUsageView methodsFor:'private'!

updateDisplay
    "update the displayed list"

    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.
	    cls == Class ifTrue:[
		'<all classes>'
	    ] ifFalse:[
		cls == Metaclass ifTrue:[
		    '<all metaclasses>'
		] ifFalse:[
		    cls displayString "/name
		] 
	    ] 
	].

	counts := rawData collect:[:i | (i at:2) ].
	sumSizes := rawData collect:[:i | (i at:3) ].
	allMemory := ObjectMemory bytesUsed.
	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).
	    l add:line
	].

	"add summary line"
	overAllCount := counts inject:0 into:[:sum :this | sum + this].
	overAllAvgSize := ((allMemory / overAllCount) * 10) rounded / 10.0.

	l add:''.
	line := 'all objects' printStringPaddedTo:30 with:Character space.
	line := line , (overAllCount printStringLeftPaddedTo:10).
	line := line , (overAllAvgSize printStringLeftPaddedTo:10).
	line := line , (allMemory printStringLeftPaddedTo:10).
	line := line , (100.0 printStringLeftPaddedTo:7).
	l add:line.

	list list:l.
    ]
!

updateInfo
    "scan all memory and collect the information"

    windowGroup withCursor:Cursor questionMark do:[
	|myProcess myPriority|

	"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|

		o isBehavior ifTrue:[
		    o isMeta ifTrue:[
			class := Metaclass
		    ] ifFalse:[
			class := Class
		    ]
		] ifFalse:[
		    class := o class.
		].
		i := info at:class ifAbsent:[].
		i isNil ifTrue:[
		    i := Array with:class with:1 with:(ObjectMemory sizeOf:o).
		    info at:class put:i.
		] ifFalse:[
		    i at:2 put:((i at:2) + 1).
		    i at:3 put:((i at:3) + (ObjectMemory sizeOf:o))
		]
	    ].
	] valueNowOrOnUnwindDo:[
	    myProcess priority:myPriority.
	].
    ]
! !

!MemoryUsageView methodsFor:'initialization'!

initialize
    |l helpView headLine|

    super initialize.
    self label:'Memory usage'.

    headLine := ' class                           # of insts  avg sz     bytes   %mem '.

    l := Label in:self.
    l origin:(0.0 @ 0.0) corner:(1.0 @ l height).
    l borderWidth:0.
    l label:headLine.
    l adjust:#left.

    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.

    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 open
    "
! !