--- a/SemaphoreMonitor.st Sun Jan 12 23:30:25 2014 +0000
+++ b/SemaphoreMonitor.st Wed Apr 01 10:38:01 2015 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1997 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -23,7 +23,7 @@
copyright
"
COPYRIGHT (c) 1997 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -41,16 +41,16 @@
This view shows smalltalks semaphores - a debugging tool.
[see also:]
- Semaphore SemaphoreSet
- Process ProcessorScheduler
- WindowGroup
- ProcessMonitor
+ Semaphore SemaphoreSet
+ Process ProcessorScheduler
+ WindowGroup
+ ProcessMonitor
[author:]
- Claus Gittinger
+ Claus Gittinger
[start with:]
- SemaphoreMonitor open
+ SemaphoreMonitor open
"
! !
@@ -81,20 +81,20 @@
|newList|
shown ifTrue:[
- newList := Semaphore allSubInstances.
+ newList := Semaphore allSubInstances.
- "sort by hashKey - will not always generate unique numbers,
- but most of the time, this works ... for now"
+ "sort by hashKey - will not always generate unique numbers,
+ but most of the time, this works ... for now"
- newList sort:[:s1 :s2 | s1 identityHash < s2 identityHash].
+ newList sort:[:s1 :s2 | s1 identityHash < s2 identityHash].
- newList ~= semaphores ifTrue:[
- self updateStatus:newList
- ].
+ newList ~= semaphores ifTrue:[
+ self updateStatus:newList
+ ].
].
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"
@@ -108,119 +108,119 @@
|oldList list oldSelection newSelection|
shown ifTrue:[
- oldList := listView list.
- oldSelection := listView selectionValue.
- oldSelection notNil ifTrue:[
- oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
- newSelection := OrderedCollection new.
- ].
+ oldList := listView list.
+ oldSelection := listView selectionValue.
+ oldSelection notNil ifTrue:[
+ oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
+ newSelection := OrderedCollection new.
+ ].
- newSemaphoreList notNil ifTrue:[
- semaphores := WeakArray withAll:newSemaphoreList.
- ].
- semaphores notNil ifTrue:[
- list := OrderedCollection new:(semaphores size + 2).
- list add:self titleLine.
- list add:(String new:self titleLine size withAll:$-).
+ newSemaphoreList notNil ifTrue:[
+ semaphores := WeakArray withAll:newSemaphoreList.
+ ].
+ semaphores notNil ifTrue:[
+ list := OrderedCollection new:(semaphores size + 2).
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
- semaphores validElementsDo:[:aSemaphore |
- |waiters waitersNames nm id str owner color line count|
+ semaphores validElementsDo:[:aSemaphore |
+ |waiters waitersNames nm id str owner color line count|
- "/ need a copy - it may change while being enumerated
- [
- count := aSemaphore count.
- waiters := aSemaphore waitingProcesses copy.
- ] valueUninterruptably.
+ "/ need a copy - it may change while being enumerated
+ [
+ count := aSemaphore count.
+ waiters := aSemaphore waitingProcesses copy.
+ ] valueUninterruptably.
- str := '' writeStream.
- [
- waiters notNil ifTrue:[
- waiters do:[:aProcess |
- str nextPut:$[.
- aProcess id printOn:str.
- str nextPutAll:' '''.
- str nextPutAll:(aProcess name contractTo:40).
- str nextPutAll:'''<'.
- aProcess priority printOn:str.
- str nextPutAll:'>]'.
- str space.
- ].
- ]
- ] valueUninterruptably.
- waitersNames := str contents.
+ str := '' writeStream.
+ [
+ waiters notNil ifTrue:[
+ waiters do:[:aProcess |
+ str nextPut:$[.
+ aProcess id printOn:str.
+ str nextPutAll:' '''.
+ str nextPutAll:(aProcess name contractTo:40).
+ str nextPutAll:'''<'.
+ aProcess priority printOn:str.
+ str nextPutAll:'>]'.
+ str space.
+ ].
+ ]
+ ] valueUninterruptably.
+ waitersNames := str contents.
- (aSemaphore respondsTo:#name) ifTrue:[
- nm := aSemaphore name.
- nm isNil ifTrue:[
- nm := ''
- ]
- ] ifFalse:[
- nm := ''
- ].
- id := aSemaphore identityHash bitShift:-12.
- owner := aSemaphore lastOwnerId.
- owner isNil ifTrue:[
- owner := ' '
- ] ifFalse:[
- owner := owner printStringLeftPaddedTo:5
- ].
- line := (id printStringPaddedTo:6)
- , ' '
- , ((nm contractTo:25) paddedTo:25)
- , ' '
- , (count printStringLeftPaddedTo:3)
- , ' '
- , owner printString
- , ' '
- , (waiters size printStringLeftPaddedTo:3)
- , ' '
- , waitersNames.
+ (aSemaphore respondsTo:#name) ifTrue:[
+ nm := aSemaphore name.
+ nm isNil ifTrue:[
+ nm := ''
+ ]
+ ] ifFalse:[
+ nm := ''
+ ].
+ id := aSemaphore identityHash bitShift:-12.
+ owner := aSemaphore lastOwnerId.
+ owner isNil ifTrue:[
+ owner := ' '
+ ] ifFalse:[
+ owner := owner printStringLeftPaddedTo:5
+ ].
+ line := (id printStringPaddedTo:6)
+ , ' '
+ , ((nm contractTo:25) paddedTo:25)
+ , ' '
+ , (count printStringLeftPaddedTo:3)
+ , ' '
+ , owner printString
+ , ' '
+ , (waiters size printStringLeftPaddedTo:3)
+ , ' '
+ , waitersNames.
- count > 0 ifTrue:[
- waiters size > 0 ifTrue:[
- "this happens if a low priority process is ready to run but didn't wake up yet"
- color := Color red.
+ count > 0 ifTrue:[
+ waiters size > 0 ifTrue:[
+ "this happens if a low priority process is ready to run but didn't wake up yet"
+ color := Color red.
"/ self beep.
- ] ifFalse:[
- "fine, this semaphore is available"
- color := Color blue.
- ].
- line := line colorizeAllWith:color.
- ] ifFalse:[
- waiters size > 0 ifTrue:[
- line := line colorizeAllWith:Color brown.
- ].
- ].
-
- list add:line.
- oldSelection notNil ifTrue:[
- (oldSelection includes:id) ifTrue:[
- newSelection add:list size.
- ]
- ]
- ].
- ].
- "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.
- ].
- newSelection notNil ifTrue:[
- listView selectWithoutScroll:newSelection
- ].
- listView flush
+ ] ifFalse:[
+ "fine, this semaphore is available"
+ color := Color blue.
+ ].
+ line := line colorizeAllWith:color.
+ ] ifFalse:[
+ waiters size > 0 ifTrue:[
+ line := line colorizeAllWith:Color brown.
+ ].
+ ].
+
+ list add:line.
+ oldSelection notNil ifTrue:[
+ (oldSelection includes:id) ifTrue:[
+ newSelection add:list size.
+ ]
+ ]
+ ].
+ ].
+ "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.
+ ].
+ newSelection notNil ifTrue:[
+ listView selectWithoutScroll: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"
@@ -233,10 +233,10 @@
debugWaiters
"open a debugger on the selected semaphores waiting processes"
- self selectedSemaphoresDo:[:aSema |
- aSema waitingProcesses do:[:aProcess |
- DebugView openOn:aProcess
- ]
+ self selectedSemaphoresDo:[:aSema |
+ aSema waitingProcesses do:[:aProcess |
+ DebugView openOn:aProcess
+ ]
]
"Modified: / 23.1.1997 / 03:12:06 / cg"
@@ -255,10 +255,10 @@
inspectWaiters
"open an inspector on the selected semaphores waiting processes"
- self selectedSemaphoresDo:[:aSema |
- aSema waitingProcesses do:[:aProcess |
- aProcess inspect
- ]
+ self selectedSemaphoresDo:[:aSema |
+ aSema waitingProcesses do:[:aProcess |
+ aProcess inspect
+ ]
]
"Modified: / 23.1.1997 / 03:12:06 / cg"
@@ -274,27 +274,27 @@
sel isNil ifTrue:[^ self].
(sel isKindOf:Collection) ifTrue:[
- sel do:[:n |
- nr := n - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := semaphores 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 := semaphores at:nr.
+ (p notNil and:[p ~~ 0]) ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- nr := sel - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := semaphores at:nr.
- (p notNil and:[p ~~ 0]) ifTrue:[
- aBlock value:p
- ]
- ]
- ]
+ nr := sel - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := semaphores at:nr.
+ (p notNil and:[p ~~ 0]) ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
"Created: 23.1.1997 / 03:11:24 / cg"
@@ -316,34 +316,34 @@
|labels selectors m|
labels := resources array:#(
- 'Inspect'
- 'Inspect Waiters'
- 'Debug Waiters'
- '-'
- 'Signal'
- ).
+ 'Inspect'
+ 'Inspect Waiters'
+ 'Debug Waiters'
+ '-'
+ 'Signal'
+ ).
selectors := #(
- inspectSemaphore
- inspectWaiters
- debugWaiters
- nil
- signalSemaphore
- ).
+ inspectSemaphore
+ inspectWaiters
+ debugWaiters
+ nil
+ signalSemaphore
+ ).
updateProcess isNil ifTrue:[
- labels := (resources array:#('Update' '-')) , labels.
- selectors := #(updateView nil) , selectors
+ labels := (resources array:#('Update' '-')) , labels.
+ selectors := #(updateView nil) , selectors
].
m := PopUpMenu labels:labels
- selectors:selectors.
+ selectors:selectors.
listView hasSelection ifFalse:[
- m disableAll:#(
- inspectSemaphore
- signalSemaphore
- )
+ m disableAll:#(
+ inspectSemaphore
+ signalSemaphore
+ )
].
^ m
@@ -355,7 +355,7 @@
preferredExtent
"return my preferred extent"
- ^ (font widthOf:self titleLine) + 40 @ 250
+ ^ (self font widthOf:self titleLine) + 40 @ 250
"Modified: 23.1.1997 / 02:35:01 / cg"
"Created: 23.1.1997 / 03:04:58 / cg"
@@ -375,11 +375,6 @@
!SemaphoreMonitor class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SemaphoreMonitor.st,v 1.17 2013-02-08 18:42:22 stefan Exp $'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
+ ^ '$Header: /cvs/stx/stx/libtool/SemaphoreMonitor.st,v 1.18 2014-04-11 14:22:55 stefan Exp $'
! !