[Goodie] Squeak system load display

Bert Freudenberg bert at isgnw.CS.Uni-Magdeburg.De
Mon Mar 13 23:49:51 UTC 2000


"Change Set:            sqload-bf
Date:                   14 March 2000
Author:                 Bert Freudenberg

New Morph>Demo>LoadMorph displays a history of Squeak's system load. Load
measurement is based on the idle time in the World's interCyclePause."

Have fun!

  -Bert-
-------------- next part --------------
'From Squeak2.8alpha of 18 January 2000 [latest update: #1919] on 14 March 2000 at 12:43:19 am'!
"Change Set:		sqload-bf
Date:			14 March 2000
Author:			Bert Freudenberg

New Morph>Demo>LoadMorph displays a history of Squeak's system load. Load measurement is based on the idle time in the World's interCyclePause."!

Morph subclass: #LoadMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Demo'!

!LoadMorph commentStamp: 'bf 3/14/2000 00:41' prior: 0!
LoadMorph displays a history of Squeak's system load.

Load measurement is based on the idle time in the World's interCyclePause. The displayed average load is collected in the World's #loadHistoryLong property. Load calculation can be disabled by removing the World's #loadHistory property (which is where the short-term history is collected):
	World removeProperty: #loadHistory.		"To stop it"
	World removeProperty: #loadHistoryLong.	"To save space"

Note that you can also enable an immediate load meter without this morph:
	World setProperty: #loadHistory toValue: OrderedCollection new.
	World setProperty: #loadDisplay toValue: true.
!

!LoadMorph methodsFor: 'initialization' stamp: 'bf 3/14/2000 00:30'!
delete
	"Stop collecting load info in my world if noone else needs it"
	self world findDeepSubmorphThat:
			[:m | m class == self class and: [m ~~ self]]
		ifAbsent:
			[(self world valueOfProperty: #loadDisplay ifAbsent: [false])
				ifFalse: [self world removeProperty: #loadHistory;
					removeProperty: #loadHistoryLong]].
	super delete.
	! !

!LoadMorph methodsFor: 'initialization' stamp: 'bf 3/14/2000 00:15'!
initialize
	super initialize.
	color _ Color red.
	self extent: 120 at 40.
! !

!LoadMorph methodsFor: 'drawing' stamp: 'bf 3/14/2000 00:17'!
drawOn: aCanvas
	| data startTime deltaTime r l h |
	data _ self world valueOfProperty: #loadHistoryLong
		ifAbsent: [^super drawOn: aCanvas].
	"data _ Array with: data last."
	"Draw"
	startTime _ data first key.
	deltaTime _ data last key - startTime + 1.
	bounds _ self bounds.
	r _ 0.
	data do: [:each |
		l _ r.
		r _ each key + 1 - startTime * bounds width // deltaTime. 
		h _ each value * bounds height // 100.
		aCanvas fillRectangle: ((bounds left + l) @ (bounds bottom - h)
				corner: (bounds left + r) @ (bounds bottom))
			color: color]! !

!LoadMorph methodsFor: 'stepping' stamp: 'bf 3/13/2000 22:14'!
step
	self changed! !

!LoadMorph methodsFor: 'stepping' stamp: 'bf 3/14/2000 00:38'!
stepTime
	^ 250! !

!LoadMorph methodsFor: 'stepping' stamp: 'bf 3/14/2000 00:22'!
wantsSteps
	"Enable collecting data"
	(self world hasProperty: #loadHistory) ifFalse:
		[self world setProperty: #loadHistory toValue: OrderedCollection new].
	^ true! !


!PasteUpMorph methodsFor: 'world state' stamp: 'bf 3/13/2000 21:50'!
interCyclePause: milliSecs
	"delay enough that the next interaction cycle won't happen too soon after the original; thus, if all the system is doing is polling for interaction, the overall CPU usage of Squeak will be low"
	| currentTime wait |
	currentTime _ Time millisecondClockValue.
	self lastCycleTime ifNotNil: [ 
		wait _ self lastCycleTime + milliSecs - currentTime.
		(self hasProperty: #loadHistory) ifTrue:
			[self recordIdleTime: wait of: milliSecs at: currentTime].
		wait > 0 ifTrue: [ 
			wait < milliSecs  "big waits happen after a snapshot"
				ifTrue: [ (Delay forMilliseconds: wait) wait ]. ]. ].
	self lastCycleTime: currentTime! !

!PasteUpMorph methodsFor: 'interaction loop' stamp: 'bf 3/13/2000 22:07'!
recordIdleTime: idleMSecs of: maxMSecs at: currentMSecs
	"Record the current load in my properties.
	To enable recording, set my property #loadHistory to an empty OrderedCollection. To disable, remove that property"

	| load averageLoad history longHistory currentSecs |
	maxMSecs <= 0 ifTrue: [^self].

	"Current load"
	load _ (maxMSecs - idleMSecs) * 100 // maxMSecs.
	load _ load min: 100 max: 0.

	"Short term history - all samples in the last second"
	history _ self valueOfProperty: #loadHistory ifAbsent: [^self].
	[history isEmpty not and: [(currentMSecs - history first key between: 1 and: 1000) not]]
		whileTrue: [history removeFirst].
	history addLast: currentMSecs -> load.
	self setProperty: #loadHistory toValue: history.

	"Calculate average load for last second"
	history size < 2 ifTrue: [^ self].
	averageLoad _ 0.
	history inject: history first into: [:prev :this |
		averageLoad _ averageLoad + ((this key - prev key) * prev value). this].
	averageLoad _ averageLoad // (history last key - history first key).
	(averageLoad between: 0 and: 100) ifFalse: [^self "should not happen"].

	"Long history: average loads of last 60 seconds"
	currentSecs _ currentMSecs // 1000.
	longHistory _ self valueOfProperty: #loadHistoryLong ifAbsent: [OrderedCollection new].
	[longHistory isEmpty not and: [(currentSecs - longHistory first key between: 0 and: 60) not]]
		whileTrue: [longHistory removeFirst].
	(longHistory isEmpty or: [longHistory last key ~= currentSecs])
		ifTrue: [longHistory add: currentSecs -> averageLoad]
		ifFalse: [longHistory last value: averageLoad].
	self setProperty: #loadHistoryLong toValue: longHistory.
	
	(self valueOfProperty: #loadDisplay ifAbsent: [false]) ifTrue:
		[Display fill: (0 at 0 corner: load at 5) fillColor: Color red;
			fill: (load at 0 corner: 100 at 5) fillColor: Color green.
		Display fill: (0 at 5 corner: averageLoad at 10) fillColor: Color red;
			fill: (averageLoad at 5 corner: 100 at 10) fillColor: Color green]! !


LoadMorph removeSelector: #startStepping!


More information about the Squeak-dev mailing list