"
 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.18 1995-08-03 01:37:52 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.18 1995-08-03 01:37:52 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

	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:
	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 @ 280)
!

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 oldSpaceSize
     gWidth shift scaleChange margin mustWait|

    shown ifTrue:[
	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.

	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:oldSpaceSize "/ 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: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
	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
	lrem    lifo 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 * 5).

    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 := '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 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'
			'incremental collect'
			'-'
			'cleanup memory'
			'-'
			'compress sources'
		      ).
	selectors := #(
			scavenge
			tenure
			incrementalCollect
			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 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
    "
! !

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

incrementalCollect
    [
	[ObjectMemory gcStep] whileFalse:[(Delay forMilliseconds:1) wait]
    ] forkAt:Processor highestPriority
!

backgroundCollect
    [ObjectMemory incrementalGC] forkAt:5 
! !