.
"
COPYRIGHT (c) 1991 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.5 on 22-mar-1995 at 7:43:35 am'!
StandardSystemView subclass:#MemoryMonitor
instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData
updateIndex org maxTotal minTotal dX newColor freeColor oldColor
prevTotal prevFree prevFree2 prevOld scale'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
!
MemoryMonitor comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.17 1995-07-23 03:19:24 claus Exp $
'!
!MemoryMonitor class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1991 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/MemoryMonitor.st,v 1.17 1995-07-23 03:19:24 claus Exp $
"
!
documentation
"
Shows memory usage (oldspace + newspace). Simple, but useful.
The numbers shown are:
tot total memory usage (i.e. allocated oldSpace + allocated newSpace)
(does not include the second semispace and other help-areas,
such as the remembered set etc.)
all current oldSpace in use + newSpace in use
new current newSpace in use
frl free space in (fragmented) free lists
fre compact free area above the used oldSpace
old current oldSpace in use
max, extreme values of 'tot' since the monitor started
min (can be reset by typing 'r' in the view)
t tenure threshold
I incremental GC state
rem size of rememberedSet
minsc: percent of newspace remaining after scavenge (worst case)
(i.e. the minimum %% of scavenged objects)
count number of scavenges since system started
% percentage of live objects in newSpace after last scavenge
(i.e. this is the garbage vs. living objects ratio of
newSpace objects after the last scavenge)
the graphic shows:
yellow newSpace used
green free memory in freeLists
white oldSpace used
the popupMenu offers GC functions; keyboard options are:
'f' -> faster; 's' -> slower; 'r' -> reset min/max
"
! !
!MemoryMonitor class methodsFor:'defaults'!
defaultExtent
^ (200 @ 250)
!
defaultLabel
^ 'Memory Monitor'
!
defaultIcon
|i|
i := Image fromFile:'MemMonitor.xbm'.
i notNil ifTrue:[^ i].
^ super defaultIcon
! !
!MemoryMonitor methodsFor:'drawing'!
updateDisplay
"update picture; trigger next update"
|total oldSpaceUsed newSpaceUsed freeMem
gWidth shift scaleChange margin mustWait|
shown ifTrue:[
oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
newSpaceUsed := ObjectMemory newSpaceUsed.
freeMem := ObjectMemory freeListSpace.
total := oldSpaceUsed + newSpaceUsed.
scaleChange := false.
((total - freeMem) < minTotal) ifTrue:[
minTotal := total - freeMem.
scaleChange := true
].
(total > maxTotal) ifTrue:[
maxTotal := total.
scaleChange := true
].
oldData at:updateIndex put:oldSpaceUsed.
newData at:updateIndex put:newSpaceUsed.
freeData at:updateIndex put:freeMem.
updateIndex := updateIndex + 1.
scaleChange ifTrue:[
scale := height asFloat / (maxTotal + 100000).
self redraw
].
gWidth := width - org.
margin := 1.
mustWait := false.
((updateIndex-1) >= (gWidth - margin)) ifTrue:[
"on slow displays, use:"
"/ shift := gWidth // 4.
"for smooth display, use:"
shift := 1.
oldData replaceFrom:1 with:oldData startingAt:shift+1.
newData replaceFrom:1 with:newData startingAt:shift+1.
freeData replaceFrom:1 with:freeData startingAt:shift+1.
updateIndex := updateIndex - shift.
dX := dX + shift.
self catchExpose.
self copyFrom:self
x:(org + shift) y:0
toX:org y:0
width:(gWidth - shift - margin)
height:height.
self clearRectangleX:(width - margin - shift) y:0
width:shift height:height.
mustWait := true.
].
self updateLineX:(updateIndex - 1 + org - 1)
total:total
old:oldSpaceUsed
new:newSpaceUsed
free:freeMem.
self updateNumbers.
mustWait ifTrue:[
self waitForExpose.
]
].
updateBlock notNil ifTrue:[
Processor addTimedBlock:updateBlock afterSeconds:updateInterval
].
!
redrawX:x y:y width:w height:h
"redraw data"
|total oldSpaceUsed newSpaceUsed freeMem lx startIdx endIdx
right|
shown ifFalse:[^ self].
right := x + w - 1.
right >= org ifTrue:[
lx := x.
lx < org ifTrue:[
lx := org
].
total := ObjectMemory symSpaceSize
+ ObjectMemory oldSpaceSize
+ ObjectMemory newSpaceSize.
startIdx := (lx-org+1).
startIdx < 1 ifTrue:[
startIdx := 1
].
endIdx := right-org+1.
endIdx >= updateIndex ifTrue:[
endIdx := updateIndex-1.
].
dX := 0.
startIdx to:endIdx do:[:i |
newSpaceUsed := newData at:i.
newSpaceUsed notNil ifTrue:[
oldSpaceUsed := oldData at:i.
freeMem := freeData at:i.
self updateLineX:lx - dX
total:total
old:oldSpaceUsed
new:newSpaceUsed
free:freeMem.
].
lx := lx + 1
]
].
x < org ifTrue:[
prevFree := prevFree2 := prevOld := prevTotal := nil.
self updateNumbers.
]
!
updateLineX:x total:total old:oldSpaceUsed new:newSpaceUsed free:freeMem
|hNew hOld hFree y1 y2|
hNew := (newSpaceUsed * scale) asInteger.
hOld := (oldSpaceUsed * scale) // 2.
hFree := (freeMem * scale) asInteger.
y1 := height - 1.
y2 := y1 - hOld.
self paint:oldColor.
self displayLineFromX:x y:y1 toX:x y:y2.
y1 := y2.
y2 := y1 - hFree.
self paint:freeColor.
self displayLineFromX:x y:y1 toX:x y:y2.
y1 := y2.
y2 := y1 - hNew.
self paint:newColor.
self displayLineFromX:x y:y1 toX:x y:y2.
!
updateNumbers
"redraw numbers.
The values shown are:
max: maximum memory used since monitor started
min: minimum memory used since monitor started
tot: total memory used (overall oldSpace + overall newSpace)
all: current memory in use (oldSpace + newSpace)
new: current newSpace in use
free: current size of freelist in oldSpace
old: current oldSpace in use
minsc: percent of newspace remaining after scavenge (worst case)
t current tenure age
I IGC state
rem remembered set size
count of scavenges
last scavenge survivor rate
"
|oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2
y half s fontHeight total n|
oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
newMemUsed := ObjectMemory newSpaceUsed.
freeMem := ObjectMemory freeListSpace.
oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
newSpaceSize := ObjectMemory newSpaceSize.
memUsed := oldMemUsed + newMemUsed "- freeMem".
total := oldSpaceSize + newSpaceSize.
free2 := ObjectMemory freeSpace.
self paint:White on:Black.
fontHeight := font height + font descent.
half := height // 2 + font descent.
y := half - (fontHeight * 4).
total ~~ prevTotal ifTrue:[
((total - freeMem) < minTotal) ifTrue:[
minTotal := total - freeMem.
].
(total > maxTotal) ifTrue:[
maxTotal := total.
].
s := 'max ' , ((maxTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:font ascent.
s := 'min ' , ((minTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:(height - font descent).
s := 'tot ' , ((total // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
prevTotal := total.
].
y := y + fontHeight.
s := 'all ' , ((memUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
y := y + fontHeight.
self paint:newColor.
s := 'new ' , ((newMemUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
y := y + fontHeight.
freeMem ~~ prevFree ifTrue:[
self paint:freeColor.
s := 'frl ' , ((freeMem // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
prevFree := freeMem.
].
y := y + fontHeight.
free2 ~~ prevFree2 ifTrue:[
self paint:freeColor.
s := 'fre ' , ((free2 // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
prevFree2 := free2.
].
y := y + fontHeight.
(oldMemUsed - freeMem) ~~ prevOld ifTrue:[
self paint:oldColor.
s := 'old ' , (((oldMemUsed - freeMem) // 1024) printStringLeftPaddedTo:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
prevOld := (oldMemUsed - freeMem).
].
"
the following is internal - normally only interresting when debugging the VM
"
y := y + fontHeight.
self paint:oldColor.
s := 't:' , (ObjectMemory tenureAge printStringLeftPaddedTo:2) , ' '.
s := s , ' I:' , (ObjectMemory incrementalGCPhase printStringLeftPaddedTo:2) , ' '.
self displayOpaqueString:s x:0 y:y.
y := y + fontHeight.
s := 'rem: ' , (ObjectMemory rememberedSetSize printStringLeftPaddedTo:5).
self displayOpaqueString:s x:0 y:y.
"/ does no longer make sense to show ....
"/ y := y + fontHeight.
"/ ObjectMemory runsSingleOldSpace ifTrue:[
"/ self displayOpaqueString:'single' x:0 y:(half + (fontHeight*4)).
"/ ].
y := y + fontHeight.
n := ObjectMemory minScavengeReclamation / ObjectMemory newSpaceSize * 100.0.
n := 100 - n asInteger.
s := 'minSc ', (n printStringLeftPaddedTo:3) , '%'.
self displayOpaqueString:s x:0 y:y.
y := y + fontHeight.
n := ObjectMemory lastScavengeReclamation / ObjectMemory newSpaceSize * 100.0.
n := 100 - n asInteger.
s := (ObjectMemory scavengeCount printStringLeftPaddedTo:6)
, (n printStringLeftPaddedTo:3) , '%'.
self displayOpaqueString:s x:0 y:y.
!
redraw
"redraw all"
self clear.
self redrawX:0 y:0 width:width height:height
! !
!MemoryMonitor methodsFor:'destroying'!
destroy
updateBlock notNil ifTrue:[
Processor removeTimedBlock:updateBlock.
] ifFalse:[
myProcess terminate.
myProcess := nil
].
oldData := newData := freeData := nil.
super destroy
! !
!MemoryMonitor methodsFor:'events'!
sizeChanged:how
|nn no nf delta oldSize newSize|
super sizeChanged:how.
oldSize := oldData size.
newSize := width-org+1.
(newSize == oldSize) ifTrue:[^ self].
nn := Array new:newSize.
no := Array new:newSize.
nf := Array new:newSize.
(newSize > oldSize) ifTrue:[
nn replaceFrom:1 to:oldSize with:newData.
no replaceFrom:1 to:oldSize with:oldData.
nf replaceFrom:1 to:oldSize with:freeData
] ifFalse:[
delta := (oldSize - newSize).
nn replaceFrom:1 with:newData startingAt:delta+1.
no replaceFrom:1 with:oldData startingAt:delta+1.
nf replaceFrom:1 with:freeData startingAt:delta+1.
updateIndex > newSize ifTrue:[
updateIndex := updateIndex - delta.
]
].
newData := nn.
oldData := no.
freeData := nf.
scale := height asFloat / (maxTotal + 100000).
self clear.
self redraw
!
keyPress:key x:x y:y
key == $f ifTrue:[
"faster"
updateInterval := updateInterval / 2
].
key == $s ifTrue:[
"slower"
updateInterval := updateInterval * 2
].
key == $r ifTrue:[
"reset max"
maxTotal := prevTotal.
scale := height asFloat / (maxTotal + 100000).
ObjectMemory resetMinScavengeReclamation.
self redraw.
]
! !
!MemoryMonitor methodsFor:'initialization'!
memoryMenu
|labels selectors|
device ctrlDown ifTrue:[
labels := #(
'scavenge'
'tenure'
'-'
'cleanup memory'
'-'
'compress sources'
).
selectors := #(
scavenge
tenure
nil
cleanupMemory
nil
compressSources
).
] ifFalse:[
labels := #(
'collect garbage'
'collect garbage & symbols'
'collect garbage & compress'
'-'
'background collect'
).
selectors := #(
garbageCollect
garbageCollectAndSymbols
compressingGarbageCollect
nil
backgroundCollect
).
].
^ PopUpMenu labels:(resources array:labels)
selectors:selectors
receiver:self
!
realize
super realize.
updateBlock notNil ifTrue:[
Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
] ifFalse:[
myProcess := [
|d|
[true] whileTrue:[
(Delay forSeconds:updateInterval) wait.
self updateDisplay
]
] forkAt:6.
myProcess name:'monitor [' ,
Processor activeProcess id printString ,
'] update'
].
newColor := newColor on:device.
freeColor := freeColor on:device.
oldColor := oldColor on:device.
font := font on:device.
!
initialize
super initialize.
updateInterval := 0.5.
ProcessorScheduler isPureEventDriven ifTrue:[
updateBlock := [self updateDisplay].
].
oldData := Array new:1000.
newData := Array new:1000.
freeData := Array new:1000.
updateIndex := 1.
org := font widthOf:'max 99999k'.
level := 0.
maxTotal := minTotal := ObjectMemory oldSpaceSize
+ ObjectMemory symSpaceSize
+ ObjectMemory newSpaceSize.
viewBackground := Black.
device hasColors ifTrue:[
newColor := Color yellow.
freeColor := Color green.
oldColor := Color white.
] ifFalse:[
newColor := Color grey:67.
freeColor := Color grey:33.
oldColor := Color white.
].
self font:(Font family:'courier' face:'medium' style:'roman' size:10).
self model:self.
self menu:#memoryMenu
"
MemoryMonitor open
"
! !
!MemoryMonitor methodsFor:'menu functions'!
cleanupMemory
"let all classes release unneeded, cached
data ..."
Smalltalk allBehaviorsDo:[:aClass |
aClass lowSpaceCleanup
].
"
then, perform a GC (incl. symbol reclamation)
"
ObjectMemory reclaimSymbols.
"
finally, compress
"
ObjectMemory verboseGarbageCollect.
!
garbageCollect
ObjectMemory markAndSweep
!
garbageCollectAndSymbols
ObjectMemory reclaimSymbols
!
compressingGarbageCollect
ObjectMemory verboseGarbageCollect
!
scavenge
ObjectMemory scavenge
!
tenure
ObjectMemory tenure
!
compressSources
Smalltalk compressSources.
ObjectMemory markAndSweep
!
backgroundCollect
[ObjectMemory incrementalGC] forkAt:5
! !