"
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.
"
"{ Package: 'stx:libtool' }"
StandardSystemView subclass:#MemoryUsageView
instanceVariableNames:'rawInfo info list sortBlock titleLabel'
classVariableNames:''
poolDictionaries:''
category:'Monitors-ST/X'
!
!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.
"
!
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 class methodsFor:'startup'!
isVisualStartable
^ true
"Created: / 10.8.1998 / 16:02:59 / cg"
! !
!MemoryUsageView methodsFor:'initialization'!
initialize
|helpView headLine|
super initialize.
self label:'Memory Usage'.
headLine := ' Class' paddedTo:50 with:Character space.
headLine := headLine , '# of Insts Avg sz Max sz Bytes %Mem %Accum.'.
titleLabel := Label in:self.
titleLabel origin:(0.0 @ 0.0) corner:(1.0 @ titleLabel height).
titleLabel borderWidth:0.
titleLabel label:headLine.
titleLabel adjust:#left.
self extent:((font widthOf:headLine) + (device horizontalPixelPerMillimeter * 15) rounded) @ self height.
helpView := ScrollableView for:SelectionInListView in:self.
helpView origin:(0.0 @ titleLabel height) corner:1.0 @ 1.0.
list := helpView scrolledView.
titleLabel origin:(list originRelativeTo:self) x @ 0.0.
list font:(EditTextView defaultFont).
titleLabel font:(EditTextView defaultFont).
list menuHolder:self; menuPerformer:self; menuMessage:#usageMenu.
"
MemoryUsageView open
"
"Modified: 14.10.1997 / 21:30:23 / cg"
! !
!MemoryUsageView methodsFor:'menu actions'!
collectGarbageAndUpdate
self withWaitCursorDo:[
ObjectMemory tenure.
ObjectMemory compressingGarbageCollect.
].
self update.
"Created: 14.10.1997 / 21:36:38 / cg"
"Modified: 14.10.1997 / 21:41:11 / cg"
!
displayGlobalRefChainsToInsts
|class|
list selection notNil ifTrue:[
class := (info at:(list selection)) at:1.
self withCursor:(Cursor questionMark) do:[
|insts|
"
special kludge
"
class isSymbol ifTrue:[
class == #NameSpace ifFalse:[
self information:'classes are directly refered to by Smalltalk'.
^ self.
].
class := (Smalltalk at:class) class.
insts := class allSubInstances.
insts remove:class soleInstance ifAbsent:nil
] ifFalse:[
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 confirm:'Show ref-path to some instances only ?' withCRs)
ifFalse:[
^ self
].
insts := (insts asArray copyTo:100)
]
].
insts := insts asArray.
ObjectMemory displayRefChainToAny:insts
]
]
"Modified: / 15.10.1996 / 22:09:29 / cg"
"Created: / 3.2.1998 / 00:03:22 / cg"
!
inspectInstances
|class|
list selection notNil ifTrue:[
class := (info at:(list selection)) at:1.
self withCursor:(Cursor questionMark) do:[
|insts|
"
special kludge
"
class isSymbol ifTrue:[
class == #NameSpace ifFalse:[
^ UserPreferences current systemBrowserClass open
].
class := (Smalltalk at:class) class.
insts := class allSubInstances.
insts remove:class soleInstance ifAbsent:nil
] ifFalse:[
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
]
]
"Modified: 15.10.1996 / 22:09:29 / cg"
!
inspectInstancesWithSearch
|filter filterBlock class|
filter := '[:inst | "<some condition for inst>" ]'.
[filterBlock isNil] whileTrue:[
filter := Dialog request:'filter block:' initialAnswer:filter.
filter size == 0 ifTrue:[^ self].
filterBlock := Compiler evaluate:filter.
filterBlock isBlock ifFalse:[
self information:'bad syntax in block'.
filterBlock := nil.
].
].
list selection notNil ifTrue:[
class := (info at:(list selection)) at:1.
self withCursor:(Cursor questionMark) do:[
|insts|
"
special kludge
"
class isSymbol ifTrue:[
class == #NameSpace ifFalse:[
^ UserPreferences current systemBrowserClass open
].
class := (Smalltalk at:class) class.
insts := class allSubInstances.
insts remove:class soleInstance ifAbsent:nil
] ifFalse:[
insts := class allInstances.
].
insts := insts select:filterBlock.
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
]
]
"Modified: 15.10.1996 / 22:09:29 / cg"
!
inspectOwners
|class inspector|
list selection notNil ifTrue:[
class := (info at:(list selection)) at:1.
"
special kludge
"
class isSymbol ifTrue:[^self].
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.
owner == Smalltalk ifTrue:[
owner keysAndValuesDo:[:key :val |
(val isMemberOf:class) ifTrue:[
set add:key
]
]
] ifFalse:[
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
]
].
inspector := DictionaryInspectorView openOn:dict.
inspector listView doubleClickAction:[:lineNr | inspector doInspectKey].
]
]
"Modified: 15.10.1996 / 22:09:38 / cg"
!
nilInstances
|class|
list selection notNil ifTrue:[
class := (info at:(list selection)) at:1.
self withCursor:(Cursor questionMark) do:[
|insts|
insts := class allInstances.
insts notEmpty ifTrue:[
(self confirm:'there are ' , insts size printString , ' instances.\\Do you really want to nil them all ?' withCRs)
ifTrue:[
insts do:[:each |
each becomeNil
]
]
].
]
]
"Modified: 15.10.1996 / 22:09:29 / cg"
!
sortByAverageSize
self label:'Memory usage; by average size'.
"/ sortBlock := [:a :b | ((a at:3)/(a at:2)) > ((b at:3)/(b at:2))].
sortBlock := [:a :b | |n1 n2 m1 m2|
n1 := ((a at:3)/(a at:2)).
n2 := ((b at:3)/(b at:2)).
n1 > n2
or:[n1 == n2
and:[(a at:1) displayString < (b at:1) displayString]]].
self updateDisplay
!
sortByClass
self label:'Memory usage; by class'.
sortBlock := [:a :b | |c1 c2 s1 s2|
c1 := (a at:1).
c2 := (b at:1).
s1 := c1 isBehavior ifTrue:[ c1 name] ifFalse:[ c1 displayString ].
s2 := c2 isBehavior ifTrue:[ c2 name ] ifFalse:[ c2 displayString ].
s1 < s2].
self updateDisplay
"Modified: 28.6.1996 / 14:32:38 / cg"
!
sortByClassNameWithoutPrefix
self label:'Memory usage; by className without prefix'.
sortBlock := [:a :b | |c1 c2 s1 s2|
c1 := (a at:1).
c2 := (b at:1).
s1 := c1 isBehavior ifTrue:[ c1 nameWithoutPrefix ] ifFalse:[ c1 displayString ].
s2 := c2 isBehavior ifTrue:[ c2 nameWithoutPrefix ] ifFalse:[ c2 displayString ].
s1 < s2].
self updateDisplay
!
sortByInstCount
self label:'Memory usage; by instance count'.
"/ sortBlock := [:a :b | (a at:2) > (b at:2) ].
sortBlock := [:a :b | |n1 n2|
n1 := (a at:2).
n2 := (b at:2).
n1 > n2
or:[n1 == n2
and:[(a at:1) displayString < (b at:1) displayString]]].
self updateDisplay
!
sortByMaxSize
self label:'Memory usage; by maximum size'.
"/ sortBlock := [:a :b | (a at:4) > (b at:4)].
sortBlock := [:a :b | |n1 n2 m1 m2|
n1 := (a at:4).
n2 := (b at:4).
n1 > n2
or:[n1 == n2
and:[(a at:1) displayString < (b at:1) displayString]]].
self updateDisplay
!
sortByMemoryUsage
self label:'Memory usage; by memory usage'.
"/ sortBlock := [:a :b | (a at:3) > (b at:3)].
sortBlock := [:a :b | |n1 n2|
n1 := (a at:3).
n2 := (b at:3).
n1 > n2
or:[n1 == n2
and:[(a at:1) displayString < (b at:1) displayString]]].
self updateDisplay
!
update
self updateInfo.
self updateDisplay
!
usageMenu
<resource: #programMenu>
|m|
m := PopUpMenu
itemList:#(
('Sort by Class Name' sortByClass )
('Sort by Classes Basename' sortByClassNameWithoutPrefix )
('Sort by Inst Count' sortByInstCount )
('Sort by Memory Usage' sortByMemoryUsage )
('Sort by Average Size' sortByAverageSize )
('Sort by Maximum Size' sortByMaxSize )
('-')
('Inspect Instances' inspectInstances )
('Inspect with Search' inspectInstancesWithSearch )
('Inspect Owners' inspectOwners )
('Ref Chains' displayGlobalRefChainsToInsts )
('Clear (nil) Instances' nilInstances )
('-')
('Update' update )
('Collect Garbage & Update' collectGarbageAndUpdate )
)
resources:resources.
list hasSelection ifFalse:[
m disableAll:#(inspectInstances inspectInstancesWithSearch
inspectOwners
displayGlobalRefChainsToInsts).
].
^ m
"Modified: / 3.2.1998 / 00:04:16 / cg"
! !
!MemoryUsageView methodsFor:'private'!
updateDisplay
"update the displayed list"
windowGroup withCursor:Cursor wait do:[
|classNames counts sumSizes maxSizes percents avgSizes
l line allMemory
overAllCount overAllAvgSize overAllMaxSize
lastP sumPercent|
info := rawInfo asSortedCollection:sortBlock.
classNames := info collect:[:infoArray |
|cls|
cls := infoArray at:1.
cls == #Class ifTrue:[
'<all classes>'
] ifFalse:[
cls == #Metaclass ifTrue:[
'<all metaclasses>'
] ifFalse:[
cls == #PrivateMetaclass ifTrue:[
'<all private meta classes>'
] ifFalse:[
cls == #PrivateClass ifTrue:[
'<all private classes>'
] ifFalse:[
cls == #ObsoleteClass ifTrue:[
'<all obsolete classes>'
] ifFalse:[
cls == #NameSpace ifTrue:[
'<all namespaces>'
] ifFalse:[
cls isJavaClass ifTrue:[
cls fullName asString copyReplaceAll:$/ with:$.
] ifFalse:[
cls isObsolete ifTrue:[
cls name,' (obsolete)'
] ifFalse:[
cls "displayString" name
]
]
]
]
]
]
]
]
].
counts := info collect:[:infoArray | (infoArray at:2) ].
sumSizes := info collect:[:infoArray | (infoArray at:3) ].
maxSizes := info collect:[:infoArray | (infoArray at:4) ].
allMemory := sumSizes inject:0 into:[:sum :this | sum + this].
"/ allMemory := ObjectMemory bytesUsed.
percents := sumSizes collect:[:sz | (sz asFloat / allMemory * 100)].
avgSizes := (1 to:sumSizes size) collect:[:i | (((sumSizes at:i) / (counts at:i)) * 10) rounded / 10.0].
sumPercent := 0.
l := OrderedCollection new.
1 to:classNames size do:[:i |
|line avgSz maxSz percent|
avgSz := avgSizes at:i.
maxSz := maxSizes at:i.
avgSz = maxSz ifTrue:[
avgSz := avgSz asInteger printString , ' '.
].
line := (classNames at:i) printStringPaddedTo:50 with:Character space.
line := line contractTo:50.
line := line , ((counts at:i) printStringLeftPaddedTo:7).
line := line , (avgSz printStringLeftPaddedTo:10).
line := line , (maxSz printStringLeftPaddedTo:8).
line := line , ((sumSizes at:i) printStringLeftPaddedTo:10).
percent := (percents at:i).
"/ percent < 0.0 ifTrue:[self halt].
line := line , ((percent asFixedPoint:1) printStringLeftPaddedTo:7).
lastP := sumPercent := ((sumPercent + percent) min:100.0).
line := line , ((sumPercent asFixedPoint:1) printStringLeftPaddedTo:7).
l add:line
].
"/ (((lastP asFixedPoint:1) printStringLeftPaddedTo:7) startsWith:'99.') ifTrue:[self halt].
"add summary line"
overAllCount := counts inject:0 into:[:sum :this | sum + this].
overAllAvgSize := ((allMemory / overAllCount) * 10) rounded / 10.0.
overAllMaxSize := maxSizes max.
l add:''.
line := 'all objects' printStringPaddedTo:33 with:Character space.
line := line , (overAllCount printStringLeftPaddedTo:7).
line := line , (overAllAvgSize printStringLeftPaddedTo:10).
line := line , (overAllMaxSize printStringLeftPaddedTo:8).
line := line , (allMemory printStringLeftPaddedTo:10).
line := line , (100.0 printStringLeftPaddedTo:7).
l add:line.
list list:l.
]
"Created: / 19.9.1995 / 15:30:47 / claus"
"Modified: / 19.7.1998 / 00:47:08 / cg"
!
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).
rawInfo := IdentityDictionary new:600.
[ |behaviorFlag|
behaviorFlag := Behavior flagBehavior.
ObjectMemory allObjectsDo:[:o |
|infoArray class bytes|
"/ o isBehavior ifTrue:[
class := o class.
(class flags notNil and:[(class flags bitAnd:behaviorFlag) ~~ 0]) ifTrue:[
o isObsolete ifTrue:[
class := #ObsoleteClass
] ifFalse:[
o isMeta ifTrue:[
o isPrivate ifTrue:[
class := #PrivateMetaclass
] ifFalse:[
class := #Metaclass
]
] ifFalse:[
o isPrivate ifTrue:[
class := #PrivateClass
] ifFalse:[
(o isNameSpace
and:[o ~~ NameSpace
and:[o ~~ Smalltalk]])
ifTrue:[
class := #NameSpace
] ifFalse:[
class := #Class
]
]
]
]
].
bytes := ObjectMemory sizeOf:o.
infoArray := rawInfo at:class ifAbsent:[].
infoArray isNil ifTrue:[
infoArray := Array
with:class
with:1
with:bytes
with:bytes.
rawInfo at:class put:infoArray.
] ifFalse:[
infoArray at:2 put:((infoArray at:2) + 1).
infoArray at:3 put:((infoArray at:3) + bytes).
infoArray at:4 put:((infoArray at:4) max: bytes).
]
].
] valueNowOrOnUnwindDo:[
myProcess priority:myPriority.
].
]
"Modified: 19.9.1995 / 15:29:10 / claus"
"Modified: 15.10.1996 / 22:13:19 / cg"
! !
!MemoryUsageView methodsFor:'realization'!
realize
super realize.
titleLabel origin:(list originRelativeTo:self) x @ 0.0.
self updateInfo.
self sortByClass.
"Modified: 14.10.1997 / 21:03:52 / cg"
! !
!MemoryUsageView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/MemoryUsageView.st,v 1.46 2006-01-30 08:30:01 cg Exp $'
! !