File: Sync.st

package info (click to toggle)
gnu-smalltalk 3.2.4-2.1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 32,688 kB
  • ctags: 14,104
  • sloc: ansic: 87,424; sh: 22,729; asm: 8,465; perl: 4,513; cpp: 3,548; xml: 1,669; awk: 1,581; yacc: 1,357; makefile: 1,237; lisp: 855; lex: 843; sed: 258; objc: 124
file content (408 lines) | stat: -rw-r--r-- 10,073 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
"======================================================================
|
|   Sample synchronization primitives
|
|
 ======================================================================"


"======================================================================
|
| Copyright (C) 2002 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
| 
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
| details.
| 
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
|
 ======================================================================"

Object subclass: #Monitor
	instanceVariableNames: 'semaphore process count waitSemaphores '
	classVariableNames: 'Mutex'
	poolDictionaries: ''
	category: 'Examples-Processes'!

Monitor comment: '
A monitor provides process synchronization that is more highlevel than the
one provided by a Semaphore.  It is equivalent to the facility provided
by the Java language.

1) At any time, only one process can be executing code inside a critical
section of a monitor.

2) A monitor is reentrant, which means that the active process in a monitor
does never get blocked when it enters a (nested) critical section of the
same monitor.

3) Inside a critcal section, a process can stop to wait for events.
The process leaves the monitor temporarily (in order to let other
processes enter) and waits until another process notifies the event.
Then, the original process checks if the event is the desired one and
continues if it is.

4) The monitor is fair, which means that the process that is waiting on a
notified condition the longest gets activated first.'!

Semaphore subclass: #ConditionVariable
       instanceVariableNames: 'set'
       classVariableNames: ''
       poolDictionaries: ''
       category: 'Examples-Processes'
!

ConditionVariable comment:
'A ConditionVariable allows Processes to suspend execution until some
predicate on shared data is satisfied. The basic operations on conditions
are: notify the condition (when the predicate becomes true), clear it,
and wait for the condition.'!

Object subclass: #Barrier
       instanceVariableNames: 'countdown sema'
       classVariableNames: ''
       poolDictionaries: ''
       category: 'Examples-Processes'
!

Barrier comment:
'A Barrier has a threshold t and stops the first t-1 processes that
sends it #wait; when the t-th process says it has reached the barrier
(by sending it #wait) all the suspended processes are restarted and
further waits will be no-ops.'!

RecursionLock subclass: #ReadWriteLock
       instanceVariableNames: 'readMutex readers readLocked'
       classVariableNames: ''
       poolDictionaries: ''
       category: 'Examples-Processes'
!

ReadWriteLock comment:
'A read-write lock can be locked in two modes, read-only (with #readLockDuring:)
and read-write (with #critical:).  When the lock is only locked by other threads
in read-only mode, a read-only lock will not block and a read-write locking
attempt will wait for all the read-only locks to be released.  Instead, when one
thread holds a read-write lock, all locking attempts will suspend the current
thread until this lock is released again.'!

Object subclass: #Watchdog
       instanceVariableNames: 'actionBlock relax ok delay'
       classVariableNames: ''
       poolDictionaries: ''
       category: 'Examples-Processes'
!

Watchdog comment:
'I am used to watch for system hangups.  Until #terminate is
sent to an instance of me, I periodically check if during the
time you sent #notify and, if you did not, I evaluate a
user-supplied action block.'!

!Monitor class methodsFor: 'initialization'!

initialize
    Mutex := Semaphore forMutualExclusion! !

!Monitor class methodsFor: 'private'!

delayProcessFor: mils semaphore: s
    ^[
        (Delay forMilliseconds: mils) wait.
        s signal.
	Processor activeProcess suspend ]!

!Monitor class methodsFor: 'instance creation'!

new
    ^super new initialize!

!Monitor methodsFor: 'initialize-release'!

initialize
    count := 0.
    semaphore := Semaphore forMutualExclusion! !

!Monitor methodsFor: 'private'!

checkOwnerProcess
    self isOwnerProcess
	ifFalse: [self error: 'Monitor access violation']!

enter
    | activeProcess |
    activeProcess := Processor activeProcess.
    process == activeProcess
	ifFalse: [
	    semaphore wait.
	    process := activeProcess ].
    count := count + 1!

exit
    Mutex wait.
    (count := count - 1) == 0
	ifTrue: [ process := nil. semaphore signal ].
    Mutex signal!

unlock
    | oldCount |
    oldCount := count.
    count := 0.
    process := nil.
    semaphore signal.
    ^oldCount!

lock: saveCount
    | activeProcess |
    activeProcess := Processor activeProcess.
    process == activeProcess
	ifFalse: [
	    semaphore wait.
	    process := activeProcess ].
    count := count + saveCount! !

!Monitor methodsFor: 'control'!

critical: aBlock
    self enter.
    ^aBlock ensure: [ self exit ]!

signal
    self checkOwnerProcess.
    Mutex wait.
    waitSemaphores isNil ifTrue: [ Mutex signal. ^self ].
    waitSemaphores isEmpty ifFalse: [ waitSemaphores removeFirst signal ].
    Mutex signal!

signalAll
    self checkOwnerProcess.
    Mutex wait.
    waitSemaphores isNil ifTrue: [ Mutex signal. ^self ].
    waitSemaphores size timesRepeat: [ waitSemaphores removeFirst signal ].
    Mutex signal!

wait
    ^self wait: 0!

wait: msec
    | count process sema |
    self checkOwnerProcess.
    sema := Semaphore new.

    "Grab the monitor, unlock it and register the semaphore we'll wait on.
     Note that we unlock the monitor *before* relinquishing the mutex."
    Mutex wait.
    count := self unlock.
    waitSemaphores isNil ifTrue: [ waitSemaphores := OrderedCollection new ].
    waitSemaphores addLast: sema.
    Mutex signal.

    "If there's a timeout, start a process to exit the wait anticipatedly."
    msec > 0 ifTrue: [
	process := (self class delayProcessFor: msec semaphore: sema) fork ].

    sema wait.

    "Also if there's a timeout, ensure that the semaphore is removed from
     the list.  If there's no timeout we do not even need to reacquire the
     monitor afterwards (see also #exit:, which waits after getting the
     monitor and relinquishing the mutex)."
    process notNil ifTrue: [
        Mutex wait.
        waitSemaphores remove: sema ifAbsent: [].
        process terminate.
        Mutex signal ].

    self lock: count! !

!ConditionVariable methodsFor: 'all'!

initialize
    super initialize.
    set := false
!

wait
    [
        set ifFalse: [ super wait ]
    ] valueWithoutPreemption
!

reset
    [
	set := false.
    ] valueWithoutPreemption
!

pulse
    [
        set ifFalse: [ self notifyAll ]
    ] valueWithoutPreemption
!

broadcast
    [
	| wasSet |
	wasSet := set.
	set := true.
	wasSet ifFalse: [ self notifyAll ].
    ] valueWithoutPreemption
!

signal
    [
	| wasSet |
	wasSet := set.
	set := true.
	wasSet ifFalse: [ self notify ].
    ] valueWithoutPreemption
! !


!Barrier class methodsFor: 'all'!

new: threshold
    ^self new initialize: threshold; yourself
!

!Barrier methodsFor: 'all'!

initialize: count
    countdown := count.
    sema := Semaphore new
!

wait
    countdown < 0 ifTrue: [ ^self ].
    countdown := countdown - 1.
    countdown = 0 ifTrue: [ sema notifyAll ] ifFalse: [ sema wait ].
! !


!ReadWriteLock methodsFor: 'all'!

initialize
    super initialize.
    readMutex := Semaphore forMutualExclusion.
    readers := 0.
    readLocked := false.
!

readLocked
    ^readLocked
!

readLockDuring: aBlock
    readMutex wait.
    readers := readers + 1.

    "If readers was already >= 1, we don't have to wait for the write-lock to be
     freed and this is substantially equivalent to
	readMutex signal.
	aBlock value.
	readMutex wait.
	readers = readers - 1.
	readMutex signal.

    Instead if readers was zero we have to get the write lock:
	<acquire the write lock>
	readLocked := true.
	readMutex signal.
	aBlock value
	readMutex wait.
	readers = readers - 1.
	readLocked := false.
	readMutex signal
	<release the write lock>

    Note that actually the release of the lock might happen in a different process
    than the one that acquired the lock!  That's the reason why readers is an
    instance variable."

    self critical: [
	readMutex signal.
	aBlock value
    ]
!

wait
    readers > 1 ifTrue: [ ^self ].
    super wait.
    readLocked := readers > 0
!

signal
    readLocked ifTrue: [
        readMutex wait.
        readers := readers - 1.
        readLocked := (readers > 0).
	readLocked ifTrue: [ readMutex signal. ^self ].
	readMutex signal.
    ].
    super signal
! !


!Watchdog class methodsFor: 'all'!

defaultMillisecondsWatchdogTime
   ^60000
!

new
    ^self basicNew initialize: self defaultMillisecondsWatchdogTime
!

forSeconds: n
    ^self basicNew initialize: n * 1000
!

forMilliseconds: n
    ^self basicNew initialize: n
!

do: aBlock
    ^self new actionBlock: aBlock; start
! !

!Watchdog methodsFor: 'all'!

initialize: msec
    relax := true.
    delay := Delay forMilliseconds: msec.
    ok := true.
    actionBlock := ValueHolder null. 	"Anything that answers #value will do"
!

terminate
    relax := true.
!

actionBlock: aBlock
    actionBlock := aBlock.
!

signal
    ok := true.
!

start
    relax := false.
    ok := false.
    [ [ delay wait. relax ] whileFalse: [
	 ok ifFalse: [ actionBlock value ].
	 ok := false.
    ] ] forkAt: Processor lowIOPriority.
! !

Monitor initialize!