#BUGFIX by cg
class: ProcessMonitorV2
fetch context in an interrupt save section
comment/format in: #fillItemInformationIn:
changed:
#getActiveStringFor:running:
#getWhereStringFor:running:
class: ProcessMonitorV2::ProcessItem
added: #processId:idVal:processGroup:groupVal:processStartTime:processName:processState:
comment/format in:
#groupVal
#groupVal:
#idVal
#idVal:
#processId:
--- a/ProcessMonitorV2.st Tue Mar 12 16:48:16 2019 +0100
+++ b/ProcessMonitorV2.st Tue Mar 12 18:11:44 2019 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2003 by eXept Software AG
All Rights Reserved
@@ -3253,17 +3255,19 @@
|stateCharacter|
isRunning ifTrue:[
- stateCharacter := '*'.
- ] ifFalse:[
- [
- (Processor scheduledProcesses includes:aProcess) ifTrue:[
- stateCharacter := '+'
- ] ifFalse:[
- stateCharacter := ''.
- ].
- ] valueUninterruptably.
+ ^ '*'.
].
+
+ [
+ (Processor scheduledProcesses includes:aProcess) ifTrue:[
+ stateCharacter := '+'
+ ] ifFalse:[
+ stateCharacter := ''.
+ ].
+ ] valueUninterruptably.
^ stateCharacter.
+
+ "Modified: / 12-03-2019 / 18:05:59 / Claus Gittinger"
!
getApplicationFor:aProcess
@@ -3489,106 +3493,105 @@
|c found skipping rs rc r sel|
con notNil ifTrue:[
- c := con.
- found := false.
- isRunning 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 selector == #waitWithTimeout: ifTrue:[
- found := true.
- ].
- c selector == #waitWithTimeoutMs: 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 |
- found ifFalse:[
- c notNil ifTrue:[
- ((r := c receiver) ~~ Processor and:[ r class ~~ Process ]) ifTrue:[
- found := true.
- ] ifFalse:[
- c := c sender.
- ]
- ]
- ]
- ]
- ].
-
- "/ skip, until an interesting context is found.
- "/ This skips intermediate contexts, which lead
- "/ to the sema-wait (for example, unwind blocks, delay-stuff etc.)
- found ifFalse:[
- c := con
- ].
- 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 == Semaphore or:[ c receiver class == Semaphore ] ]) ifTrue:[
- c := c sender.
- skipping := true.
- ].
- [
- c notNil
- and:[ c receiver isBlock
- and:[ (c selector startsWith:'value')
- or:[ c selector = 'doWhile:'
- or:[ c selector = 'doUntil:'
- or:[ c selector = 'ensure:' ]]]]]
- ] 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 ifTrue:[
- sel := c selector.
- sel isNil ifTrue:[
- sel := '* unknown *'
- ].
- r := c receiver.
- rc := r class.
- rs := rc name.
- (rc == SharedQueue
- or:[rc == RecursionLock]) ifTrue:[
- rs := rs , ' (', (r identityHash bitShift:-12) hexPrintString,') '.
- ].
- ^ (rs , '>>' , sel).
- ]
+ c := con.
+ found := false.
+ isRunning 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:[
+ ((sel := c selector) == #wait
+ or:[sel == #waitWithTimeout:
+ or:[sel == #waitWithTimeoutMs:]]
+ ) 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 |
+ found ifFalse:[
+ c notNil ifTrue:[
+ ((r := c receiver) ~~ Processor and:[ r class ~~ Process ]) ifTrue:[
+ found := true.
+ ] ifFalse:[
+ c := c sender.
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ "/ skip, until an interesting context is found.
+ "/ This skips intermediate contexts, which lead
+ "/ to the sema-wait (for example, unwind blocks, delay-stuff etc.)
+ found ifFalse:[
+ c := con
+ ].
+ skipping := true.
+ [ skipping ] whileTrue:[
+ skipping := false.
+ (c notNil and:[ (r := c receiver) == Delay or:[ r class == Delay ] ]) ifTrue:[
+ c := c sender.
+ skipping := true.
+ ].
+ (c notNil and:[ (r := c receiver) == Semaphore or:[ r class == Semaphore ] ]) ifTrue:[
+ c := c sender.
+ skipping := true.
+ ].
+ [
+ c notNil
+ and:[ c receiver isBlock
+ and:[ ((sel := c selector) startsWith:'value')
+ or:[ sel = 'doWhile:'
+ or:[ sel = 'doUntil:'
+ or:[ sel = 'ensure:' ]]]]]
+ ] 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 ifTrue:[
+ sel := c selector.
+ sel isNil ifTrue:[
+ sel := '* unknown *'
+ ].
+ r := c receiver.
+ rc := r class.
+ rs := rc name.
+ (rc == SharedQueue
+ or:[rc == RecursionLock]) ifTrue:[
+ rs := rs , ' (', (r identityHash bitShift:-12) hexPrintString,') '.
+ ].
+ ^ (rs , '>>' , sel).
+ ]
].
^ ''
"Modified: / 28-02-2012 / 11:43:30 / cg"
+ "Modified: / 12-03-2019 / 17:54:47 / Claus Gittinger"
!
getWindowTitleFor:aProcess
@@ -3659,52 +3662,63 @@
!ProcessMonitorV2 methodsFor:'update process'!
fillItemInformationIn:processItem
- |state stateColor running con aProcess|
+ |state stateColor stateString running con aProcess group|
aProcess := processItem processInstance.
aProcess isNil ifTrue:[
^ self.
].
-
- processItem processId:aProcess id.
- processItem idVal:aProcess id ? -1.
-
- processItem processGroup:(self getGroupStringFor:aProcess).
- processItem groupVal:(processItem processGroup isNumber ifTrue:[processItem processGroup] ifFalse:[-1]).
-
- processItem processStartTime:aProcess startTimestamp.
- processItem processName:aProcess name ? ''.
-
+ group := self getGroupStringFor:aProcess.
+
state := aProcess state.
running := (state == #run and:[aProcess == Processor interruptedProcess]).
-
stateColor := (state == #run)
ifTrue:[ Color green darkened ]
ifFalse:[
(state == #debug or:[state == #stopped])
ifTrue:[ Color red ]
ifFalse:[ Color black ]].
-
- processItem processState:(state asString withColor:stateColor).
+ stateString := state asString withColor:stateColor.
+
+ processItem
+ processId:(aProcess id)
+ idVal:(aProcess id ? -1)
+ processGroup:group
+ groupVal:(group isNumber ifTrue:[group] ifFalse:[-1])
+ processStartTime:aProcess startTimestamp
+ processName:(aProcess name ? '')
+ processState:stateString.
+
processItem processActive:(self getActiveStringFor:aProcess running:running).
-"/ processItem processBlocked:(aProcess interruptsDisabled).
+ "/ processItem processBlocked:(aProcess interruptsDisabled).
processItem prioVal:(aProcess priority).
processItem processPrio:(self getPrioStringFor:aProcess).
processItem processUsedStack:aProcess usedStackSize.
processItem processTotalStack:(self getTotalStackStringFor:aProcess).
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ].
- showWhere value ifTrue:[
- processItem processWhere:(self getWhereStringFor:con running:running).
- ].
- processItem processCurrentSegment:(self getCurrentSegmentStringFor:con).
+ "/ must be very careful here: the process might actually be
+ "/ resumed and con becomes invalid while we access it.
+ "/ this seems to be a bug in the current VM, in that it does not update
+ "/ the returned context-ref, when the method returns,
+ "/ AND the ref is from another process's local variable or a return value
+ "/ (it does, if it is ever stored into something...)
+ "/ Therefore, we must do this uninterruptably.
+ [
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+ showWhere value ifTrue:[
+ processItem processWhere:(self getWhereStringFor:con running:running).
+ ].
+ processItem processCurrentSegment:(self getCurrentSegmentStringFor:con).
+ con := nil.
+ ] valueUninterruptably.
+
processItem processSwitch:(aProcess numberOfStackBoundaryHits).
showApplication value ifTrue:[
processItem processApplication:(self getApplicationStringFor:aProcess)
@@ -3717,6 +3731,7 @@
].
"Modified: / 17-08-2011 / 11:04:32 / cg"
+ "Modified: / 12-03-2019 / 18:09:21 / Claus Gittinger"
!
fillItemInformationIn:processItem with:aProcess inArray:weakArrayWithProcesses atIndex:processInstanceIndexInWeakArray
@@ -4077,27 +4092,35 @@
!ProcessMonitorV2::ProcessItem methodsFor:'accessing'!
groupVal
- "return the value of the instance variable 'groupVal' (automatically generated)"
+ "return the groupId"
^ groupVal
+
+ "Modified (comment): / 12-03-2019 / 17:58:12 / Claus Gittinger"
!
-groupVal:something
- "set the value of the instance variable 'groupVal' (automatically generated)"
-
- groupVal := something.
+groupVal:groupIdInteger
+ "set the groupId"
+
+ groupVal := groupIdInteger.
+
+ "Modified (comment): / 12-03-2019 / 17:58:38 / Claus Gittinger"
!
idVal
- "return the value of the instance variable 'idVal' (automatically generated)"
+ "return the processId"
^ idVal
+
+ "Modified (comment): / 12-03-2019 / 17:58:19 / Claus Gittinger"
!
-idVal:something
- "set the value of the instance variable 'idVal' (automatically generated)"
-
- idVal := something.
+idVal:idInteger
+ "set the processId"
+
+ idVal := idInteger.
+
+ "Modified (comment): / 12-03-2019 / 17:58:29 / Claus Gittinger"
!
prioVal
@@ -4174,10 +4197,23 @@
^ processId
!
-processId:something
- "set the value of the instance variable 'processId' (automatically generated)"
-
- processId := something.
+processId:processIdArg
+ processId := processIdArg.
+
+ "Modified (comment): / 12-03-2019 / 17:57:05 / Claus Gittinger"
+!
+
+processId:processIdArg idVal:idArg processGroup:processGroupArg groupVal:groupValArg
+ processStartTime:processStartTimeArg processName:processNameArg processState:processStateArg
+ processId := processIdArg.
+ idVal := idArg.
+ processGroup := processGroupArg.
+ groupVal := groupValArg.
+ startTimestamp := processStartTimeArg.
+ processName := processNameArg.
+ processState := processStateArg.
+
+ "Created: / 12-03-2019 / 18:06:49 / Claus Gittinger"
!
processInstance