--- a/ProcessMonitor.st Mon May 31 15:31:56 1999 +0200
+++ b/ProcessMonitor.st Fri Jun 04 09:35:05 1999 +0200
@@ -158,253 +158,260 @@
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:[
- 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
- ]
- ].
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
- showDetail ifTrue:[
- line nextPutAll:(aProcess usedStackSize printStringLeftPaddedTo:11).
+ 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 interesting context is
+ "/ found.
+ "/ this skips intermediate contexts, which lead
+ "/ to the sema-wait (for example, unwind blocks,
+ "/ delay-stuff etc.)
- "/ skip, until an interesting 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.
+ ].
- 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.
+ ].
- [c notNil
- and:[c receiver isBlock
- and:[c selector startsWith:'value']]] whileTrue:[
- c := c sender.
- skipping := true.
- ].
+ [c notNil
+ and:[c receiver == OperatingSystem
+ and:[c selector == #unblockInterrupts]]] whileTrue:[
+ c := c sender.
+ skipping := true.
+ ].
- [c notNil and:[c isBlockContext]] whileTrue:[
- c := c home.
- 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.
+ (oldSelection notNil and:[oldSelection includesIdentical:aProcess]) ifTrue:[
+ newSelection add:dIndex+numHeaderLines.
+ ].
- 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"
@@ -723,5 +730,5 @@
!ProcessMonitor class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.69 1999-03-29 14:52:58 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.70 1999-06-04 07:35:05 cg Exp $'
! !