Semaphore.st
author claus
Sat, 22 Jul 1995 21:25:26 +0200
changeset 362 4131e87e79ec
parent 329 f14fc5ac11b7
child 375 e5019c22f40e
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
LinkedList subclass:#Semaphore
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    14
	 instanceVariableNames:'count waitingProcesses'
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    15
"/         instanceVariableNames:'count'
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    16
	 classVariableNames:''
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    17
	 poolDictionaries:''
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    18
	 category:'Kernel-Processes'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
Semaphore comment:'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
COPYRIGHT (c) 1993 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    22
	      All Rights Reserved
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    23
362
claus
parents: 329
diff changeset
    24
$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.18 1995-07-22 19:24:21 claus Exp $
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    25
'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    26
69
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    27
!Semaphore class methodsFor:'documentation'!
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    28
88
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    29
copyright
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    30
"
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    31
 COPYRIGHT (c) 1993 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    32
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    33
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    34
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    35
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    37
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    38
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    39
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    40
"
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    41
!
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    42
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    43
version
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    44
"
362
claus
parents: 329
diff changeset
    45
$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.18 1995-07-22 19:24:21 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    46
"
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    47
!
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    48
69
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    49
documentation
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    50
"
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    51
    Semaphores are used to synchronize processes providing a nonBusy wait
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    52
    mechanism. A process can wait for the availability of some resource by
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    53
    performing a Semaphore>>wait, which will suspend the process until the
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    54
    resource becomes available. Signalling is done by (another process performing) 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    55
    Semaphore>>signal.
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    56
    If the resource has been already available before the wait, no suspending is
69
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    57
    done, but the resource immediately allocated.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    58
    There are also semaphores for mutual access to a critical region
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    59
    (Semaphore>>forMutualExclusion and Semaphore>>critical:).
88
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    60
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    61
    You can also attach semaphores to external events (such as I/O arrival or
183
7899f380e77d signalIf
claus
parents: 159
diff changeset
    62
    timer events. This is done by telling the Processor to signal the semaphore
7899f380e77d signalIf
claus
parents: 159
diff changeset
    63
    under some condition.
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    64
    See 'Processor>>signal:afterSeconds:', 'Processor>>signal:onInput:' etc.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
    65
88
81dacba7a63a *** empty log message ***
claus
parents: 79
diff changeset
    66
    See examples in doc/coding.
69
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    67
"
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    68
! !
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
    69
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
!Semaphore class methodsFor:'instance creation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
new
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
    "create & return a new semaphore which blocks until a signal is sent"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
    ^ super new setCount:0
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
new:n
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
    "create & return a new semaphore which allows n waits before
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
     blocking"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
    ^ super new setCount:n
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
forMutualExclusion
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
    "create & return a new semaphore which allows exactly one process to
a27a279701f8 Initial revision
claus
parents:
diff changeset
    87
     wait on it without blocking"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    88
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    89
    ^ super new setCount:1
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    90
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    91
a27a279701f8 Initial revision
claus
parents:
diff changeset
    92
!Semaphore methodsFor:'private accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    93
a27a279701f8 Initial revision
claus
parents:
diff changeset
    94
setCount:n
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
    count := n
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    97
217
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
    98
!Semaphore methodsFor:'queries '!
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
    99
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   100
wouldBlock
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   101
    "return true, if the receiver would block the activeProcess
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   102
     if a wait was performed. False otherwise."
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   103
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   104
    ^ count == 0
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   105
! !
a0400fdbc933 *** empty log message ***
claus
parents: 183
diff changeset
   106
362
claus
parents: 329
diff changeset
   107
!Semaphore methodsFor:'printing & storing'!
claus
parents: 329
diff changeset
   108
claus
parents: 329
diff changeset
   109
displayString
claus
parents: 329
diff changeset
   110
    ^ self class name , '(' , count printString , ')'
claus
parents: 329
diff changeset
   111
! !
claus
parents: 329
diff changeset
   112
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
!Semaphore methodsFor:'wait & signal'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
a27a279701f8 Initial revision
claus
parents:
diff changeset
   115
wait
a27a279701f8 Initial revision
claus
parents:
diff changeset
   116
    "wait for the semaphore"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   118
    |current wasBlocked|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
    "
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   121
     this works only since interrupts are only serviced at 
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   122
     message send and method-return time ....
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   123
     If you add a message send into the ifTrue:-block, things will
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   124
     go mad ... (especially be careful when adding a debugPrint-here)
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   125
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   126
    count ~~ 0 ifTrue:[
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   127
	count := count - 1.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   128
	^ self
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   129
    ].
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   130
302
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   131
    current := Processor activeProcess.
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   132
302
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   133
    wasBlocked := OperatingSystem blockInterrupts.
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   134
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   135
     need a while-loop here, since more than one process may
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   136
     wait for it and another one may also wake up.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   137
     Thus, the count is not always non-zero after returning from
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   138
     suspend.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   139
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   140
    [count == 0] whileTrue:[
302
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   141
	waitingProcesses isNil ifTrue:[
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   142
	    waitingProcesses := OrderedCollection with:current
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   143
	] ifFalse:[
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   144
	    waitingProcesses add:current
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   145
	].
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   146
"/        self add:current.
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   147
	"
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   148
	 for some more descriptive info in processMonitor ...
183
7899f380e77d signalIf
claus
parents: 159
diff changeset
   149
	 (notice that state could already be #ioWait, #timeWait or anything else)
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   150
	"
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   151
	current setStateTo:#wait if:#active.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   152
	Processor suspend:current
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
    ].
10
claus
parents: 3
diff changeset
   154
    count := count - 1.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   155
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
10
claus
parents: 3
diff changeset
   156
!
claus
parents: 3
diff changeset
   157
329
claus
parents: 302
diff changeset
   158
waitUncounted
claus
parents: 302
diff changeset
   159
    "wait for the semaphore; do not consume the resource
claus
parents: 302
diff changeset
   160
     (i.e. do not count down)"
claus
parents: 302
diff changeset
   161
claus
parents: 302
diff changeset
   162
    |current wasBlocked|
claus
parents: 302
diff changeset
   163
claus
parents: 302
diff changeset
   164
    "
claus
parents: 302
diff changeset
   165
     this works only since interrupts are only serviced at 
claus
parents: 302
diff changeset
   166
     message send and method-return time ....
claus
parents: 302
diff changeset
   167
     If you add a message send into the ifTrue:-block, things will
claus
parents: 302
diff changeset
   168
     go mad ... (especially be careful when adding a debugPrint-here)
claus
parents: 302
diff changeset
   169
    "
claus
parents: 302
diff changeset
   170
    count ~~ 0 ifTrue:[
claus
parents: 302
diff changeset
   171
	^ self
claus
parents: 302
diff changeset
   172
    ].
claus
parents: 302
diff changeset
   173
claus
parents: 302
diff changeset
   174
    current := Processor activeProcess.
claus
parents: 302
diff changeset
   175
claus
parents: 302
diff changeset
   176
    wasBlocked := OperatingSystem blockInterrupts.
claus
parents: 302
diff changeset
   177
    "
claus
parents: 302
diff changeset
   178
     need a while-loop here, since more than one process may
claus
parents: 302
diff changeset
   179
     wait for it and another one may also wake up.
claus
parents: 302
diff changeset
   180
     Thus, the count is not always non-zero after returning from
claus
parents: 302
diff changeset
   181
     suspend.
claus
parents: 302
diff changeset
   182
    "
claus
parents: 302
diff changeset
   183
    [count == 0] whileTrue:[
claus
parents: 302
diff changeset
   184
	waitingProcesses isNil ifTrue:[
claus
parents: 302
diff changeset
   185
	    waitingProcesses := OrderedCollection with:current
claus
parents: 302
diff changeset
   186
	] ifFalse:[
claus
parents: 302
diff changeset
   187
	    waitingProcesses add:current
claus
parents: 302
diff changeset
   188
	].
claus
parents: 302
diff changeset
   189
"/        self add:current.
claus
parents: 302
diff changeset
   190
	"
claus
parents: 302
diff changeset
   191
	 for some more descriptive info in processMonitor ...
claus
parents: 302
diff changeset
   192
	 (notice that state could already be #ioWait, #timeWait or anything else)
claus
parents: 302
diff changeset
   193
	"
claus
parents: 302
diff changeset
   194
	current setStateTo:#wait if:#active.
claus
parents: 302
diff changeset
   195
	Processor suspend:current
claus
parents: 302
diff changeset
   196
    ].
claus
parents: 302
diff changeset
   197
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
claus
parents: 302
diff changeset
   198
!
claus
parents: 302
diff changeset
   199
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   200
waitWithTimeout:seconds
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   201
    "wait for the semaphore, but abort the wait after some time.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   202
     return true if semaphore triggered normal, false if we return
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   203
     due to a timeout. With zero timeout, this can be used to poll
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   204
     a semaphore (which is not the intend of semaphores, though)."
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   205
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   206
    |current timeoutOccured wasBlocked unblock now endTime|
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   207
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   208
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   209
     this works only since interrupts are only serviced at 
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   210
     message send and method-return time ....
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   211
     If you add a message send into the ifTrue:-block, things will
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   212
     go mad ... (especially be careful when adding a debugPrint-here)
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   213
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   214
    count ~~ 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   215
	count := count - 1.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   216
	^ true
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   217
    ].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   218
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   219
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   220
     with zero-timeout, this is a poll
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   221
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   222
    seconds = 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   223
	^ false
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   224
    ].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   225
302
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   226
    current := Processor activeProcess.
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   227
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   228
    wasBlocked := OperatingSystem blockInterrupts.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   229
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   230
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   231
     calculate the end-time
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   232
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   233
    now := OperatingSystem getMillisecondTime.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   234
    endTime := OperatingSystem millisecondTimeAdd:now and:(seconds * 1000).
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   235
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   236
    unblock := [timeoutOccured := true. Processor resume:current].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   237
    Processor addTimedBlock:unblock for:current atMilliseconds:endTime.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   238
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   239
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   240
     need a while-loop here, since more than one process may
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   241
     wait for it and another one may also wake up.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   242
     Thus, the count is not always non-zero after returning from
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   243
     suspend.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   244
    "
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   245
    [count == 0] whileTrue:[
302
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   246
	waitingProcesses isNil ifTrue:[
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   247
	    waitingProcesses := OrderedCollection with:current
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   248
	] ifFalse:[
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   249
	    waitingProcesses add:current
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   250
	].
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   251
"/        self add:current.
1f76060d58a4 *** empty log message ***
claus
parents: 269
diff changeset
   252
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   253
	"
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   254
	 for some more descriptive info in processMonitor ...
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   255
	 (notice that state could already be #ioWait or #timeWait)
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   256
	"
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   257
	current setStateTo:#wait if:#active.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   258
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   259
	timeoutOccured := false.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   260
	Processor suspend:current.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   261
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   262
	timeoutOccured ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   263
	    waitingProcesses remove:current ifAbsent:[].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   264
	    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   265
	    ^ false
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   266
	].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   267
    ].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   268
    Processor removeTimedBlock:unblock.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   269
    count := count - 1.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   270
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   271
    ^ true
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   272
!
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   273
10
claus
parents: 3
diff changeset
   274
signalOnce
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   275
    "wakeup waiters - but only once.
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   276
     I.e. if the semaphore has already been signalled, this
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   277
     is ignored."
10
claus
parents: 3
diff changeset
   278
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   279
    |wasBlocked|
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   280
10
claus
parents: 3
diff changeset
   281
    count == 0 ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   282
	wasBlocked := OperatingSystem blockInterrupts.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   283
	count == 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   284
	    self signal
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   285
	].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   286
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   287
    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
signal
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   291
    "waking up (first) waiter"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   293
    |p wasBlocked|
77
6c38ca59927f *** empty log message ***
claus
parents: 69
diff changeset
   294
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   295
    wasBlocked := OperatingSystem blockInterrupts.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   296
    count := count + 1.
79
046dc2b6c3ec oops - false if introduced with last change
claus
parents: 77
diff changeset
   297
    (waitingProcesses notNil and:[waitingProcesses notEmpty]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   298
	p := waitingProcesses removeFirst.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   299
"/    self isEmpty ifFalse:[
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   300
"/        p := self removeFirst.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   301
159
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   302
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   303
	p resume.
514c749165c3 *** empty log message ***
claus
parents: 93
diff changeset
   304
	^ self
10
claus
parents: 3
diff changeset
   305
    ].
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   306
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   307
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   308
183
7899f380e77d signalIf
claus
parents: 159
diff changeset
   309
signalIf
7899f380e77d signalIf
claus
parents: 159
diff changeset
   310
    "signal the semaphore, but only if being waited upon.
7899f380e77d signalIf
claus
parents: 159
diff changeset
   311
     This can be used for one-shot semaphores (i.e. not remembering
7899f380e77d signalIf
claus
parents: 159
diff changeset
   312
     previous signals)"
7899f380e77d signalIf
claus
parents: 159
diff changeset
   313
7899f380e77d signalIf
claus
parents: 159
diff changeset
   314
    |wasBlocked|
7899f380e77d signalIf
claus
parents: 159
diff changeset
   315
7899f380e77d signalIf
claus
parents: 159
diff changeset
   316
    (waitingProcesses notNil and:[waitingProcesses notEmpty]) ifTrue:[
7899f380e77d signalIf
claus
parents: 159
diff changeset
   317
	wasBlocked := OperatingSystem blockInterrupts.
7899f380e77d signalIf
claus
parents: 159
diff changeset
   318
	(waitingProcesses notNil and:[waitingProcesses notEmpty]) ifTrue:[
7899f380e77d signalIf
claus
parents: 159
diff changeset
   319
	    self signal
7899f380e77d signalIf
claus
parents: 159
diff changeset
   320
	].
7899f380e77d signalIf
claus
parents: 159
diff changeset
   321
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
7899f380e77d signalIf
claus
parents: 159
diff changeset
   322
    ]
7899f380e77d signalIf
claus
parents: 159
diff changeset
   323
!
7899f380e77d signalIf
claus
parents: 159
diff changeset
   324
329
claus
parents: 302
diff changeset
   325
signalForAll
claus
parents: 302
diff changeset
   326
    "signal the semaphore for all waiters.
claus
parents: 302
diff changeset
   327
     This can be used for process synchronization, if multiple processes are
claus
parents: 302
diff changeset
   328
     waiting for a common event."
claus
parents: 302
diff changeset
   329
claus
parents: 302
diff changeset
   330
    |wasBlocked|
claus
parents: 302
diff changeset
   331
claus
parents: 302
diff changeset
   332
    [waitingProcesses notNil and:[waitingProcesses notEmpty]] whileTrue:[
claus
parents: 302
diff changeset
   333
	wasBlocked := OperatingSystem blockInterrupts.
claus
parents: 302
diff changeset
   334
	(waitingProcesses notNil and:[waitingProcesses notEmpty]) ifTrue:[
claus
parents: 302
diff changeset
   335
	    self signal
claus
parents: 302
diff changeset
   336
	].
claus
parents: 302
diff changeset
   337
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
claus
parents: 302
diff changeset
   338
    ]
claus
parents: 302
diff changeset
   339
!
claus
parents: 302
diff changeset
   340
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   341
critical:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   342
    "evaluate aBlock as a critical region; the receiver must be
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   343
     created using Semaphore>>forMutualExclusion"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   344
a27a279701f8 Initial revision
claus
parents:
diff changeset
   345
    self wait.
69
4564b6328136 *** empty log message ***
claus
parents: 25
diff changeset
   346
    ^ aBlock valueNowOrOnUnwindDo:[self signal].
269
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   347
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   348
    "
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   349
      the example below is stupid (it should use a SharedQueue,
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   350
      or at least a Queue with critical regions).
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   351
      Anyhow, it demonstrates how two processes lock each other
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   352
      from accessing coll at the same time
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   353
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   354
     |sema coll|
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   355
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   356
     sema := Semaphore forMutualExclusion.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   357
     coll := OrderedCollection new:10.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   358
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   359
     [
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   360
	1 to:1000 do:[:i |
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   361
	    sema critical:[
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   362
		coll addLast:i.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   363
		(Delay forSeconds:0.1) wait.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   364
	    ]
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   365
	]
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   366
     ] forkAt:4.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   367
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   368
     [
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   369
	1 to:1000 do:[:i |
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   370
	    sema critical:[
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   371
		coll removeFirst.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   372
		(Delay forSeconds:0.1) wait.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   373
	    ]
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   374
	]
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   375
     ] forkAt:4.
93162487a94b *** empty log message ***
claus
parents: 217
diff changeset
   376
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   377
! !