"
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.
"
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.6 1995-02-06 01:00:07 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.6 1995-02-06 01:00:07 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
% 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 @ 200)
!
defaultLabel
^ 'Memory Monitor'
!
defaultIcon
|i|
i := Image fromFile:'bitmaps/MemMonitor.xbm'.
i notNil ifTrue:[^ i].
^ super defaultIcon
! !
!MemoryMonitor methodsFor:'drawing'!
redraw
"redraw all"
self clear.
self redrawX:0 y:0 width:width height:height
!
redrawX:x y:y width:w height:h
"redraw data"
|total oldSpaceUsed newSpaceUsed freeMem lx s startIdx endIdx
right|
shown ifFalse:[^ self].
right := x + w - 1.
right >= org ifTrue:[
lx := x.
lx < org ifTrue:[
lx := org
].
total := ObjectMemory fixSpaceSize
+ 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
"
|oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2
x y half s thisStringLen fontHeight total n|
oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
newMemUsed := ObjectMemory newSpaceUsed.
freeMem := ObjectMemory freeListSpace.
oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory fixSpaceSize.
newSpaceSize := ObjectMemory newSpaceSize.
memUsed := oldMemUsed + newMemUsed "- freeMem".
total := oldSpaceSize + newSpaceSize.
free2 := oldSpaceSize - oldMemUsed.
self paint:White on:Black.
fontHeight := font height + font descent.
half := height // 2 + font descent.
y := half - (fontHeight * 3).
total ~~ prevTotal ifTrue:[
((total - freeMem) < minTotal) ifTrue:[
minTotal := total - freeMem.
].
(total > maxTotal) ifTrue:[
maxTotal := total.
].
s := 'max ' , ((maxTotal // 1024) printStringRightAdjustLen:5) , 'k '.
self displayOpaqueString:s x:0 y:font ascent.
s := 'min ' , ((minTotal // 1024) printStringRightAdjustLen:5) , 'k '.
self displayOpaqueString:s x:0 y:(height - font descent).
s := 'tot ' , ((total // 1024) printStringRightAdjustLen:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
prevTotal := total.
].
y := y + fontHeight.
s := 'all ' , ((memUsed // 1024) printStringRightAdjustLen:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
y := y + fontHeight.
self paint:newColor.
s := 'new ' , ((newMemUsed // 1024) printStringRightAdjustLen:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
y := y + fontHeight.
freeMem ~~ prevFree ifTrue:[
self paint:freeColor.
s := 'frl ' , ((freeMem // 1024) printStringRightAdjustLen:5) , 'k '.
self displayOpaqueString:s x:0 y:y.
prevFree := freeMem.
].
y := y + fontHeight.
free2 ~~ prevFree2 ifTrue:[
self paint:freeColor.
s := 'fre ' , ((free2 // 1024) printStringRightAdjustLen: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) printStringRightAdjustLen: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 printStringRightAdjustLen:2) , ' '.
s := s , 'I:' , (ObjectMemory incrementalGCPhase printStringRightAdjustLen:2) , ' '.
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 lastScavangeReclamation / ObjectMemory newSpaceSize * 100.0.
n := 100 - n asInteger.
s := (n printStringRightAdjustLen:2) , '%'.
self displayOpaqueString:s x:0 y:y.
!
updateDisplay
"update picture; trigger next update"
|total oldSpaceUsed newSpaceUsed freeMem
gWidth shift scaleChange margin mustWait|
shown ifTrue:[
oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
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
].
! !
!MemoryMonitor methodsFor:'destroying'!
destroy
updateBlock notNil ifTrue:[
Processor removeTimedBlock:updateBlock.
] ifFalse:[
myProcess terminate.
myProcess := nil
].
oldData := newData := freeData := nil.
super destroy
! !
!MemoryMonitor methodsFor:'events'!
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).
self redraw.
]
!
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
! !
!MemoryMonitor methodsFor:'initialization'!
realize
super realize.
updateBlock notNil ifTrue:[
Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
] ifFalse:[
myProcess := [
|d|
[true] whileTrue:[
(Delay forSeconds:updateInterval) wait.
self updateDisplay
]
] forkAt:5.
myProcess name:'monitor 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 fixSpaceSize
+ 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).
"
MemoryMonitor open
"
!
initializeMiddleButtonMenu
self middleButtonMenu:
(PopUpMenu labels:(resources array:#(
'collect Garbage'
'collect Garbage & compress'
'-'
'background collect'
))
selectors:#(
garbageCollect
compressingGarbageCollect
nil
backgroundCollect
)
receiver:self
for:self)
! !
!MemoryMonitor methodsFor:'menu functions'!
garbageCollect
ObjectMemory markAndSweep
!
compressingGarbageCollect
ObjectMemory verboseGarbageCollect
!
backgroundCollect
[ObjectMemory incrementalGC] forkAt:4
! !