"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

Object subclass:#Semaphore

	instanceVariableNames:'count waitingProcesses lastOwnerID name'

	classVariableNames:''

	poolDictionaries:''

	category:'Kernel-Processes'

!

!Semaphore class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Semaphores are used to synchronize processes providing a nonBusy wait

    mechanism. A process can wait for the availability of some resource by

    performing a Semaphore>>wait, which will suspend the process until the

    resource becomes available. Signalling is done by (another process performing) 

    Semaphore>>signal.

    If the resource has been already available before the wait, no suspending is

    done, but the resource immediately allocated.

    There are also semaphores for mutual access to a critical region

    (Semaphore>>forMutualExclusion and Semaphore>>critical:).

    Additional protocol is provided for oneShot semaphores, 

    (#signalOnce) and for conditional signalling (#signalIf).

    You can also attach semaphores to external events (such as I/O arrival or

    timer events). 

    This is done by telling the Processor to signal the semaphore 

    under some condition.

    See 'Processor>>signal:afterSeconds:', 'Processor>>signal:onInput:' etc.

    See examples in doc/coding (found in the CodingExamples-nameSpace).

    [instance variables:]

	count			<SmallInteger>		the number of waits, that will go through

							without blocking.

							Incremented on #signal; decremented on #wait.

	waitingProcesses	<OrderedCollection>	waiting processes - will be served first

							come first served when signalled.

	lastOwnerID		<SmallInteger>		a debugging aid: set when count drops

							to zero to the current processes id.

							Helps in finding deadlocks.

	name			<String>		a debugging aid: an optional userFriendly

							name; helps to identify a semaphore easier.

    [see also:]

        SemaphoreSet RecursionLock Monitor

        SharedQueue Delay 

        Process ProcessorScheduler

    [author:]

        Claus Gittinger

"

! !

!Semaphore class methodsFor:'instance creation'!

forMutualExclusion

    "create & return a new semaphore which allows exactly one process to

     wait on it without blocking. This type of semaphore is used

     for mutual exclusion from critical regions (see #critical:)"

    ^ super new setCount:1

    "Modified: 10.1.1997 / 21:44:30 / cg"

!

new

    "create & return a new semaphore which blocks until a signal is sent"

    ^ super new setCount:0

!

new:n

    "create & return a new semaphore which allows n waits before

     blocking"

    ^ super new setCount:n

! !

!Semaphore methodsFor:'friend-class interface'!

checkAndRegisterProcess:process

    "interface for SemaphoreSet.

     If the semaphore is available, decrement it and return true.

     Otherwise register our process to be wakened up once the semaphore is available

     and return false..

    "

    "

     bad ST/X trick (needs change, when multiProcessor support is added):

     this works only since interrupts are only serviced at 

     message send and method-return time ....

     If you add a message send into the ifTrue:-block, things will

     go mad ... (especially be careful when adding a debugPrint-here)

    "

    count ~~ 0 ifTrue:[

        count := count - 1.

	count == 0 ifTrue:[

	    lastOwnerID := Processor activeProcessId.

	].

        ^ true

    ].

    (waitingProcesses identityIndexOf:process) == 0 ifTrue:[

        waitingProcesses add:process.

    ].

    ^ false

    "Modified: 14.12.1995 / 10:32:17 / stefan"

    "Modified: 10.1.1997 / 21:42:18 / cg"

!

unregisterProcess:process

    "interface for SemaphoreSet.

     Unregister our process from the Semaphore"

    waitingProcesses removeIdentical:process ifAbsent:[].

    "Created: 14.12.1995 / 10:31:50 / stefan"

    "Modified: 1.2.1997 / 12:11:22 / cg"

! !

!Semaphore methodsFor:'printing & storing'!

displayString

    "return a string to display the receiver - include the

     count for your convenience"

    |n|

    name isNil ifTrue:[

	n := 'unnamed'

    ] ifFalse:[

	n := name

    ].

    ^ self class name , '(' , count printString , ' name: ' , n , ')'

    "Modified: 10.1.1997 / 21:43:04 / cg"

!

name

    "return the semaphores userFriendly name"

    ^ name

!

name:aString

    "set the semaphores userFriendly name"

    name := aString

! !

!Semaphore methodsFor:'private accessing'!

setCount:n

    "set the count of the semaphore;

     thats the number of possible waits, without blocking"

    count := n

! !

!Semaphore methodsFor:'queries '!

count

    "return the number of 'already-counted' trigger events.

     Thats the number of waits which will succeed without blocking"

    ^ count

    "Created: 23.1.1997 / 02:55:58 / cg"

!

lastOwnerId

    "return the processId of the last owning process

     (the one which counted to zero).

     May be very useful in debugging deadLock situations"

    ^ lastOwnerID

    "Created: 24.1.1997 / 23:09:33 / cg"

!

numberOfWaitingProcesses

    "return the number of processes waiting on the receiver"

    ^ waitingProcesses size

    "Created: 3.5.1996 / 18:06:27 / cg"

!

waitingProcesses

    "return the processes waiting on the receiver"

    ^ waitingProcesses

    "Created: 18.7.1996 / 20:53:33 / cg"

!

wouldBlock

    "return true, if the receiver would block the activeProcess

     if a wait was performed. False otherwise."

    ^ count == 0

! !

!Semaphore methodsFor:'wait & signal'!

critical:aBlock

    "evaluate aBlock as a critical region; the receiver must be

     created using Semaphore>>forMutualExclusion"

    |retVal gotSema|

    [

        gotSema := self wait.

        retVal := aBlock value.

    ] valueOnUnwindDo:[

        gotSema notNil ifTrue:[self signal].

    ].

    self signal.

    ^ retVal

    "

      the example below is stupid (it should use a SharedQueue,

      or at least a Queue with critical regions).

      Anyhow, it demonstrates how two processes lock each other

      from accessing coll at the same time

     |sema coll|

     sema := Semaphore forMutualExclusion.

     coll := OrderedCollection new:10.

     [

        1 to:1000 do:[:i |

            sema critical:[

                coll addLast:i.

                (Delay forSeconds:0.1) wait.

            ]

        ]

     ] forkAt:4.

     [

        1 to:1000 do:[:i |

            sema critical:[

                coll removeFirst.

                (Delay forSeconds:0.1) wait.

            ]

        ]

     ] forkAt:4.

    "

    "Modified: 16.4.1996 / 10:00:46 / stefan"

!

signal

    "waking up (first) waiter"

    |p wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    [

        count := count + 1.

        waitingProcesses notEmpty ifTrue:[

            p := waitingProcesses removeFirst.

            p resume.

        ].

    ] valueNowOrOnUnwindDo:[

        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    ]

    "Modified: 28.2.1996 / 21:23:10 / cg"

!

signalForAll

    "signal the semaphore for all waiters.

     This can be used for process synchronization, if multiple processes are

     waiting for a common event."

    |wasBlocked|

    [waitingProcesses notEmpty] whileTrue:[

        wasBlocked := OperatingSystem blockInterrupts.

        [

            waitingProcesses notEmpty ifTrue:[

                self signal

            ].

        ] valueNowOrOnUnwindDo:[

            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

        ]

    ]

    "Modified: 28.2.1996 / 21:23:38 / cg"

!

signalIf

    "signal the semaphore, but only if being waited upon.

     This can be used for one-shot semaphores (i.e. not remembering

     previous signals)"

    |wasBlocked|

    waitingProcesses notEmpty ifTrue:[

        wasBlocked := OperatingSystem blockInterrupts.

        [

            waitingProcesses notEmpty ifTrue:[

                self signal

            ].

        ] valueNowOrOnUnwindDo:[

            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

        ]

    ]

    "Modified: 28.2.1996 / 21:23:57 / cg"

!

signalOnce

    "wakeup waiters - but only once.

     I.e. if the semaphore has already been signalled, this

     is ignored."

    |wasBlocked|

    count == 0 ifTrue:[

        wasBlocked := OperatingSystem blockInterrupts.

        [

            count == 0 ifTrue:[

                self signal

            ].

        ] valueNowOrOnUnwindDo:[

            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

        ]

    ]

    "Modified: 28.2.1996 / 21:24:08 / cg"

!

wait

    "wait for the semaphore"

    |activeProcess wasBlocked|

    "

     bad ST/X trick (needs change, when multiProcessor support is added):

     this works only since interrupts are only serviced at 

     message send and method-return time ....

     If you add a message send between the compare and the decrement,

     things will go mad ... (especially be careful when adding a debugPrint-here)

    "

    count ~~ 0 ifTrue:[

        count := count - 1.

        count == 0 ifTrue:[

            lastOwnerID := Processor activeProcessId.

        ].

        ^ self

    ].

    activeProcess := Processor activeProcess.

    wasBlocked := OperatingSystem blockInterrupts.

    "

     need a while-loop here, since more than one process may

     wait for it and another one may also wake up.

     Thus, the count is not always non-zero after returning from

     suspend.

    "

    [count == 0] whileTrue:[

        waitingProcesses add:activeProcess.

        "

         for some more descriptive info in processMonitor ...

         ... set the state to #wait (instead of #suspend)

        "

        [

            activeProcess suspendWithState:#wait

        ] valueOnUnwindDo:[

            waitingProcesses removeIdentical:activeProcess ifAbsent:[].

            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

        ].

        count == 0 ifTrue:[

            "/ care for someone manually resuming me ...

            "/ being multiple times on waitingProcesses

            waitingProcesses removeIdentical:activeProcess ifAbsent:[].

        ]

    ].

    count := count - 1.

    count == 0 ifTrue:[

        lastOwnerID := Processor activeProcessId.

    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Modified: 13.12.1995 / 13:26:33 / stefan"

    "Modified: 1.2.1997 / 12:11:32 / cg"

!

waitUncounted

    "wait for the semaphore; do not consume the resource

     (i.e. do not count down)"

    |activeProcess wasBlocked|

    "

     bad ST/X trick (needs change, when multiProcessor support is added):

     this works only since interrupts are only serviced at 

     message send and method-return time ....

     If you add a message send between the compare and the decrement,

     things will go mad ... (especially be careful when adding a debugPrint-here)

    "

    count ~~ 0 ifTrue:[

        ^ self

    ].

    activeProcess := Processor activeProcess.

    wasBlocked := OperatingSystem blockInterrupts.

    "

     need a while-loop here, since more than one process may

     wait for it and another one may also wake up.

     Thus, the count is not always non-zero after returning from

     suspend.

    "

    [count == 0] whileTrue:[

        waitingProcesses add:activeProcess.

        "

         for some more descriptive info in processMonitor ...

         ... set the state to #wait (instead of #suspend)

        "

        [

            activeProcess suspendWithState:#wait

        ] valueOnUnwindDo:[

            waitingProcesses removeIdentical:activeProcess ifAbsent:[].

            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

        ].

        count == 0 ifTrue:[

            "/ care for someone manually resuming me ...

            "/ being multiple times on waitingProcesses

            waitingProcesses removeIdentical:activeProcess ifAbsent:[].

        ]

    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Modified: 13.12.1995 / 13:26:49 / stefan"

    "Modified: 1.2.1997 / 12:11:41 / cg"

!