/usr/share/gnu-smalltalk/examples/Sync.st is in gnu-smalltalk-common 3.2.5-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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!
|