--- a/ProcessMonitor.st Thu Sep 28 21:27:16 1995 +0100
+++ b/ProcessMonitor.st Mon Oct 23 21:08:26 1995 +0100
@@ -14,8 +14,8 @@
SimpleView subclass:#ProcessMonitor
instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
- listUpdateBlock updateProcess hideDead runColor suspendedColor
- waitColor cpuUsages showDetail'
+ listUpdateBlock updateProcess hideDead runColor suspendedColor
+ waitColor cpuUsages showDetail'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -39,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.22 1995-09-28 20:27:16 cg Exp $
+$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.23 1995-10-23 20:08:21 cg Exp $
"
!
@@ -165,146 +165,148 @@
|oldList list line dIndex con interrupted plist|
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 c0 n found|
+ dIndex := 1.
+ 1 to:processes size do:[:index |
+ |aProcess nm st c c0 n found|
- 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).
+ 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).
- n := aProcess numberOfStackSegments.
- n == 0 ifTrue:[
- con := nil
- ] ifFalse:[
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ]
- ].
- showDetail ifTrue:[
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- line := line , '(' , n printString , ')'.
- con notNil ifTrue:[
- line := line , ' '.
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- line := line , ' .. '.
- c := con.
- [c sender notNil] whileTrue:[
- c := c sender
- ].
- line := line , ((ObjectMemory addressOf:c) printStringRadix:16).
- ] ifFalse:[
- line := line , (String new:20)
- ].
- line := line , ' '.
- line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
- ].
+ n := aProcess numberOfStackSegments.
+ n == 0 ifTrue:[
+ con := nil
+ ] ifFalse:[
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ]
+ ].
+ showDetail ifTrue:[
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ line := line , '(' , n printString , ')'.
+ con notNil ifTrue:[
+ line := line , ' '.
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ line := line , ' .. '.
+ c := con.
+ [c sender notNil] whileTrue:[
+ c := c sender
+ ].
+ line := line , ((ObjectMemory addressOf:c) printStringRadix:16).
+ ] ifFalse:[
+ line := line , (String new:20)
+ ].
+ line := line , ' '.
+ line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
+ ].
- con notNil ifTrue:[
- "/ search for a semaphore-wait in the top 10 contexts
- found := false.
- c := con.
- 1 to:10 do:[:n |
- found ifFalse:[
- c notNil ifTrue:[
- (c receiver isMemberOf: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 isBlockContext] whileTrue:[
- c := c home
- ].
- 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.
- ]
+ con notNil ifTrue:[
+ "/ search for a semaphore-wait in the top 10 contexts
+ found := false.
+ c := con.
+ 1 to:10 do:[:n |
+ found ifFalse:[
+ c notNil ifTrue:[
+ (c receiver isMemberOf: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.
+ ]
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
!
@@ -599,4 +601,3 @@
preferredExtent
^ (font widthOf:self titleLine) + 40 @ 100
! !
-