"
COPYRIGHT (c) 1993 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.
"
SimpleView subclass:#ProcessMonitor
instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
listUpdateBlock updateProcess hideDead runColor suspendedColor
waitColor cpuUsages showDetail'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
!
!ProcessMonitor class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 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.
"
!
documentation
"
This view shows smalltalks (light-weight) processes, and also offers
a popup menu for various useful operations on them.
Especially 'debug' is useful, to see what a process is currently
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)
prio - the processes priority (1..30)
usedStack - the current stack use
totalStack - the stack currently allocated (i.e. the maximum ever needed)
"
! !
!ProcessMonitor class methodsFor:'defaults'!
defaultIcon
|i|
i := Image fromFile:'ProcMon.xbm'.
i notNil ifTrue:[^ i].
^ StandardSystemView defaultIcon
!
defaultLabel
^ 'Process Monitor'
! !
!ProcessMonitor class methodsFor:'startup'!
open
|top monitor|
top := StandardSystemView new.
monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top.
top extent:monitor preferredExtent.
top label:self defaultLabel.
top icon:self defaultIcon.
top open
"
ProcessMonitor open
"
! !
!ProcessMonitor methodsFor:'destroying'!
destroy
updateBlock notNil ifTrue:[
Processor removeTimedBlock:updateBlock.
Processor removeTimedBlock:listUpdateBlock.
] ifFalse:[
updateProcess notNil ifTrue:[updateProcess terminate]
].
super destroy
! !
!ProcessMonitor methodsFor:'drawing'!
titleLine
showDetail ifTrue:[
^ 'id name state prio usedStack totalStack current-segment switches where'.
].
^ 'id name state prio usedStack where'.
!
updateList
"update list of processes"
|newList|
shown ifTrue:[
showDetail ifTrue:[
newList := Process allInstances asOrderedCollection.
] ifFalse:[
newList := ProcessorScheduler knownProcesses asOrderedCollection.
].
newList := newList select:[:p | p id notNil].
"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
].
].
updateBlock notNil ifTrue:[
Processor removeTimedBlock:listUpdateBlock.
Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
].
!
updateStatus
"update status display of processes"
|oldList list line dIndex con interrupted plist aProcess nm st c c0 n found sender running|
shown ifTrue:[
oldList := listView list.
processes notNil ifTrue:[
list := OrderedCollection new.
list add:self titleLine.
list add:(String new:self titleLine size withAll:$-).
interrupted := Processor interruptedProcess.
dIndex := 1.
1 to:processes size do:[:index |
|totalStack|
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 := ' *'.
running := true.
] ifFalse:[
c := ' '.
running := false.
].
line := line , c , (st printStringPaddedTo:9).
line := line , (aProcess priority printStringLeftPaddedTo:3).
line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
n := aProcess numberOfStackSegments.
true "showDetail" ifTrue:[
con := aProcess suspendedContext.
con isNil ifTrue:[
aProcess == Processor activeProcess ifTrue:[
con := thisContext
]
].
].
showDetail ifTrue:[
aProcess id == 0 ifTrue:[
line := line , ('unlimited' leftPaddedTo:13).
] ifFalse:[
line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
line := line , '(' , n printString , ')'.
].
con notNil ifTrue:[
line := line , ' '.
line := line , (((ObjectMemory addressOf:con) printStringRadix:16) leftPaddedTo:8 with:$0).
line := line , ' .. '.
c := con.
[(sender := c sender) notNil] whileTrue:[
c := sender
].
line := line , (((ObjectMemory addressOf:c) printStringRadix:16) leftPaddedTo:8 with:$0).
] ifFalse:[
line := line , (String new:20)
].
line := line , ' '.
line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
].
con notNil ifTrue:[
c := con.
running ifFalse:[
"/ search for a semaphore-wait in the top 10 contexts
found := false.
1 to:10 do:[:n |
found ifFalse:[
c notNil ifTrue:[
(c receiver class == Semaphore) ifTrue:[
c selector == #wait ifTrue:[
found := true.
]
].
c := c sender.
]
]
].
found ifFalse:[
c := con.
1 to:10 do:[:n |
found ifFalse:[
c notNil ifTrue:[
(c receiver ~~ Processor) ifTrue:[
found := true.
] ifFalse:[
c := c sender.
]
]
]
]
].
found ifFalse:[
c := con
].
].
[c notNil and:[c isBlockContext]] whileTrue:[
c := c home
].
c notNil ifTrue:[
n := c receiver class name , '>>' , c selector.
line := line , ' ' , n
]
].
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.
].
listView flush
].
updateBlock notNil ifTrue:[
Processor removeTimedBlock:updateBlock.
Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
"Modified: 23.12.1995 / 17:40:21 / cg"
!
updateView
self updateList.
self updateStatus
! !
!ProcessMonitor methodsFor:'events'!
canHandle:key
^ key == #InspectIt
!
keyPress:key x:x y:y
<resource: #keyboard ( #InspectIt ) >
key == #InspectIt ifTrue:[
^ self inspectProcess.
].
^ super keyPress:key x:x y:y
! !
!ProcessMonitor methodsFor:'initialization'!
initialize
|v|
super initialize.
hideDead := true.
showDetail := Smalltalk at:#SystemDebugging ifAbsent:false.
v := HVScrollableView for:SelectionInListView miniScrollerH:true in:self.
v origin:0.0@0.0 corner:1.0@1.0.
"/ self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.
listView := v scrolledView.
listView font:font.
listView menuHolder:self; menuPerformer:self; menuMessage:#processMenu.
listView multipleSelectOk:true.
listView delegate:(KeyboardForwarder toView:self).
updateDelay := 0.5.
listUpdateDelay := 5.
"/ event mode is no longer used;
"/ this event support may vanish
ProcessorScheduler isPureEventDriven ifTrue:[
updateBlock := [self updateStatus].
listUpdateBlock := [self updateList].
].
device hasColors ifTrue:[
runColor := Color green.
suspendedColor := Color yellow.
waitColor := Color red.
] ifFalse:[
runColor := suspendedColor := waitColor := Color black
]
"
ProcessMonitor open
"
"Modified: 22.12.1995 / 22:50:58 / cg"
!
mapped
super mapped.
self updateStatus.
self updateList.
!
realize
super realize.
waitColor := waitColor on:device.
runColor := runColor on:device.
suspendedColor := suspendedColor on:device.
self startUpdateProcess.
!
reinitialize
updateProcess := nil.
super reinitialize.
self startUpdateProcess.
"Created: 22.12.1995 / 22:48:37 / cg"
"Modified: 22.12.1995 / 22:51:14 / cg"
!
startUpdateProcess
updateBlock notNil ifTrue:[
Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
] ifFalse:[
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 |
"/ cpuUsages := IdentityDictionary new.
"/ 1 to:25 do:[:i |
"/ (Delay forSeconds:0.02) wait.
"/ id := Processor interruptedProcess id.
"/ 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)
].
! !
!ProcessMonitor methodsFor:'menu actions'!
abortProcess
"abort (raise AbortSignal in) the selected process"
self selectedProcessesDo:[:p |
p interruptWith:[AbortSignal raise]
]
!
debugProcess
"open a debugger on the selected process"
self selectedProcessesDo:[:p |
Debugger openOn:p
]
!
detail
showDetail := showDetail not.
self updateView
!
hideDead:aBoolean
hideDead := aBoolean
!
inspectProcess
"open an inspector on the selected process"
self selectedProcessesSend:#inspect
!
lowerPrio
"lower the selected processes priority"
self selectedProcessesDo:[:p |
p priority:(p priority - 1)
]
!
processMenu
|labels selectors m|
device ctrlDown ifTrue:[
labels := resources array:#(
'\c detail'
).
selectors := #(
detail
).
] ifFalse:[
labels := resources array:#(
'inspect'
'debug'
'-'
'resume'
'suspend'
'stop'
'abort'
'terminate'
'-'
'raise prio'
'lower prio'
).
selectors := #(
inspectProcess
debugProcess
nil
resumeProcess
suspendProcess
stopProcess
abortProcess
terminateProcess
nil
raisePrio
lowerPrio
).
updateProcess isNil ifTrue:[
labels := (resources array:#('update' '-')) , labels.
selectors := #(updateView nil) , selectors
].
].
m := PopUpMenu labels:labels
selectors:selectors.
m checkToggleAt:#detail put:showDetail.
^ m
!
raisePrio
"raise the selected processes priority"
self selectedProcessesDo:[:p |
p priority:(p priority + 1)
]
!
resumeProcess
"resume the selected process (i.e. let it run) "
self selectedProcessesSend:#resume
!
stopProcess
"stop the selected process - not even interrupts will wake it up"
self selectedProcessesSend:#stop
!
suspendProcess
"suspend the selected process - interrupts will let it run again"
self selectedProcessesSend:#suspend
!
terminateProcess
"terminate the selected process"
self selectedProcessesSend:#terminate
! !
!ProcessMonitor methodsFor:'private'!
selectedProcessesDo:aBlock
|p nr sel|
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
]
]
]
]
] ifFalse:[
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
].
self updateView.
! !
!ProcessMonitor methodsFor:'queries'!
preferredExtent
^ (font widthOf:self titleLine) + 40 @ 100
! !
!ProcessMonitor class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.30 1996-02-28 14:43:10 cg Exp $'! !