--- a/ProcessMonitor.st Sun Mar 26 22:18:34 1995 +0200
+++ b/ProcessMonitor.st Fri Mar 31 05:07:47 1995 +0200
@@ -14,8 +14,8 @@
View subclass:#ProcessMonitor
instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
- listUpdateBlock updateProcess hideDead runColor suspendedColor
- waitColor cpuUsages'
+ listUpdateBlock updateProcess hideDead runColor suspendedColor
+ waitColor cpuUsages'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.8 1995-03-25 22:24:39 claus Exp $
+$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.9 1995-03-31 03:07:32 claus Exp $
"
!
@@ -51,24 +51,24 @@
doing.
The information shown is:
- id - the numeric id of the process
- name - the name (if any) of the process
- (the name has no semantic meaning; it exists for the processMonitor only)
- state - what is it doing;
- wait - waiting on a semaphore
- eventWait - waiting on a view-event semaphore
- ioWait - waiting on an io-semaphore
- timeWait - waiting for a time-semaphore
- run - run, but currently not scheduled
- active - really running (this info is useless, since at
- update time, its always the update process which is
- running)
- suspended - suspended; not waiting on a semaphore
- light - not yet started (i.e. has no stack yet)
+ id - the numeric id of the process
+ name - the name (if any) of the process
+ (the name has no semantic meaning; it exists for the processMonitor only)
+ state - what is it doing;
+ wait - waiting on a semaphore
+ eventWait - waiting on a view-event semaphore
+ ioWait - waiting on an io-semaphore
+ timeWait - waiting for a time-semaphore
+ run - run, but currently not scheduled
+ active - really running (this info is useless, since at
+ update time, its always the update process which is
+ running)
+ suspended - suspended; not waiting on a semaphore
+ light - not yet started (i.e. has no stack yet)
- prio - the processes priority (1..30)
- usedStack - the current stack use
- totalStack - the stack currently allocated (i.e. the maximum ever needed)
+ prio - the processes priority (1..30)
+ usedStack - the current stack use
+ totalStack - the stack currently allocated (i.e. the maximum ever needed)
"
! !
@@ -116,32 +116,32 @@
|newList|
shown ifTrue:[
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
- newList := Process allInstances.
- ] ifFalse:[
- newList := ProcessorScheduler knownProcesses asOrderedCollection.
- ].
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ newList := Process allInstances.
+ ] ifFalse:[
+ newList := ProcessorScheduler knownProcesses asOrderedCollection.
+ ].
- "sort by id - take care of nil ids of dead processes"
- newList sort:[:p1 :p2 |
- |id1 id2|
+ "sort by id - take care of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
- (p1 isNil or:[(id1 := p1 id) isNil])
- ifTrue:[true]
- ifFalse:[
- (p2 isNil or:[(id2 := p2 id) isNil])
- ifTrue:[false]
- ifFalse:[id1 < id2]
- ]
- ].
- newList ~= processes ifTrue:[
- processes := WeakArray withAll:newList.
- self updateStatus
- ].
+ (p1 isNil or:[(id1 := p1 id) isNil])
+ ifTrue:[true]
+ ifFalse:[
+ (p2 isNil or:[(id2 := p2 id) isNil])
+ ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:listUpdateBlock.
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
+ Processor removeTimedBlock:listUpdateBlock.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
].
!
@@ -151,95 +151,95 @@
|oldList list line dIndex con interrupted|
shown ifTrue:[
- oldList := listView list.
- processes notNil ifTrue:[
- list := OrderedCollection new.
- list add:self titleLine.
- list add:(String new:self titleLine size withAll:$-).
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
- interrupted := Processor interruptedProcess.
+ interrupted := Processor interruptedProcess.
- dIndex := 1.
- 1 to:processes size do:[:index |
- |aProcess nm st c n|
+ dIndex := 1.
+ 1 to:processes size do:[:index |
+ |aProcess nm st c n|
- aProcess := processes at:index.
- aProcess notNil ifTrue:[
- (aProcess id notNil or:[hideDead not]) ifTrue:[
- line := aProcess id printStringPaddedTo:5.
- (nm := aProcess name) isNil ifFalse:[
- nm := nm printString
- ] ifTrue:[
- nm := ' '
- ].
- nm size >= 29 ifTrue:[
- nm := (nm contractTo:28) , ' '
- ] ifFalse:[
- nm := (nm printStringPaddedTo:29).
- ].
- line := line , nm.
+ aProcess := processes at:index.
+ aProcess notNil ifTrue:[
+ (aProcess id notNil or:[hideDead not]) ifTrue:[
+ line := aProcess id printStringPaddedTo:5.
+ (nm := aProcess name) isNil ifFalse:[
+ nm := nm printString
+ ] ifTrue:[
+ nm := ' '
+ ].
+ nm size >= 29 ifTrue:[
+ nm := (nm contractTo:28) , ' '
+ ] ifFalse:[
+ nm := (nm printStringPaddedTo:29).
+ ].
+ line := line , nm.
"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
"/ n ~~ 0 ifTrue:[
"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
"/ ] ifFalse:[
"/ line := line , ' '
"/ ].
- st := aProcess state.
- (st == #run
- and:[aProcess == interrupted]) ifTrue:[
- c := ' *'.
- ] ifFalse:[
- c := ' '.
- ].
- line := line , c , (st printStringPaddedTo:9).
- line := line , (aProcess priority printStringLeftPaddedTo:3).
- line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- line := line , '(' , aProcess numberOfStackSegments printString , ')'.
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ].
- con notNil ifTrue:[
- line := line , ' '.
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- line := line , ' .. '.
- [con sender notNil] whileTrue:[
- con := con sender
- ].
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- ]
- ].
- list add:line.
- processes at:dIndex put:aProcess.
- dIndex := dIndex + 1
- ]
- ].
- ].
- dIndex to:processes size do:[:index |
- processes at:index put:nil
- ]
- ].
- "avoid flicker"
- (oldList notNil and:[oldList size == list size]) ifTrue:[
- list keysAndValuesDo:[:idx :entry |
- (oldList at:idx) ~= entry ifTrue:[
- listView at:idx put:entry
- ]
- ]
- ] ifFalse:[
- listView setList:list.
- "the first two entries cannot be selected"
- listView attributeAt:1 put:#disabled.
- listView attributeAt:2 put:#disabled.
- ]
+ st := aProcess state.
+ (st == #run
+ and:[aProcess == interrupted]) ifTrue:[
+ c := ' *'.
+ ] ifFalse:[
+ c := ' '.
+ ].
+ line := line , c , (st printStringPaddedTo:9).
+ line := line , (aProcess priority printStringLeftPaddedTo:3).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ line := line , '(' , aProcess numberOfStackSegments printString , ')'.
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+ con notNil ifTrue:[
+ line := line , ' '.
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ line := line , ' .. '.
+ [con sender notNil] whileTrue:[
+ con := con sender
+ ].
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ ]
+ ].
+ list add:line.
+ processes at:dIndex put:aProcess.
+ dIndex := dIndex + 1
+ ]
+ ].
+ ].
+ dIndex to:processes size do:[:index |
+ processes at:index put:nil
+ ]
+ ].
+ "avoid flicker"
+ (oldList notNil and:[oldList size == list size]) ifTrue:[
+ list keysAndValuesDo:[:idx :entry |
+ (oldList at:idx) ~= entry ifTrue:[
+ listView at:idx put:entry
+ ]
+ ]
+ ] ifFalse:[
+ listView setList:list.
+ "the first two entries cannot be selected"
+ listView attributeAt:1 put:#disabled.
+ listView attributeAt:2 put:#disabled.
+ ]
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
!
@@ -268,7 +268,7 @@
listView model:self; menu:#processMenu.
listView multipleSelectOk:true.
- listView keyboardHandler:self.
+ listView delegate:(KeyboardForwarder to:self).
updateDelay := 0.5.
listUpdateDelay := 5.
@@ -276,16 +276,16 @@
"/ true
ProcessorScheduler isPureEventDriven
ifTrue:[
- updateBlock := [self updateStatus].
- listUpdateBlock := [self updateList].
+ updateBlock := [self updateStatus].
+ listUpdateBlock := [self updateList].
].
device hasColors ifTrue:[
- runColor := Color green.
- suspendedColor := Color yellow.
- waitColor := Color red.
+ runColor := Color green.
+ suspendedColor := Color yellow.
+ waitColor := Color red.
] ifFalse:[
- runColor := suspendedColor := waitColor := Color black
+ runColor := suspendedColor := waitColor := Color black
]
"
@@ -303,23 +303,23 @@
super realize.
updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
] ifFalse:[
- updateProcess := [
- Process terminateSignal handle:[:ex |
- updateProcess := nil
- ] do:[
- |id cnt|
+ updateProcess := [
+ Process terminateSignal handle:[:ex |
+ updateProcess := nil
+ ] do:[
+ |id cnt|
- "
- every 20ms, we look which process runs;
- every half second, the status is updated.
- every 5 seconds, the list of processes is
- built up again
- "
- [true] whileTrue:[
- 1 to:9 do:[:i |
+ "
+ every 20ms, we look which process runs;
+ every half second, the status is updated.
+ every 5 seconds, the list of processes is
+ built up again
+ "
+ [true] whileTrue:[
+ 1 to:9 do:[:i |
"/ cpuUsages := IdentityDictionary new.
"/ 1 to:25 do:[:i |
"/ (Delay forSeconds:0.02) wait.
@@ -327,21 +327,21 @@
"/ cnt := cpuUsages at:id ifAbsent:[0].
"/ cpuUsages at:id put:cnt + 1.
"/ ].
- (Delay forSeconds:0.5) wait.
- self updateStatus.
- ].
- (Delay forSeconds:0.5) wait.
- self updateList.
- ]
- ]
- ] forkAt:(Processor userSchedulingPriority + 1).
- updateProcess name:'monitor [' ,
- Processor activeProcess id printString ,
- '] update'.
- "
- raise my own priority
- "
- Processor activeProcess priority:(Processor userSchedulingPriority + 2)
+ (Delay forSeconds:0.5) wait.
+ self updateStatus.
+ ].
+ (Delay forSeconds:0.5) wait.
+ self updateList.
+ ]
+ ]
+ ] forkAt:(Processor userSchedulingPriority + 1).
+ updateProcess name:'monitor [' ,
+ Processor activeProcess id printString ,
+ '] update'.
+ "
+ raise my own priority
+ "
+ Processor activeProcess priority:(Processor userSchedulingPriority + 2)
].
waitColor := waitColor on:device.
runColor := runColor on:device.
@@ -356,33 +356,33 @@
sel := listView selection.
sel isNil ifTrue:[^ self].
(sel isKindOf:Collection) ifTrue:[
- sel do:[:n |
- nr := n - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- p notNil ifTrue:[
- aBlock value:p
- ]
- ]
- ]
- ]
+ sel do:[:n |
+ nr := n - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- nr := sel - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- p notNil ifTrue:[
- aBlock value:p
- ]
- ]
- ]
+ nr := sel - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
!
selectedProcessesSend:aSelector
self selectedProcessesDo:[:p |
- p perform:aSelector
+ p perform:aSelector
].
self updateView.
! !
@@ -426,39 +426,39 @@
"/
"/ '\c hide dead'
"/ '-'
- 'inspect'
- 'debug'
- '-'
- 'resume'
- 'suspend'
- 'abort'
- 'terminate'
- '-'
- 'raise prio'
- 'lower prio'
- ).
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'abort'
+ 'terminate'
+ '-'
+ 'raise prio'
+ 'lower prio'
+ ).
selectors := #(
"/ hideDead:
"/ nil
- inspectProcess
- debugProcess
- nil
- resumeProcess
- suspendProcess
- abortProcess
- terminateProcess
- nil
- raisePrio
- lowerPrio
- ).
+ inspectProcess
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ abortProcess
+ terminateProcess
+ nil
+ raisePrio
+ lowerPrio
+ ).
updateProcess isNil ifTrue:[
- labels := (resources array:#('update' '-')) , labels.
- selectors := #(updateView nil) , selectors
+ labels := (resources array:#('update' '-')) , labels.
+ selectors := #(updateView nil) , selectors
].
m := PopUpMenu labels:labels
- selectors:selectors.
+ selectors:selectors.
"/ m checkToggleAt:#hideDead: put:hideDead.
@@ -485,10 +485,10 @@
destroy
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor removeTimedBlock:listUpdateBlock.
+ Processor removeTimedBlock:updateBlock.
+ Processor removeTimedBlock:listUpdateBlock.
] ifFalse:[
- updateProcess notNil ifTrue:[updateProcess terminate]
+ updateProcess notNil ifTrue:[updateProcess terminate]
].
super destroy
! !