author | Claus Gittinger <cg@exept.de> |
Mon, 20 Jan 2020 21:02:47 +0100 | |
changeset 19422 | c6ca1c3e0fd7 |
parent 19056 | 9bb181a447f7 |
permissions | -rw-r--r-- |
19056 | 1 |
"{ Encoding: utf8 }" |
2 |
||
980 | 3 |
" |
4 |
COPYRIGHT (c) 1997 by Claus Gittinger |
|
14202 | 5 |
All Rights Reserved |
980 | 6 |
|
7 |
This software is furnished under a license and may be used |
|
8 |
only in accordance with the terms of that license and with the |
|
9 |
inclusion of the above copyright notice. This software may not |
|
10 |
be provided or otherwise made available to, or used by, any |
|
11 |
other person. No title to or ownership of the software is |
|
12 |
hereby transferred. |
|
13 |
" |
|
4253 | 14 |
"{ Package: 'stx:libtool' }" |
15 |
||
17169 | 16 |
"{ NameSpace: Smalltalk }" |
17 |
||
982 | 18 |
SystemStatusMonitor subclass:#SemaphoreMonitor |
980 | 19 |
instanceVariableNames:'semaphores' |
20 |
classVariableNames:'' |
|
21 |
poolDictionaries:'' |
|
1053 | 22 |
category:'Monitors-ST/X' |
980 | 23 |
! |
24 |
||
25 |
!SemaphoreMonitor class methodsFor:'documentation'! |
|
26 |
||
27 |
copyright |
|
28 |
" |
|
29 |
COPYRIGHT (c) 1997 by Claus Gittinger |
|
14202 | 30 |
All Rights Reserved |
980 | 31 |
|
32 |
This software is furnished under a license and may be used |
|
33 |
only in accordance with the terms of that license and with the |
|
34 |
inclusion of the above copyright notice. This software may not |
|
35 |
be provided or otherwise made available to, or used by, any |
|
36 |
other person. No title to or ownership of the software is |
|
37 |
hereby transferred. |
|
38 |
" |
|
39 |
||
40 |
||
41 |
! |
|
42 |
||
43 |
documentation |
|
44 |
" |
|
17169 | 45 |
This view shows smalltalk's semaphores - a debugging tool. |
980 | 46 |
|
17169 | 47 |
[disclaimer:] |
48 |
this is one of the oldest tools in the system, written in the early 90's. |
|
49 |
It does in no way reflect the way GUIs are designed/written these days. |
|
50 |
||
980 | 51 |
[see also:] |
17169 | 52 |
Semaphore SemaphoreSet |
53 |
Process ProcessorScheduler |
|
54 |
WindowGroup |
|
55 |
ProcessMonitor |
|
980 | 56 |
|
57 |
[author:] |
|
17169 | 58 |
Claus Gittinger |
980 | 59 |
|
60 |
[start with:] |
|
17169 | 61 |
SemaphoreMonitor open |
980 | 62 |
" |
63 |
! ! |
|
64 |
||
65 |
!SemaphoreMonitor class methodsFor:'defaults'! |
|
66 |
||
67 |
defaultLabel |
|
68 |
^ 'Semaphore Monitor' |
|
69 |
||
70 |
"Created: 23.1.1997 / 02:52:53 / cg" |
|
71 |
! ! |
|
72 |
||
73 |
!SemaphoreMonitor methodsFor:'drawing'! |
|
74 |
||
75 |
titleLine |
|
17226 | 76 |
^ 'Id Name Count Owner Waiting Process(es)'. |
980 | 77 |
|
78 |
" |
|
79 |
SemaphoreMonitor open |
|
80 |
" |
|
81 |
||
1692 | 82 |
"Modified: / 17.6.1998 / 14:52:48 / cg" |
980 | 83 |
! |
84 |
||
85 |
updateList |
|
86 |
"update list of semaphores" |
|
87 |
||
88 |
|newList| |
|
89 |
||
90 |
shown ifTrue:[ |
|
17226 | 91 |
"sort by hashKey - will not always generate unique numbers, |
92 |
but most of the time, this works ... for now" |
|
17443 | 93 |
newList := SortedCollection sortBlock:[:s1 :s2 | s1 identityHash < s2 identityHash]. |
94 |
Semaphore allSubInstancesDo:[:each| |
|
95 |
newList add:each. |
|
96 |
]. |
|
97 |
(newList isSameSequenceAs:semaphores) ifFalse:[ |
|
17226 | 98 |
self updateStatus:newList |
99 |
]. |
|
980 | 100 |
]. |
17226 | 101 |
self installDelayedUpdate. |
980 | 102 |
|
17443 | 103 |
"Created: / 23-01-1997 / 02:44:48 / cg" |
104 |
"Modified: / 14-12-1999 / 20:52:44 / cg" |
|
105 |
"Modified: / 24-02-2017 / 13:44:09 / stefan" |
|
980 | 106 |
! |
107 |
||
2487
4ac80975b91d
avoid loosing the selection when the list is updated
Claus Gittinger <cg@exept.de>
parents:
1838
diff
changeset
|
108 |
updateStatus:newSemaphoreList |
980 | 109 |
"update status display of semaphores" |
110 |
||
19056 | 111 |
|numberOfHeadlines oldList list oldSelection newSelection| |
980 | 112 |
|
113 |
shown ifTrue:[ |
|
19056 | 114 |
numberOfHeadlines := self numberOfHeadlines. |
17169 | 115 |
oldList := listView list. |
116 |
oldSelection := listView selectionValue. |
|
117 |
oldSelection notNil ifTrue:[ |
|
19056 | 118 |
oldSelection := oldSelection |
119 |
collect:[:line | line asCollectionOfWords first asNumber]. |
|
17169 | 120 |
newSelection := OrderedCollection new. |
121 |
]. |
|
980 | 122 |
|
17169 | 123 |
newSemaphoreList notNil ifTrue:[ |
124 |
semaphores := WeakArray withAll:newSemaphoreList. |
|
125 |
]. |
|
126 |
semaphores notNil ifTrue:[ |
|
19056 | 127 |
list := OrderedCollection new:(semaphores size + numberOfHeadlines). |
17169 | 128 |
list add:self titleLine. |
129 |
list add:(String new:self titleLine size withAll:$-). |
|
980 | 130 |
|
17169 | 131 |
semaphores validElementsDo:[:aSemaphore | |
132 |
|waiters waitersNames nm id str owner color line count| |
|
980 | 133 |
|
17169 | 134 |
"/ need a copy - it may change while being enumerated |
135 |
[ |
|
136 |
count := aSemaphore count. |
|
137 |
waiters := aSemaphore waitingProcesses copy. |
|
138 |
] valueUninterruptably. |
|
980 | 139 |
|
17169 | 140 |
str := '' writeStream. |
17443 | 141 |
waiters notEmptyOrNil ifTrue:[ |
142 |
waiters do:[:aProcess | |
|
143 |
str nextPut:$[. |
|
144 |
aProcess id printOn:str. |
|
145 |
str nextPutAll:' '''. |
|
146 |
str nextPutAll:(aProcess name contractTo:40). |
|
147 |
str nextPutAll:'''<'. |
|
148 |
aProcess priority printOn:str. |
|
149 |
str nextPutAll:'>]'. |
|
150 |
str space. |
|
151 |
]. |
|
152 |
]. |
|
17169 | 153 |
waitersNames := str contents. |
980 | 154 |
|
17169 | 155 |
(aSemaphore respondsTo:#name) ifTrue:[ |
156 |
nm := aSemaphore name. |
|
157 |
nm isNil ifTrue:[ |
|
17423 | 158 |
nm := aSemaphore className. |
17169 | 159 |
] |
160 |
] ifFalse:[ |
|
17443 | 161 |
nm := aSemaphore className. |
17169 | 162 |
]. |
163 |
id := aSemaphore identityHash bitShift:-12. |
|
164 |
owner := aSemaphore lastOwnerId. |
|
165 |
owner isNil ifTrue:[ |
|
17226 | 166 |
owner := '' |
17169 | 167 |
] ifFalse:[ |
17226 | 168 |
owner := owner printString |
17169 | 169 |
]. |
17226 | 170 |
owner := owner leftPaddedTo:6. |
171 |
||
17169 | 172 |
line := (id printStringPaddedTo:6) |
173 |
, ' ' |
|
174 |
, ((nm contractTo:25) paddedTo:25) |
|
175 |
, ' ' |
|
176 |
, (count printStringLeftPaddedTo:3) |
|
177 |
, ' ' |
|
178 |
, owner printString |
|
179 |
, ' ' |
|
180 |
, (waiters size printStringLeftPaddedTo:3) |
|
181 |
, ' ' |
|
182 |
, waitersNames. |
|
12399 | 183 |
|
17169 | 184 |
count > 0 ifTrue:[ |
17443 | 185 |
waiters notEmpty ifTrue:[ |
17169 | 186 |
"this happens if a low priority process is ready to run but didn't wake up yet" |
187 |
color := Color red. |
|
12399 | 188 |
"/ self beep. |
17169 | 189 |
] ifFalse:[ |
190 |
"fine, this semaphore is available" |
|
191 |
color := Color blue. |
|
192 |
]. |
|
193 |
line := line colorizeAllWith:color. |
|
194 |
] ifFalse:[ |
|
17443 | 195 |
waiters notEmpty ifTrue:[ |
196 |
"someone waits on the Semaphore" |
|
17169 | 197 |
line := line colorizeAllWith:Color brown. |
198 |
]. |
|
199 |
]. |
|
14202 | 200 |
|
17169 | 201 |
list add:line. |
202 |
oldSelection notNil ifTrue:[ |
|
203 |
(oldSelection includes:id) ifTrue:[ |
|
204 |
newSelection add:list size. |
|
205 |
] |
|
206 |
] |
|
207 |
]. |
|
208 |
]. |
|
17443 | 209 |
|
17169 | 210 |
"avoid flicker" |
211 |
(oldList notNil and:[oldList size == list size]) ifTrue:[ |
|
212 |
list keysAndValuesDo:[:idx :entry | |
|
213 |
(oldList at:idx) ~= entry ifTrue:[ |
|
214 |
listView at:idx put:entry |
|
215 |
] |
|
216 |
] |
|
217 |
] ifFalse:[ |
|
218 |
listView setList:list. |
|
19056 | 219 |
"the first few entries cannot be selected" |
220 |
1 to:numberOfHeadlines do:[:lNr | listView attributeAt:lNr put:#disabled]. |
|
17169 | 221 |
]. |
222 |
newSelection notNil ifTrue:[ |
|
223 |
listView selectWithoutScroll:newSelection |
|
224 |
]. |
|
225 |
listView flush |
|
980 | 226 |
]. |
17226 | 227 |
self installDelayedUpdate. |
980 | 228 |
|
17423 | 229 |
"Created: / 14-12-1999 / 20:52:29 / cg" |
17443 | 230 |
"Modified: / 24-02-2017 / 13:39:25 / stefan" |
980 | 231 |
! ! |
232 |
||
233 |
!SemaphoreMonitor methodsFor:'menu'! |
|
234 |
||
17226 | 235 |
debugLastOwningProcess |
236 |
"open a debugger on the selected semaphores' (last) owning processes" |
|
1692 | 237 |
|
14202 | 238 |
self selectedSemaphoresDo:[:aSema | |
17226 | 239 |
|p| |
240 |
||
241 |
(p := aSema lastOwner) notNil ifTrue:[ |
|
242 |
DebugView openOn:p |
|
243 |
] |
|
244 |
] |
|
245 |
! |
|
246 |
||
247 |
debugWaiters |
|
248 |
"open a debugger on the selected semaphores' waiting processes" |
|
249 |
||
250 |
self selectedSemaphoresDo:[:aSema | |
|
251 |
aSema waitingProcesses do:[:aProcess | |
|
252 |
DebugView openOn:aProcess |
|
253 |
] |
|
1692 | 254 |
] |
255 |
||
256 |
"Modified: / 23.1.1997 / 03:12:06 / cg" |
|
257 |
"Created: / 17.6.1998 / 14:56:55 / cg" |
|
258 |
! |
|
259 |
||
17438 | 260 |
findRefChainToSemaphore |
261 |
"open an ref chain dialog on the selected semaphore(s)" |
|
262 |
||
263 |
|coll| |
|
264 |
||
265 |
coll := OrderedCollection new. |
|
266 |
self selectedSemaphoresDo:[:aSema | coll add:aSema]. |
|
267 |
ObjectMemory displayRefChainToAny:coll. |
|
268 |
||
269 |
"Created: / 23-02-2017 / 15:17:01 / stefan" |
|
270 |
! |
|
271 |
||
995 | 272 |
inspectSemaphore |
17226 | 273 |
"open an inspector on the selected semaphore(s)" |
980 | 274 |
|
275 |
self selectedSemaphoresDo:[:aSema | aSema inspect] |
|
276 |
||
277 |
"Modified: 23.1.1997 / 03:12:06 / cg" |
|
995 | 278 |
"Created: 24.1.1997 / 23:11:50 / cg" |
980 | 279 |
! |
280 |
||
1692 | 281 |
inspectWaiters |
17226 | 282 |
"open an inspector on the selected semaphores' waiting processes" |
1692 | 283 |
|
14202 | 284 |
self selectedSemaphoresDo:[:aSema | |
17226 | 285 |
aSema waitingProcesses do:[:aProcess | |
286 |
aProcess inspect |
|
287 |
] |
|
1692 | 288 |
] |
289 |
||
290 |
"Modified: / 23.1.1997 / 03:12:06 / cg" |
|
291 |
"Created: / 17.6.1998 / 14:17:41 / cg" |
|
292 |
! |
|
293 |
||
980 | 294 |
selectedSemaphoresDo:aBlock |
17226 | 295 |
"evaluate aBlock on all selected semaphore(s)" |
980 | 296 |
|
17226 | 297 |
self selectionIndicesDo:[:n | |
298 |
|nr p| |
|
299 |
||
300 |
nr := n - self numberOfHeadlines. |
|
17169 | 301 |
nr notNil ifTrue:[ |
302 |
nr > 0 ifTrue:[ |
|
303 |
p := semaphores at:nr. |
|
304 |
(p notNil and:[p ~~ 0]) ifTrue:[ |
|
305 |
aBlock value:p |
|
306 |
] |
|
307 |
] |
|
308 |
] |
|
980 | 309 |
]. |
310 |
! |
|
311 |
||
312 |
signalSemaphore |
|
313 |
"signal all selected semaphores" |
|
314 |
||
315 |
self selectedSemaphoresDo:[:aSema | aSema signal] |
|
316 |
||
317 |
"Created: 23.1.1997 / 03:12:30 / cg" |
|
318 |
! |
|
319 |
||
320 |
statusMenu |
|
321 |
"return a popUpMenu" |
|
322 |
||
1692 | 323 |
<resource: #programMenu> |
324 |
||
4253 | 325 |
|labels selectors m| |
980 | 326 |
|
327 |
labels := resources array:#( |
|
17226 | 328 |
'Inspect' |
329 |
'Inspect Waiters' |
|
17438 | 330 |
'Show reference chains' |
17226 | 331 |
'Debug Waiters' |
332 |
'Debug Last Owning Process' |
|
333 |
'-' |
|
334 |
'Signal' |
|
335 |
). |
|
980 | 336 |
selectors := #( |
17226 | 337 |
inspectSemaphore |
338 |
inspectWaiters |
|
17438 | 339 |
findRefChainToSemaphore |
17226 | 340 |
debugWaiters |
341 |
debugLastOwningProcess |
|
342 |
nil |
|
343 |
signalSemaphore |
|
344 |
). |
|
980 | 345 |
|
346 |
updateProcess isNil ifTrue:[ |
|
17226 | 347 |
labels := (resources array:#('Update' '-')) , labels. |
348 |
selectors := #(updateView nil) , selectors |
|
980 | 349 |
]. |
350 |
||
351 |
m := PopUpMenu labels:labels |
|
17226 | 352 |
selectors:selectors. |
980 | 353 |
|
354 |
||
355 |
listView hasSelection ifFalse:[ |
|
17226 | 356 |
m disableAll:#( |
357 |
inspectSemaphore |
|
358 |
inspectWaiters |
|
359 |
debugWaiters |
|
360 |
debugLastOwningProcess |
|
361 |
signalSemaphore |
|
362 |
) |
|
980 | 363 |
]. |
364 |
^ m |
|
365 |
||
17438 | 366 |
"Modified: / 17-06-1998 / 14:17:05 / cg" |
367 |
"Modified: / 23-02-2017 / 15:18:50 / stefan" |
|
980 | 368 |
! ! |
369 |
||
370 |
!SemaphoreMonitor methodsFor:'queries'! |
|
371 |
||
17169 | 372 |
numberOfHeadlines |
373 |
^ 2 |
|
980 | 374 |
! ! |
375 |
||
376 |
!SemaphoreMonitor methodsFor:'user actions'! |
|
377 |
||
378 |
doubleClicked |
|
379 |
"open an inspector on the selected semaphore" |
|
380 |
||
1023 | 381 |
self inspectSemaphore |
980 | 382 |
|
383 |
"Created: 23.1.1997 / 03:22:04 / cg" |
|
1023 | 384 |
"Modified: 31.1.1997 / 22:33:27 / cg" |
980 | 385 |
! ! |
386 |
||
387 |
!SemaphoreMonitor class methodsFor:'documentation'! |
|
388 |
||
389 |
version |
|
17169 | 390 |
^ '$Header$' |
17443 | 391 |
! |
392 |
||
393 |
version_CVS |
|
394 |
^ '$Header$' |
|
980 | 395 |
! ! |
12399 | 396 |