--- a/MemoryMonitor.st Mon Oct 10 04:15:21 1994 +0100
+++ b/MemoryMonitor.st Mon Oct 10 04:16:24 1994 +0100
@@ -1,21 +1,31 @@
-'From Smalltalk/X, Version:1.5 on 4-Sep-91 at 18:41:13'!
+"
+ COPYRIGHT (c) 1992 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:'halted delay myBlock myProcess oldData newData sumData
- index org max min prevStringLen
- grey'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Debugger'
+ instanceVariableNames:'halted updateInterval updateBlock myProcess oldData newData
+ freeData sumData updateIndex org maxUsed minUsed newColor
+ freeColor oldColor prevFree prevOld'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Tools'
!
MemoryMonitor comment:'
-Shows memory usage (oldspace + newspace). Stupid, but works.
+Shows memory usage (oldspace + newspace). Simple, but useful.
'!
!MemoryMonitor class methodsFor:'startup'!
-start
+open
|m|
m := self origin:0 @ 0 extent:(200 @ 100).
@@ -27,60 +37,7 @@
m open.
^ m
- "MemoryMonitor start"
-! !
-
-!MemoryMonitor methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- halted := false.
- delay := 0.5.
- ProcessorScheduler isPureEventDriven ifTrue:[
- myBlock := [self updateDisplay].
- ].
- oldData := Array new:1000.
- newData := Array new:1000.
- index := 1.
- org := font widthOf:'9999999'.
- max := ObjectMemory bytesUsed + 100000.
- min := ObjectMemory bytesUsed.
- prevStringLen := nil.
- viewBackground := Black
-
- "MemoryMonitor start"
-!
-
-realize
- super realize.
- self enableKeyEvents.
- myBlock notNil ifTrue:[
- Processor addTimedBlock:myBlock after:delay.
- ] ifFalse:[
- myProcess := [
- |d|
-
- [true] whileTrue:[
- (Delay forSeconds:delay) wait.
- self updateDisplay
- ]
- ] forkAt:4.
- myProcess name:'monitor update'
- ].
- grey := Color grey on:device.
-! !
-
-!MemoryMonitor methodsFor:'destroying'!
-
-destroy
- myBlock notNil ifTrue:[
- Processor removeTimedBlock:myBlock.
- ] ifFalse:[
- myProcess terminate.
- myProcess := nil
- ].
- super destroy
+ "MemoryMonitor open"
! !
!MemoryMonitor methodsFor:'drawing'!
@@ -88,128 +45,269 @@
updateDisplay
"update picture; trigger next update"
- |h hOld memUsed oldMemUsed newMemUsed x half scaleChange s thisStringLen|
+ |hAll hOld hFree memUsed oldMemUsed newMemUsed freeMem x y half scaleChange s thisStringLen scale|
realized ifFalse:[^ self].
- oldMemUsed := ObjectMemory oldSpaceUsed.
- newMemUsed := ObjectMemory newSpaceUsed.
- memUsed := oldMemUsed + newMemUsed.
- oldData at:index put:oldMemUsed.
- newData at:index put:newMemUsed.
+ shown ifTrue:[
+ oldMemUsed := ObjectMemory oldSpaceUsed.
+ newMemUsed := ObjectMemory newSpaceUsed.
+ freeMem := ObjectMemory freeListSpace.
+ memUsed := oldMemUsed + newMemUsed.
- h := (memUsed - min) * height // (max - min).
- hOld := (oldMemUsed - min) * height // (max - min).
+ scaleChange := false.
+ (memUsed < minUsed) ifTrue:[
+ minUsed := memUsed.
+ scaleChange := true
+ ].
+ (memUsed - freeMem < minUsed) ifTrue:[
+ minUsed := memUsed - freeMem.
+ scaleChange := true
+ ].
+ (memUsed > maxUsed) ifTrue:[
+ maxUsed := memUsed.
+ scaleChange := true
+ ].
+ scaleChange ifTrue:[
+ self clear.
+ self redraw
+ ].
- x := index - 1 + org.
+ oldData at:updateIndex put:oldMemUsed.
+ newData at:updateIndex put:newMemUsed.
+ freeData at:updateIndex put:freeMem.
+
+ scale := height asFloat / (maxUsed - minUsed + 200000).
+
+ hAll := ((memUsed - minUsed) * scale) asInteger.
+ hOld := ((oldMemUsed - minUsed + 100000) * scale) asInteger.
+ hFree := (freeMem * scale) asInteger.
+
+ x := updateIndex - 1 + org.
+ y := height - 1.
+
+ self paint:newColor.
+ self displayLineFromX:x y:y toX:x y:(y - hAll).
- self paint:grey.
- self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - h).
+ self paint:oldColor.
+ self displayLineFromX:x y:y toX:x y:(y - hOld).
+
+ self paint:freeColor.
+ self displayLineFromX:x y:y-hOld toX:x y:(y - hOld + hFree).
+
+ self paint:White on:Black.
- self paint:White.
- self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - hOld).
+ self paint:newColor.
+ s := 'all ' , ((memUsed // 1024) printStringRightAdjustLen:5) , 'k '.
+ self displayOpaqueString:s x:0 y:(height // 2 - font height).
+
+ freeMem ~~ prevFree ifTrue:[
+ self paint:freeColor.
+ s := 'free' , ((freeMem // 1024) printStringRightAdjustLen:5) , 'k '.
+ self displayOpaqueString:s x:0 y:(height // 2 + font descent).
+ prevFree := freeMem.
+ ].
- s := (memUsed // 1024) printString , 'k'.
- thisStringLen := s size.
- (thisStringLen ~~ prevStringLen) ifTrue:[
- prevStringLen notNil ifTrue:[
- self displayOpaqueString:' ' from:1 to:prevStringLen
- x:0 y:(height // 2 + font ascent)
- ]
+ (oldMemUsed - freeMem) ~~ prevOld ifTrue:[
+ self paint:oldColor.
+ s := 'old ' , (((oldMemUsed - freeMem) // 1024) printStringRightAdjustLen:5) , 'k '.
+ self displayOpaqueString:s x:0 y:(height // 2 + font height + (font descent * 2)).
+ prevOld := (oldMemUsed - freeMem).
+ ].
+
+ (updateIndex >= (width - org)) ifTrue:[
+ half := ((width - org) // 2) // 8 * 8.
+ oldData replaceFrom:1 to:half with:oldData startingAt:(half + 1).
+ newData replaceFrom:1 to:half with:newData startingAt:(half + 1).
+ freeData replaceFrom:1 to:half with:freeData startingAt:(half + 1).
+
+ self catchExpose.
+ self copyFrom:self x:(half + org) y:0
+ toX:org y:0
+ width:(width - org - half) height:height.
+ self clearRectangleX:(width - half) y:0 width:(width - org - half) height:height.
+ self waitForExpose.
+ updateIndex := updateIndex - half + 1
+ ] ifFalse:[
+ updateIndex := updateIndex + 1
+ ].
].
- self paint:White on:Black.
- self displayOpaqueString:s x:0 y:(height // 2 + font ascent).
- prevStringLen := thisStringLen.
-
- (index >= (width - org)) ifTrue:[
- half := ((width - org) // 2) // 8 * 8.
- oldData replaceFrom:1 to:half with:oldData startingAt:(half + 1).
- newData replaceFrom:1 to:half with:newData startingAt:(half + 1).
-
- self copyFrom:self x:(half + org) y:0
- toX:org y:0
- width:(width - org - half) height:height.
- self clearRectangleX:(width - half "- org" "org + half") y:0 width:(width - org - half) height:height.
- index := index - half
- ] ifFalse:[
- index := index + 1
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock afterSeconds:updateInterval
].
- scaleChange := false.
- (memUsed < min) ifTrue:[
- min := memUsed.
- scaleChange := true
- ].
- (memUsed > max) ifTrue:[
- max := memUsed.
- scaleChange := true
- ].
- scaleChange ifTrue:[
- self clear.
- self redraw
- ].
- myBlock notNil ifTrue:[
- Processor addTimedBlock:myBlock after:delay
- ].
+
!
redraw
"redraw data"
- |h hOld memUsed oldMemUsed x half|
+ |hAll hOld hFree memUsed oldMemUsed newMemUsed freeMem x y half scale s|
realized ifFalse:[^ self].
+ shown ifFalse:[^ self].
+
+ "
+ redraw all ...
+ "
+ self clipRect:nil.
x := org.
- 1 to:(index - 1) do:[:i |
- oldMemUsed := (oldData at:i).
- memUsed := oldMemUsed + (newData at:i).
- h := (((memUsed - min) asFloat / (max - min) asFloat) * height) asInteger.
- hOld := (((oldMemUsed - min) asFloat / (max - min) asFloat) * height) asInteger.
+ y := height - 1.
+ scale := height asFloat / (maxUsed - minUsed + 200000).
+
+ 1 to:(updateIndex - 1) do:[:i |
+ newMemUsed := (newData at:i).
+ oldMemUsed := (oldData at:i).
+ freeMem := freeData at:i.
+ memUsed := oldMemUsed + newMemUsed.
+
+ hAll := ((memUsed - minUsed) * scale) asInteger.
+ hOld := ((oldMemUsed - minUsed + 100000) * scale) asInteger.
+ hFree := (freeMem * scale) asInteger.
+
+ self paint:newColor.
+ self displayLineFromX:x y:y toX:x y:(y - hAll).
+
+ self paint:oldColor.
+ self displayLineFromX:x y:y toX:x y:(y - hOld).
+
+ self paint:freeColor.
+ self displayLineFromX:x y:y-hOld toX:x y:(y - hOld + hFree).
- self paint:grey.
- self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - h).
+ x := x + 1
+ ].
+
+ self paint:White.
+ s := 'max ' , ((maxUsed // 1024) printStringRightAdjustLen:5) , 'k '.
+ self displayString:s x:0 y:font ascent.
+ s := 'min ' , ((minUsed // 1024) printStringRightAdjustLen:5) , 'k '.
+ self displayString:s x:0 y:(height - font descent).
+
+ prevFree := prevOld := nil.
- self paint:White.
- self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - hOld).
- x := x + 1
+ "
+ since everything was draw, throw away other expose events
+ "
+ self sensor flushExposeEvents.
+
+
+! !
+
+!MemoryMonitor methodsFor:'destroying'!
+
+destroy
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ ] ifFalse:[
+ myProcess terminate.
+ myProcess := nil
].
- self paint:White.
- self displayString:(((max // 1024) printString) , 'k') x:0 y:(font ascent).
- self displayString:(((min // 1024) printString) , 'k') x:0 y:(height - font descent)
+ super destroy
! !
!MemoryMonitor methodsFor:'events'!
keyPress:key x:x y:y
key == $f ifTrue:[
- delay := delay / 2
+ updateInterval := updateInterval / 2
].
key == $s ifTrue:[
- delay := delay * 2
+ updateInterval := updateInterval * 2
]
!
sizeChanged
- |nn no|
+ |nn no nf oldSize|
- ((width - org) == oldData size) ifTrue:[^ self].
+ oldSize := oldData size.
+ ((width - org) == oldSize) ifTrue:[^ self].
+
nn := Array new:width.
no := Array new:width.
- (nn size > newData size) ifTrue:[
- nn replaceFrom:1 to:(newData size) with:newData.
- no replaceFrom:1 to:(oldData size) with:oldData
+ nf := Array new:width.
+
+ (nn size > oldSize) ifTrue:[
+ nn replaceFrom:1 to:oldSize with:newData.
+ no replaceFrom:1 to:oldSize with:oldData.
+ nf replaceFrom:1 to:oldSize with:freeData
] ifFalse:[
- (index > nn size) ifTrue:[
- nn replaceFrom:1 to:(nn size) with:newData
- startingAt:(index - nn size + 1 ).
- no replaceFrom:1 to:(no size) with:oldData
- startingAt:(index - no size + 1 ).
- index := newData size - 1
- ] ifFalse:[
- nn replaceFrom:1 to:(nn size) with:newData.
- no replaceFrom:1 to:(no size) with:oldData
- ]
+ (updateIndex > nn size) ifTrue:[
+ nn replaceFrom:1 to:oldSize with:newData
+ startingAt:(updateIndex - oldSize + 1 ).
+ no replaceFrom:1 to:oldSize with:oldData
+ startingAt:(updateIndex - oldSize + 1 ).
+ nf replaceFrom:1 to:oldSize with:freeData
+ startingAt:(updateIndex - oldSize + 1 ).
+ updateIndex := oldSize - 1
+ ] ifFalse:[
+ nn replaceFrom:1 to:oldSize with:newData.
+ no replaceFrom:1 to:oldSize with:oldData.
+ nf replaceFrom:1 to:oldSize with:freeData
+ ]
].
newData := nn.
- oldData := no
+ oldData := no.
+ freeData := nf
! !
+
+!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.
+
+ halted := false.
+ 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:'used:9999k '.
+
+ maxUsed := ObjectMemory bytesUsed.
+ minUsed := ObjectMemory bytesUsed.
+ 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
+ "
+! !
+