"
 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'
	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:).

    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.
"
! !

!Semaphore class methodsFor:'instance creation'!

forMutualExclusion
    "create & return a new semaphore which allows exactly one process to
     wait on it without blocking"

    ^ super new setCount:1
!

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.
    "


    "
     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.
	^ true
    ].
    (waitingProcesses identityIndexOf:process) == 0 ifTrue:[
	waitingProcesses add:process.
    ].
    ^ false

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

unregisterProcess:process
    "
     interface for SemaphoreSet.
     Unregister our process from the Semaphore
    "

    waitingProcesses remove:process ifAbsent:[].

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

!Semaphore methodsFor:'printing & storing'!

displayString
    ^ self class name , '(' , count printString , ')'
! !

!Semaphore methodsFor:'private accessing'!

setCount:n
    waitingProcesses := OrderedCollection new:3.
    count := n
! !

!Semaphore methodsFor:'queries '!

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"

    |current wasBlocked|

    "
     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.
        ^ self
    ].

    current := 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:current.
        "
         for some more descriptive info in processMonitor ...
         ... set the state to #wait (instead of #suspend)
        "
        [
            current suspendWithState:#wait
        ] valueOnUnwindDo:[
            waitingProcesses remove:current ifAbsent:[].
            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        ]
    ].
    count := count - 1.
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Modified: 13.12.1995 / 13:26:33 / stefan"
    "Modified: 28.2.1996 / 21:24:33 / cg"
!

waitUncounted
    "wait for the semaphore; do not consume the resource
     (i.e. do not count down)"

    |current wasBlocked|

    "
     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:[
        ^ self
    ].

    current := 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:current.
        "
         for some more descriptive info in processMonitor ...
         ... set the state to #wait (instead of #suspend)
        "
        [
            current suspendWithState:#wait
        ] valueOnUnwindDo:[
            waitingProcesses remove:current ifAbsent:[].
            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        ]
    ].
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Modified: 13.12.1995 / 13:26:49 / stefan"
    "Modified: 28.2.1996 / 21:24:43 / cg"
!

waitWithTimeout:seconds
    "wait for the semaphore, but abort the wait after some time.
     return the receiver if semaphore triggered normal, nil if we return
     due to a timeout. 
     The seconds-argument may be a float (i.e. use 0.1 for a 100ms timeout).
     With zero timeout, this can be used to poll a semaphore 
     (which is not the intend of semaphores, though)."

    |current timeoutOccured wasBlocked unblock now endTime|

    "
     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.
        ^ self
    ].

    "
     with zero-timeout, this is a poll
    "
    seconds = 0 ifTrue:[
        ^ nil
    ].

    current := Processor activeProcess.

    wasBlocked := OperatingSystem blockInterrupts.

    "
     calculate the end-time
    "
    now := OperatingSystem getMillisecondTime.
    endTime := OperatingSystem millisecondTimeAdd:now and:(seconds * 1000).

    unblock := [timeoutOccured := true. Processor resume:current].
    Processor addTimedBlock:unblock for:current atMilliseconds:endTime.

    "
     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:current.

        timeoutOccured := false.
        "
         for some more descriptive info in processMonitor ...
         ... set the state to #wait (instead of #suspend)
        "
        [
            current suspendWithState:#wait.
        ] valueOnUnwindDo:[
            waitingProcesses remove:current ifAbsent:[].
            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        ].

        timeoutOccured ifTrue:[
            waitingProcesses remove:current ifAbsent:[].
            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
            ^ nil
        ].
    ].
    Processor removeTimedBlock:unblock.
    count := count - 1.
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ^ self

    "Modified: 13.12.1995 / 13:27:24 / stefan"
    "Modified: 28.2.1996 / 21:24:56 / cg"
! !

!Semaphore class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.33 1996-04-16 10:58:39 stefan Exp $'
! !