'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 8 October 2005 at 9:55:45 pm'!
ProgressMorph subclass: #MemoryUsage
instanceVariableNames: 'prevUsage'
classVariableNames: ''
poolDictionaries: ''
category: 'Hungry-FN'!
!MemoryUsage commentStamp: 'fn 10/8/2005 21:54' prior: 0!
A Morph to display the current VM memory used.
Do "MemoryUsage new openInWorld" or "MemoryUsage example".
author: Faried Nawaz <st@pain.hungry.com>
with a memory display patch from Jeff Sparkes <JSparkes@databeacon.com> (10/22/2004).
with a bugfix for Squeak 3.7 and up from <humasect@shaw.ca> (12/11/2004-ish, applied
10/08/2005).
!
!MemoryUsage methodsFor: 'initialization' stamp: 'fn 10/25/2004 23:19'!
initLabelMorph
^ labelMorph _ StringMorph
contents: ''
font: (self fontOfPointSize: 12)! !
!MemoryUsage methodsFor: 'initialization' stamp: 'fn 10/25/2004 23:19'!
initSubLabelMorph
^ subLabelMorph _ StringMorph
contents: ''
font: (self fontOfPointSize: 8)! !
!MemoryUsage methodsFor: 'initialization' stamp: 'fn 8/6/2003 17:27'!
initialize
super initialize. self label: 'Memory Usage'! !
!MemoryUsage methodsFor: 'step' stamp: 'fn 10/8/2005 21:51'!
step
| total used usedNow |
total _ SmalltalkImage current vmParameterAt: 3.
used _ SmalltalkImage current vmParameterAt: 2.
usedNow _ used / total roundTo: 0.01.
prevUsage = usedNow
ifFalse: [super step.
prevUsage _ usedNow.
self done: prevUsage.
self subLabel: ((used / (1024 * 1024)) asFloat roundTo: 0.1) asString , 'M/' , ((total / (1024 * 1024)) asFloat roundTo: 0.1) asString , 'M = ' , ((used / total roundTo: 0.001)
* 100) asString , '%']! !
!MemoryUsage methodsFor: 'step' stamp: 'fn 8/6/2003 18:05'!
stepTime
"Update every 5 seconds to avoid hogging the system."
^ 5000! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MemoryUsage class
instanceVariableNames: ''!
!MemoryUsage class methodsFor: 'example' stamp: 'fn 8/6/2003 16:53'!
example
"MemoryUsage example"
| mem |
mem _ MemoryUsage label: 'Memory Usage'.
mem openInWorld.
^ self.
! !