--- a/ProcessMonitor.st Thu Sep 21 14:26:50 1995 +0200
+++ b/ProcessMonitor.st Thu Sep 28 21:27:16 1995 +0100
@@ -10,12 +10,12 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 24-mar-1995 at 11:25:51 am'!
+'From Smalltalk/X, Version:2.10.7 on 29-sep-1995 at 02:24:01' !
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.21 1995-09-12 10:51:40 claus Exp $
+$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.22 1995-09-28 20:27:16 cg Exp $
"
!
@@ -103,13 +103,25 @@
"
! !
+!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 list'.
+ ^ 'id name state prio usedStack totalStack current-segment switches where'.
].
- ^ 'id name state prio usedStack totalStack'.
+ ^ 'id name state prio usedStack where'.
!
updateList
@@ -153,104 +165,146 @@
|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 n|
+ 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).
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- showDetail ifTrue:[
- n := aProcess numberOfStackSegments.
- line := line , '(' , n printString , ')'.
- n == 0 ifTrue:[
- con := nil
- ] ifFalse:[
- 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).
- ] ifFalse:[
- line := line , (String new:20)
- ].
- line := line , ' '.
- line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
- ].
- 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).
+
+ 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.
+ ]
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
!
@@ -259,6 +313,21 @@
self updateStatus
! !
+!ProcessMonitor methodsFor:'events'!
+
+keyPress:key x:x y:y
+ <resource: #keyboard ( #InspectIt ) >
+
+ key == #InspectIt ifTrue:[
+ ^ self inspectProcess.
+ ].
+ ^ super keyPress:key x:x y:y
+!
+
+canHandle:key
+ ^ key == #InspectIt
+! !
+
!ProcessMonitor methodsFor:'initialization'!
initialize
@@ -363,85 +432,8 @@
self startUpdateProcess.
! !
-!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:'menu actions'!
-hideDead:aBoolean
- hideDead := aBoolean
-!
-
-terminateProcess
- "terminate the selected process"
-
- self selectedProcessesSend:#terminate
-!
-
-debugProcess
- "open a debugger on the selected process"
-
- self selectedProcessesDo:[:p |
- Debugger openOn:p
- ]
-!
-
-abortProcess
- "abort (raise AbortSignal in) the selected process"
-
- self selectedProcessesDo:[:p |
- p interruptWith:[AbortSignal raise]
- ]
-!
-
-inspectProcess
- "open an inspector on the selected process"
-
- self selectedProcessesSend:#inspect
-!
-
-resumeProcess
- "resume the selected process (i.e. let it run) "
-
- self selectedProcessesSend:#resume
-!
-
processMenu
|labels selectors m|
@@ -492,6 +484,49 @@
^ m
!
+terminateProcess
+ "terminate the selected process"
+
+ self selectedProcessesSend:#terminate
+!
+
+hideDead:aBoolean
+ hideDead := aBoolean
+!
+
+debugProcess
+ "open a debugger on the selected process"
+
+ self selectedProcessesDo:[:p |
+ Debugger openOn:p
+ ]
+!
+
+abortProcess
+ "abort (raise AbortSignal in) the selected process"
+
+ self selectedProcessesDo:[:p |
+ p interruptWith:[AbortSignal raise]
+ ]
+!
+
+inspectProcess
+ "open an inspector on the selected process"
+
+ self selectedProcessesSend:#inspect
+!
+
+detail
+ showDetail := showDetail not.
+ self updateView
+!
+
+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"
@@ -518,23 +553,45 @@
self selectedProcessesDo:[:p |
p priority:(p priority - 1)
]
-!
-
-detail
- showDetail := showDetail not.
- self updateView
! !
-!ProcessMonitor methodsFor:'destroying'!
+!ProcessMonitor methodsFor:'private'!
+
+selectedProcessesDo:aBlock
+ |p nr sel|
-destroy
- updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor removeTimedBlock:listUpdateBlock.
+ 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:[
- updateProcess notNil ifTrue:[updateProcess terminate]
+ nr := sel - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
- super destroy
+!
+
+selectedProcessesSend:aSelector
+ self selectedProcessesDo:[:p |
+ p perform:aSelector
+ ].
+ self updateView.
! !
!ProcessMonitor methodsFor:'queries'!
@@ -543,17 +600,3 @@
^ (font widthOf:self titleLine) + 40 @ 100
! !
-!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
-! !