--- a/ProcessMonitor.st Thu Sep 24 12:07:12 1998 +0200
+++ b/ProcessMonitor.st Thu Sep 24 12:07:31 1998 +0200
@@ -42,35 +42,35 @@
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)
[see also:]
- Process ProcessorScheduler
- WindowGroup
- SemaphoreMonitor
+ Process ProcessorScheduler
+ WindowGroup
+ SemaphoreMonitor
[author:]
- Claus Gittinger
+ Claus Gittinger
[start with:]
- ProcessMonitor open
+ ProcessMonitor open
"
! !
@@ -100,9 +100,9 @@
titleLine
showDetail ifTrue:[
- Processor supportDynamicPriorities ifTrue:[
+ Processor supportDynamicPriorities ifTrue:[
^ 'id group name state prio usedStack totalStack current-segment switch where'.
- ].
+ ].
^ 'id group name state prio usedStack totalStack current-segment switch where'.
].
^ 'id group name state prio where '.
@@ -117,32 +117,32 @@
|newList|
shown ifTrue:[
- showDetail ifTrue:[
- newList := Process allSubInstances asOrderedCollection.
- ] ifFalse:[
- newList := ProcessorScheduler knownProcesses asOrderedCollection.
- ].
+ showDetail ifTrue:[
+ newList := Process allSubInstances asOrderedCollection.
+ ] 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
].
"Modified: 3.7.1996 / 13:37:29 / stefan"
@@ -162,253 +162,253 @@
nameLength := self class nameLengthInList.
shown ifTrue:[
- oldList := listView list.
- processes notNil ifTrue:[
- oldSelection := listView selection.
- oldSelection notNil ifTrue:[
- oldSelection := oldSelection collect:[:idx | |pI|
- pI := idx-numHeaderLines.
- (pI > processes size or:[pI < 1]) ifTrue:[
- nil
- ] ifFalse:[
- processes at:pI
- ]
- ].
- newSelection := OrderedCollection new.
- ].
+ oldList := listView list.
+ processes notNil ifTrue:[
+ oldSelection := listView selection.
+ oldSelection notNil ifTrue:[
+ oldSelection := oldSelection collect:[:idx | |pI|
+ pI := idx-numHeaderLines.
+ (pI > processes size or:[pI < 1]) ifTrue:[
+ nil
+ ] ifFalse:[
+ processes at:pI
+ ]
+ ].
+ newSelection := OrderedCollection new.
+ ].
- list := OrderedCollection new:(processes size + numHeaderLines).
- list add:self titleLine.
- list add:(String new:self titleLine size withAll:$-).
+ list := OrderedCollection new:(processes size + numHeaderLines).
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
- interrupted := Processor interruptedProcess.
+ interrupted := Processor interruptedProcess.
- dIndex := 1.
- index := 1.
+ dIndex := 1.
+ index := 1.
- "/ use while-loop;
- "/ processList may change size ....
+ "/ use while-loop;
+ "/ processList may change size ....
- [index <= processes size] whileTrue:[
- aProcess := processes at:index.
- index := index + 1.
+ [index <= processes size] whileTrue:[
+ aProcess := processes at:index.
+ index := index + 1.
- (aProcess notNil
- and:[aProcess ~~ 0]) ifTrue:[
- ((id := aProcess id) notNil or:[hideDead not]) ifTrue:[
- (oldSelection notNil and:[oldSelection includesIdentical:aProcess]) ifTrue:[
- newSelection add:index+numHeaderLines.
- ].
-
- line := WriteStream on:(String new:200).
+ (aProcess notNil
+ and:[aProcess ~~ 0]) ifTrue:[
+ ((id := aProcess id) notNil or:[hideDead not]) ifTrue:[
+ line := WriteStream on:(String new:200).
- id printOn:line paddedTo:6.
- gId := aProcess processGroupId.
- gId == id ifTrue:[
- "/ a group leader
- '- ' printOn:line.
- ] ifFalse:[
- gId printOn:line paddedTo:6.
- ].
+ id printOn:line paddedTo:6.
+ gId := aProcess processGroupId.
+ gId == id ifTrue:[
+ "/ a group leader
+ '- ' printOn:line.
+ ] ifFalse:[
+ gId printOn:line paddedTo:6.
+ ].
- (nm := aProcess name) isNil ifFalse:[
- nm := nm printStringPaddedTo:(nameLength-1).
- nm size >= nameLength ifTrue:[
- nm := (nm contractTo:(nameLength-1)).
- ].
- line nextPutAll:nm; nextPut:space.
- ] ifTrue:[
- line next:(nameLength) put:space.
- ].
+ (nm := aProcess name) isNil ifFalse:[
+ nm := nm printStringPaddedTo:(nameLength-1).
+ nm size >= nameLength ifTrue:[
+ nm := (nm contractTo:(nameLength-1)).
+ ].
+ line nextPutAll:nm; nextPut:space.
+ ] ifTrue:[
+ line next:(nameLength) put:space.
+ ].
"/ n := cpuUsages at:(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:[
- [
- (Processor scheduledProcesses includes:aProcess) ifTrue:[
- c := ' +'
- ] ifFalse:[
- c := ' '.
- ].
- ] valueUninterruptably.
- running := false.
- ].
- line nextPutAll:c; nextPutAll:(st printStringPaddedTo:9).
- line nextPutAll:(aProcess priority printStringLeftPaddedTo:3).
+ st := aProcess state.
+ (st == #run
+ and:[aProcess == interrupted]) ifTrue:[
+ c := ' *'.
+ running := true.
+ ] ifFalse:[
+ [
+ (Processor scheduledProcesses includes:aProcess) ifTrue:[
+ c := ' +'
+ ] ifFalse:[
+ c := ' '.
+ ].
+ ] valueUninterruptably.
+ running := false.
+ ].
+ line nextPutAll:c; nextPutAll:(st printStringPaddedTo:9).
+ line nextPutAll:(aProcess priority printStringLeftPaddedTo:3).
- (showDetail
- and:[Processor supportDynamicPriorities]) ifTrue:[
- (r := aProcess priorityRange) isNil ifTrue:[
- line nextPutAll:' '.
- ] ifFalse:[
- line nextPutAll:((
- ' ['
- , (r start printString)
- , '..'
- , (r stop printString)
- , ']') paddedTo:7).
- ].
- ].
+ (showDetail
+ and:[Processor supportDynamicPriorities]) ifTrue:[
+ (r := aProcess priorityRange) isNil ifTrue:[
+ line nextPutAll:' '.
+ ] ifFalse:[
+ line nextPutAll:((
+ ' ['
+ , (r start printString)
+ , '..'
+ , (r stop printString)
+ , ']') paddedTo:7).
+ ].
+ ].
+
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+
+ showDetail ifTrue:[
+ line nextPutAll:(aProcess usedStackSize printStringLeftPaddedTo:11).
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ].
-
- showDetail ifTrue:[
- line nextPutAll:(aProcess usedStackSize printStringLeftPaddedTo:11).
+ id == 0 ifTrue:[
+ line nextPutAll:('unlimited' leftPaddedTo:14).
+ ] ifFalse:[
+ n := aProcess numberOfStackSegments.
+ line nextPutAll:(aProcess totalStackSize printStringLeftPaddedTo:10).
+ line nextPutAll:(('(' , n printString , ')') paddedTo:4).
+ ].
+ con notNil ifTrue:[
+ line nextPutAll:' '.
+ line nextPutAll:(((ObjectMemory addressOf:con) printStringRadix:16) leftPaddedTo:8 with:$0).
+ line nextPutAll:' .. '.
- id == 0 ifTrue:[
- line nextPutAll:('unlimited' leftPaddedTo:14).
- ] ifFalse:[
- n := aProcess numberOfStackSegments.
- line nextPutAll:(aProcess totalStackSize printStringLeftPaddedTo:10).
- line nextPutAll:(('(' , n printString , ')') paddedTo:4).
- ].
- con notNil ifTrue:[
- line nextPutAll:' '.
- line nextPutAll:(((ObjectMemory addressOf:con) printStringRadix:16) leftPaddedTo:8 with:$0).
- line nextPutAll:' .. '.
+ contextCount := 1.
+ c := con.
+ [(sender := c sender) notNil] whileTrue:[
+ c := sender.
+ contextCount := contextCount + 1.
+ ].
+ line nextPutAll:(((ObjectMemory addressOf:c) printStringRadix:16) leftPaddedTo:8 with:$0).
+ ] ifFalse:[
+ line next:20 put:space.
+ ].
+ line nextPut:space.
+ line nextPutAll:(aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:6).
+ ].
- contextCount := 1.
- c := con.
- [(sender := c sender) notNil] whileTrue:[
- c := sender.
- contextCount := contextCount + 1.
- ].
- line nextPutAll:(((ObjectMemory addressOf:c) printStringRadix:16) leftPaddedTo:8 with:$0).
- ] ifFalse:[
- line next:20 put:space.
- ].
- line nextPut:space.
- line nextPutAll:(aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:6).
- ].
+ con notNil ifTrue:[
+ c := con.
+ found := false.
+ running ifFalse:[
+ "/ search for a semaphore-wait in the top 10 contexts
- con notNil ifTrue:[
- c := con.
- found := false.
- running ifFalse:[
- "/ search for a semaphore-wait in the top 10 contexts
+ 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:[
+ "/ search for a non-processor, non-process
+ "/ receiver in the top 10 contexts
- 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:[
- "/ search for a non-processor, non-process
- "/ receiver in the top 10 contexts
+ c := con.
+ 1 to:10 do:[:n |
+ |r|
- c := con.
- 1 to:10 do:[:n |
- |r|
+ found ifFalse:[
+ c notNil ifTrue:[
+ ((r := c receiver) ~~ Processor
+ and:[r class ~~ Process]) ifTrue:[
+ found := true.
+ ] ifFalse:[
+ c := c sender.
+ ]
+ ]
+ ]
+ ]
+ ].
+ found ifFalse:[
+ c := con
+ ].
- found ifFalse:[
- c notNil ifTrue:[
- ((r := c receiver) ~~ Processor
- and:[r class ~~ Process]) ifTrue:[
- found := true.
- ] ifFalse:[
- c := c sender.
- ]
- ]
- ]
- ]
- ].
- found ifFalse:[
- c := con
- ].
+ "/ skip, until an interresting context is
+ "/ found.
+ "/ this skips intermediate contexts, which lead
+ "/ to the sema-wait (for example, unwind blocks,
+ "/ delay-stuff etc.)
- "/ skip, until an interresting context is
- "/ found.
- "/ this skips intermediate contexts, which lead
- "/ to the sema-wait (for example, unwind blocks,
- "/ delay-stuff etc.)
+ skipping := true.
+ [skipping] whileTrue:[
+ skipping := false.
+ (c notNil
+ and:[c receiver == Delay
+ or:[c receiver class == Delay]]) ifTrue:[
+ c := c sender.
+ skipping := true.
+ ].
+
+ [c notNil
+ and:[c receiver isBlock
+ and:[c selector startsWith:'value']]] whileTrue:[
+ c := c sender.
+ skipping := true.
+ ].
- skipping := true.
- [skipping] whileTrue:[
- skipping := false.
- (c notNil
- and:[c receiver == Delay
- or:[c receiver class == Delay]]) ifTrue:[
- c := c sender.
- skipping := true.
- ].
+ [c notNil and:[c isBlockContext]] whileTrue:[
+ c := c home.
+ skipping := true.
+ ].
+ ].
- [c notNil
- and:[c receiver isBlock
- and:[c selector startsWith:'value']]] whileTrue:[
- c := c sender.
- skipping := true.
- ].
-
- [c notNil and:[c isBlockContext]] whileTrue:[
- c := c home.
- skipping := true.
- ].
- ].
+ c notNil ifTrue:[
+ sel := c selector.
+ sel isNil ifTrue:[
+ sel := '* unknown *'
+ ].
+ line nextPutAll:' '.
+ line nextPutAll:c receiver class name.
+ line nextPutAll:'>>'; nextPutAll:sel.
+ ]
+ ].
+ list add:line contents.
+ processes at:dIndex put:aProcess.
+ (oldSelection notNil and:[oldSelection includesIdentical:aProcess]) ifTrue:[
+ newSelection add:dIndex+numHeaderLines.
+ ].
- c notNil ifTrue:[
- sel := c selector.
- sel isNil ifTrue:[
- sel := '* unknown *'
- ].
- line nextPutAll:' '.
- line nextPutAll:c receiver class name.
- line nextPutAll:'>>'; nextPutAll:sel.
- ]
- ].
- list add:line contents.
- processes at:dIndex put:aProcess.
- dIndex := dIndex + 1
- ]
- ].
- ].
- dIndex to:processes size do:[:index |
- processes at:index put:nil
- ]
- ].
+ 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.
+ "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.
- oldSelection notNil ifTrue:[
- listView selection:newSelection.
- ]
- ].
+ oldSelection notNil ifTrue:[
+ listView selection:newSelection.
+ ]
+ ].
"/ listView flush
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
"Modified: / 3.7.1996 / 13:56:01 / stefan"
@@ -424,11 +424,11 @@
showDetail := Smalltalk at:#SystemDebugging ifAbsent:false.
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
].
"
@@ -509,7 +509,7 @@
"abort (raise AbortSignal in) the selected process"
self selectedProcessesDo:[:p |
- p restart.
+ p restart.
]
!
@@ -527,81 +527,81 @@
|labels selectors m sel allRestartable|
device ctrlDown ifTrue:[
- labels := resources array:#(
- '\c detail'
- ).
- selectors := #(
- toggleDetail
- ).
+ labels := resources array:#(
+ '\c detail'
+ ).
+ selectors := #(
+ toggleDetail
+ ).
] ifFalse:[
- labels := resources array:#(
- 'inspect'
- 'debug'
- '-'
- 'resume'
- 'suspend'
- 'stop'
- '-'
- 'abort'
- 'terminate'
- 'terminate group'
+ labels := resources array:#(
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'stop'
+ '-'
+ 'abort'
+ 'terminate'
+ 'terminate group'
"/ 'hard terminate'
- 'restart'
- '-'
- 'raise prio'
- 'lower prio'
- ).
- selectors := #(
- inspectSelection
- debugProcess
- nil
- resumeProcess
- suspendProcess
- stopProcess
- nil
- abortProcess
- terminateProcess
- terminateProcessGroup
+ 'restart'
+ '-'
+ 'raise prio'
+ 'lower prio'
+ ).
+ selectors := #(
+ inspectSelection
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ stopProcess
+ nil
+ abortProcess
+ terminateProcess
+ terminateProcessGroup
"/ hardTerminateProcess
- restartProcess
- nil
- raisePrio
- lowerPrio
- ).
- updateProcess isNil ifTrue:[
- labels := (resources array:#('update' '-')) , labels.
- selectors := #(updateView nil) , selectors
- ].
+ restartProcess
+ nil
+ raisePrio
+ lowerPrio
+ ).
+ updateProcess isNil ifTrue:[
+ labels := (resources array:#('update' '-')) , labels.
+ selectors := #(updateView nil) , selectors
+ ].
].
m := PopUpMenu labels:labels
- selectors:selectors.
+ selectors:selectors.
listView hasSelection ifFalse:[
- m disableAll:#(
- inspectSelection
- debugProcess
- resumeProcess
- suspendProcess
- stopProcess
- restartProcess
- abortProcess
- terminateProcess
- terminateProcessGroup
- raisePrio
- lowerPrio
- )
+ m disableAll:#(
+ inspectSelection
+ debugProcess
+ resumeProcess
+ suspendProcess
+ stopProcess
+ restartProcess
+ abortProcess
+ terminateProcess
+ terminateProcessGroup
+ raisePrio
+ lowerPrio
+ )
] ifTrue:[
- allRestartable := true.
- self selectedProcessesDo:[:p |
- p isRestartable ifFalse:[
- allRestartable := false
- ].
- ].
- allRestartable ifFalse:[
- m disable:#restartProcess
- ].
+ allRestartable := true.
+ self selectedProcessesDo:[:p |
+ p isRestartable ifFalse:[
+ allRestartable := false
+ ].
+ ].
+ allRestartable ifFalse:[
+ m disable:#restartProcess
+ ].
].
m checkToggleAt:#toggleDetail put:showDetail.
@@ -656,27 +656,27 @@
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 and:[p ~~ 0]) ifTrue:[
- aBlock value:p
- ]
- ]
- ]
- ]
+ sel do:[:n |
+ nr := n - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ (p notNil and:[p ~~ 0]) ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- nr := sel - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- (p notNil and:[p ~~ 0]) ifTrue:[
- aBlock value:p
- ]
- ]
- ]
+ nr := sel - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ (p notNil and:[p ~~ 0]) ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
"Modified: 23.1.1997 / 03:10:53 / cg"
@@ -686,7 +686,7 @@
"send a message to all selected processes"
self selectedProcessesDo:[:p |
- p perform:aSelector
+ p perform:aSelector
].
self updateView.
@@ -706,5 +706,5 @@
!ProcessMonitor class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.65 1998-09-08 11:24:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.66 1998-09-24 10:07:31 cg Exp $'
! !