"
 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.8 1995-02-15 10:39:55 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.8 1995-02-15 10:39:55 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) 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.

"/ 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 printStringLeftPaddedTo: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:'Memory 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 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
! !