MemoryMonitor.st
author Claus Gittinger <cg@exept.de>
Wed, 30 Jul 1997 21:20:36 +0200
changeset 1261 f59a1039ae3c
parent 1206 e3894601c394
child 1619 6e4b1930841a
permissions -rw-r--r--
tenure in GC to break rememberedSet refs.

"
 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 drawLock'
	classVariableNames:''
	poolDictionaries:''
	category:'Monitors-ST/X'
!

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

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

        cod     dynamic compiled code space size (just in time compiler)

        max,    extreme values of 'tot' since the monitor started
        min     (can be reset by typing 'r' in the view)

        t       tenure threshold (1 .. 30)

        I       incremental GC state (2 = idle)

        weak    number of weak objects

        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:
        orange  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

    [author:]
        Claus Gittinger

    [see also:]
        ObjectMemory
        MemoryUsageMonitor ProcessMonitor
"
! !

!MemoryMonitor class methodsFor:'defaults'!

defaultExtent
    ^ (200 @ 320)

    "Modified: 24.8.1996 / 12:04:21 / cg"
!

defaultIcon
    |i|

    i := Image fromFile:'MemMonitor.xbm'.
    i notNil ifTrue:[^ i].
    ^ super defaultIcon
!

defaultLabel
    ^ 'Memory Monitor'
! !

!MemoryMonitor methodsFor:'destroying'!

destroy
    updateBlock notNil ifTrue:[
	Processor removeTimedBlock:updateBlock.
    ] ifFalse:[
	myProcess terminate.
	myProcess := nil
    ].
    oldData := newData := freeData := nil.
    super destroy
! !

!MemoryMonitor methodsFor:'drawing'!

displayKilo:aNumber name:nm y:y
    |s|

    s := nm , ((aNumber // 1024) printStringLeftPaddedTo:5) , 'k '.
    self displayOpaqueString:s x:0 y:y.

!

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 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.
    ]
!

updateDisplay
    "update picture; trigger next update"

    |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize
     gWidth shift scaleChange margin|

    shown ifTrue:[
        drawLock wouldBlock ifFalse:[
            drawLock critical:[
                oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
                newSpaceUsed := ObjectMemory newSpaceUsed.
                freeMem := ObjectMemory freeListSpace + (ObjectMemory oldSpaceSize - ObjectMemory oldSpaceUsed).
                oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
                total := oldSpaceSize + ObjectMemory newSpaceSize.

                scaleChange := false.

                ((total - freeMem) < minTotal) ifTrue:[
                    minTotal := total - freeMem.
                    scaleChange := true
                ].
                (total > maxTotal) ifTrue:[
                    maxTotal := total.
                    scaleChange := true
                ].

                oldData at:updateIndex put:oldSpaceSize. "/ 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.

                ((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 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.
                ].

                self updateLineX:(updateIndex - 1 + org - 1)
                           total:total 
                           old:oldSpaceSize "/ oldSpaceUsed
                           new:newSpaceUsed 
                           free:freeMem.

                self updateNumbers.
                self flush.
            ].
        ].
    ].

    updateBlock notNil ifTrue:[
        Processor addTimedBlock:updateBlock afterSeconds:updateInterval
    ].

    "Modified: 29.1.1997 / 13:32:31 / cg"
!

updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem
    |hNew hOld hFree y1 y2 y3|

    hNew := (newSpaceUsed * scale) asInteger.
    hOld := (oldSpaceSize * scale) // 2.
    hFree := (freeMem * scale) // 2.

    y1 := height - 1.

    y2 := y1 - hOld.
    self paint:oldColor.
    self displayLineFromX:x y:y1 toX:x y:y2.

    y3 := y1 - hFree.
    self paint:freeColor.
    self displayLineFromX:x y:y1 toX:x y:y3.

    y1 := y2 - 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
        fre:    current size of freelist in oldSpace
        old:    current oldSpace in use
        code:   current just-in-time compiled code cache size
        t:      current tenure age
        I:      IGC state
        weak:   number of weak arrays in the system
        rem     remembered set size
        lrem    lifo remembered set size
        minsc:  percent of newspace remaining after scavenge (worst case)
        irq:    max. interrupt delay
        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 * 5).

    total ~~ prevTotal ifTrue:[
        ((total - freeMem) < minTotal) ifTrue:[
            minTotal := total - freeMem.
        ].
        (total > maxTotal) ifTrue:[
            maxTotal := total.
        ].

        self displayKilo:maxTotal name:'max ' y:font ascent.
        self displayKilo:minTotal name:'min ' y:(height - font descent).
        self displayKilo:total    name:'tot ' y:y.

        prevTotal := total.
    ].

    y := y + fontHeight.
    self displayKilo:memUsed name:'all ' y:y.

    y := y + fontHeight.
    self paint:newColor.
    self displayKilo:newMemUsed name:'new ' y:y.

    y := y + fontHeight.
    freeMem ~~ prevFree ifTrue:[
        self paint:freeColor.
        self displayKilo:freeMem name:'frl ' y:y.
        prevFree := freeMem.
    ].

    y := y + fontHeight.
    free2 ~~ prevFree2 ifTrue:[
        self paint:freeColor.
        self displayKilo:free2 name:'fre ' y:y.
        prevFree2 := free2.
    ].

    y := y + fontHeight.
    (oldMemUsed - freeMem) ~~ prevOld ifTrue:[
        self paint:oldColor.
        self displayKilo:(oldMemUsed - freeMem) name:'old ' y:y.
        prevOld := (oldMemUsed - freeMem).
    ].

    ObjectMemory supportsJustInTimeCompilation ifTrue:[
        y := y + fontHeight.
        self paint:oldColor.
        n := ObjectMemory compiledCodeSpaceUsed.
        n > 9999 ifTrue:[
            s := 'code ' , ((n // 1024) printStringLeftPaddedTo:4) , 'k'.
        ] ifFalse:[
            s := 'code ' , (n printStringLeftPaddedTo:4) , ' '.
        ].
        self displayOpaqueString:s x:0 y:y.
    ].

    "
     the following is internal - normally only interesting 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 := 'weak: ' , (ObjectMemory numberOfWeakObjects printStringLeftPaddedTo:4).
    self displayOpaqueString:s x:0 y:y.

    y := y + fontHeight.
    s := 'rem: ' , (ObjectMemory rememberedSetSize printStringLeftPaddedTo:5).
    self displayOpaqueString:s x:0 y:y.

    y := y + fontHeight.
    s := 'lrem: ' , (ObjectMemory lifoRememberedSetSize printStringLeftPaddedTo:4 ifLarger:['****']).
    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 maxInterruptLatency.
    n notNil ifTrue:[
        s := 'irq ', (n printStringLeftPaddedTo:3) , ' ms'.
    ] ifFalse:[
        s := ''
    ].
    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.

    "Created: 7.11.1995 / 14:48:16 / cg"
    "Modified: 24.8.1996 / 11:57:22 / cg"
! !

!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 resetStatisticValues.
	self redraw.
    ]

    "Modified: 7.11.1995 / 17:45:13 / cg"
!

sizeChanged:how
    |nn no nf delta oldSize newSize|

    super sizeChanged:how.

    oldSize := oldData size.
    newSize := width-org+1.

    (newSize ~~ oldSize) ifTrue:[
	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'!

initialize
    super initialize.

    drawLock := Semaphore forMutualExclusion name:'drawLock'.

    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 orange. "/ 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
    "

    "Modified: 23.1.1997 / 22:37:06 / cg"
!

memoryMenu
    |m specialMenu labels selectors shorties|

    labels :=    #(
                    'scavenge'
                    'tenure'
                    'hi prio incremental collect'
                    '-'
                    'cleanup memory'
                    'flush method history'
                    'unload autoloaded classes'
                    '-'
                    'compress sources'
                  ).
    selectors := #(
                    scavenge
                    tenure
                    incrementalCollect
                    nil
                    cleanupMemory
                    cleanupMethodHistory
                    unloadAllAutoloadedClasses
                    nil
                    compressSources
                  ).

    specialMenu := PopUpMenu
                        labels:(resources array:labels)
                        selectors:selectors.

    device ctrlDown ifTrue:[
        ^ specialMenu
    ].

    ObjectMemory backgroundCollectorRunning ifFalse:[
        labels :=    #(
                        'collect garbage'
                        'collect garbage & symbols'
                        'collect garbage & compress'
                        '-'
                        'background collect now'
                        'start background collector'
                        '-'
                        'reset statistic values'
                        '-'
                        'others'
                      ).

        selectors := #(
                        garbageCollect
                        garbageCollectAndSymbols
                        compressingGarbageCollect
                        nil
                        backgroundCollect
                        restartBackgroundCollector
                        nil
                        resetStatisticValues
                        nil
                        otherMenu
                      ).
    ] ifTrue:[
        labels :=    #(
                        'collect garbage'
                        'collect garbage & symbols'
                        'collect garbage & compress'
                        '-'
                        'background collect'
                        '-'
                        'reset statistic values'
                        '-'
                        'others'
                      ).

        selectors := #(
                        garbageCollect
                        garbageCollectAndSymbols
                        compressingGarbageCollect
                        nil
                        backgroundCollect
                        nil
                        resetStatisticValues
                        nil
                        otherMenu
                      ).
    ].

    shorties := #(
                    nil
                    nil
                    nil
                    nil
                    nil
                    nil
                    nil
                    nil
                    #'Ctrl'
                 ).

    m := PopUpMenu labels:(resources array:labels)
                   selectors:selectors
                   accelerators:shorties.

    m subMenuAt:#otherMenu put:specialMenu.
    ^ m

    "Modified: 27.6.1997 / 14:45:06 / cg"
!

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.
! !

!MemoryMonitor methodsFor:'menu functions'!

backgroundCollect
    "start a background (non disturbing) incremental GC. 
     Since the GC is performed at a low priority, it may not make progress if higher
     prio processes are running"
 
    [
	ObjectMemory incrementalGC
    ] forkAt:5 
!

cleanupMemory
    "let all classes release unneeded, cached
     data ..."

    ObjectMemory performLowSpaceCleanup.

    "
     then, perform a GC (incl. symbol reclamation)
    "
    ObjectMemory reclaimSymbols.
    "
     finally, compress
    "
    ObjectMemory tenure.
    ObjectMemory verboseGarbageCollect.

    "Modified: 26.6.1997 / 17:12:53 / cg"
!

cleanupMethodHistory
    "release the oldMethod history"

    (self confirm:'This removes the previous method history,
which is kept for all changed methods in the system.
After that, the browsers cannot easily switch back to a methods
previous version.

However, this is normally not a problem, since
a methods previous code should still be accessable through
either the changes-file, the sourceCode repository or the classes original
source file.

cleanup now ?') ifTrue:[


        Class flushMethodHistory.

        "
         then, perform a GC (incl. symbol reclamation)
        "
        ObjectMemory reclaimSymbols.
        "
         finally, compress
        "
        ObjectMemory verboseGarbageCollect.
   ]



!

compressSources
    (self confirm:'This saves all in-memory source strings into a file
and makes methods reference these (file-) strings,
freeing all in-memory sources.

If that source file is ever lost or gets out of sync with
your system, those method sources are lost and the browser
will show garbage. 
However, you still have a change file as backup.

(Be especially careful, if you move images around:
 the source file must then be the correct one for that image)

A compress is only useful, if you added many methods
and the systems response time suffers from paging.

Compress anyway ?') ifTrue:[
        windowGroup withWaitCursorDo:[
            Smalltalk compressSources.
            ObjectMemory markAndSweep
        ]
    ]

    "Modified: 9.2.1996 / 18:17:22 / cg"
!

compressingGarbageCollect
    "perform a blocking compressing garbage collect."

    windowGroup withWaitCursorDo:[
        ObjectMemory tenure.
        ObjectMemory verboseGarbageCollect
    ]

    "Modified: 30.7.1997 / 21:19:47 / cg"
!

garbageCollect
    "perform a blocking (non compressing) garbage collect"

    windowGroup withWaitCursorDo:[
        ObjectMemory tenure.
        ObjectMemory markAndSweep
    ]

    "Modified: 30.7.1997 / 21:19:35 / cg"
!

garbageCollectAndSymbols
    "perform a blocking (non compressing) garbage collect
     and reclaim unreferenced symbols."

    windowGroup withWaitCursorDo:[
        ObjectMemory tenure.
        ObjectMemory reclaimSymbols
    ]

    "Modified: 30.7.1997 / 21:19:41 / cg"
!

incrementalCollect
    "start an incremental GC which does not disturb too much, but is guaranteed to
     make progress.
     This is done by doing the IGC at a very high priority, but giving up the CPU after
     every step. Due to the long delays, this may take a while to finish.
     Notice, that this is different from doing a background collect: that one
     may not make any progress if higher prio processes are runnable."

    |done delay|

    [
        done := false.
        delay := Delay new.
        [done] whileFalse:[
            10 timesRepeat:[
                done ifFalse:[done := ObjectMemory gcStep].
            ].
            (delay delay:10) wait
        ]
    ] forkAt:Processor highestPriority

    "Modified: 23.12.1995 / 17:31:55 / cg"
!

resetStatisticValues 
    ObjectMemory resetMaxInterruptLatency.
    ObjectMemory resetMinScavengeReclamation.

    "Created: 7.11.1995 / 17:44:59 / cg"
!

restartBackgroundCollector
    "start a background (non disturbing) incremental GC. 
     Since the GC is performed at a low priority, it may not make progress if higher
     prio processes are running"
 
    ObjectMemory backgroundCollectorRunning
    ifFalse:[
        ObjectMemory startBackgroundCollectorAt:5.
        ObjectMemory startBackgroundCollectorAt:5
    ]

    "Created: 21.1.1997 / 00:09:30 / cg"
!

scavenge 
    "perform a blocking newspace garbage collect.
     (this is for debugging only - the system does this automatically)"

    ObjectMemory scavenge
!

tenure 
    "empty the newSpace, by aging all new objects immediately and transfering them
     into oldSpace.
     (this is for debugging only - the system does this automatically)"

    ObjectMemory tenure
!

unloadAllAutoloadedClasses
    "unload all classes which were autoloaded and have no instances"

    Autoload loadedClasses copy do:[:anAutoloadedClass |
        anAutoloadedClass hasInstances ifFalse:[
            anAutoloadedClass unload
        ]
    ].

    "Created: 27.6.1997 / 14:21:45 / cg"
    "Modified: 27.6.1997 / 14:22:47 / cg"
! !

!MemoryMonitor class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.48 1997-07-30 19:20:36 cg Exp $'
! !