"
 COPYRIGHT (c) 1995 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.
"
"{ Package: 'stx:libbasic' }"

Object subclass:#RecursionLock
	instanceVariableNames:'process sema'
	classVariableNames:''
	poolDictionaries:''
	category:'Kernel-Processes'
!

!RecursionLock class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 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
"
    like a Semaphore for mutual exclusion, but avoids the deadlock
    if a critical region is reentered by the same process again.
    I.e. allows reentering the critical region IFF the current process 
    is the one which did the original locking.

    WARNING:
	for now, recursionLocks are not unlocked when an image is
	restarted. You may have to recreate them to avoid a deadLock.
	(this may change in the future, but recreating a recursionLock in
	 the #earlyRestart handling does not hurt)

    [author:]
	Claus Gittinger

    [see also:]
	Semaphore
	Process ProcessorScheduler
"
!

examples
"
  example (good):
									[exBegin]
    |lock|

    lock := RecursionLock new.
    lock critical:[
	Transcript showCR:'in lock ...'.
	lock critical:[
	    Transcript showCR:'again ...'
	]
    ]
									[exEnd]

  in contrast to (wrong example - deadlocks):
									[exBegin]
    |lock|

    lock := Semaphore forMutualExclusion.
    lock critical:[
	Transcript showCR:'in lock ...'.
	lock critical:[
	    '*** never reached - deadlock because sema is already locked ***'.
	    '    (press CTRL-c and abort in the debugger)'.
	    Transcript showCR:'again ...'
	]
    ]
									[exEnd]
"
! !

!RecursionLock class methodsFor:'instance creation'!

forMutualExclusion
    "for easy exchangability with mutual-exclusion Semaphores..."

    ^ self new 
!

new
    ^ self basicNew initialize

! !

!RecursionLock methodsFor:'printing & storing'!

displayOn:aGCOrStream
    "return a string to display the receiver - include the
     count for your convenience"

    "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
    "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
    (aGCOrStream isStream) ifFalse:[
        ^ super displayOn:aGCOrStream
    ].
    aGCOrStream
        nextPutAll:self class name;
        nextPut:$(.
    sema count printOn:aGCOrStream.
    aGCOrStream nextPutAll:' name: '.
    (self name ? 'unnamed') printOn:aGCOrStream.
    aGCOrStream nextPut:$).
!

name
    "return the semaphores userFriendly name"

    ^ sema name

    "Created: / 28.6.1997 / 16:19:40 / cg"
    "Modified: / 14.12.1999 / 21:03:46 / cg"
!

name:aString
    "set the semaphores userFriendly name"

    sema name:aString

    "Created: / 28.6.1997 / 16:19:47 / cg"
    "Modified: / 14.12.1999 / 21:03:52 / cg"
! !

!RecursionLock methodsFor:'private-initialization'!

initialize
    sema := Semaphore forMutualExclusion name:'recursionLock'

    "Modified: 25.1.1997 / 00:19:15 / cg"
! !

!RecursionLock methodsFor:'queries'!

numberOfWaitingProcesses
    "return the number of waiting processes"

    ^ sema numberOfWaitingProcesses

    "Created: 18.4.1996 / 17:18:08 / cg"
!

owner
    "return the owning processes (or nil)"

    ^ process
!

wouldBlock
    "Check if the resource represented by the receiver is  
     already in use by another Process."

    ^ process notNil and:[Processor activeProcess ~~ process]
! !

!RecursionLock methodsFor:'waiting'!

critical:aBlock
    "evaluate aBlock as a critical region, but do not block,
     if this lock is already held by the current process."

    |active retVal wasBlocked gotSema|

    active := Processor activeProcess.
    process == active ifTrue:[
        "I have already got the lock"
        ^ aBlock value
    ].

    "/
    "/ sema wait & process := active
    "/ and:
    "/ proces := nil & sema signal
    "/ must both be done atomic
    "/ Scenario:
    "/   ... recLock critical
    "/         got lock
    "/         evaluated
    "/         set process to nil
    "/         -> timer interrupt
    "/              recLock critical in timeOut action
    "/              process isNil
    "/                 sema wait !!!!!! DEADLOCK
    "/
    wasBlocked := OperatingSystem blockInterrupts.
    [
        (process notNil and:[process isDead]) ifTrue:[
            'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
            process := nil. sema signal.
        ].
        gotSema := sema wait.
        process := active.
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        retVal := aBlock value.
    ] ifCurtailed:[
        "be careful - the unwind may occur both while waiting
         AND while evaluating the block"
        gotSema notNil ifTrue:[
            OperatingSystem blockInterrupts.
            process := nil.
            sema signal.
        ].
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ].
    OperatingSystem blockInterrupts.
    process := nil.
    sema signal.
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ^ retVal.
!

critical:aBlock ifBlocking:blockingBlock
    "like critical:, but do not block if the lock cannot be aquired.
     Instead, return the value of the second argument, blockingBlock."

    |active wasBlocked result|

    active := Processor activeProcess.
    "I already have the lock"
    process == active ifTrue:[
        ^ aBlock value
    ].

    wasBlocked := OperatingSystem blockInterrupts.

    process notNil ifTrue:[
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        ^ blockingBlock value
    ].

    [
        process := active.
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        result := aBlock value
    ] ensure:[
        process := nil.
        sema signalIf.
    ].
    ^ result

    "Created: / 08-06-2007 / 13:23:03 / cg"
    "Modified: / 09-06-2007 / 14:22:47 / cg"
!

critical:aBlock timeoutMs:timeoutMs ifBlocking:blockingBlock
    "like critical:, but do not block if the lock cannot be aquired 
     within timeoutMs milliseconds.
     Instead, return the value of blockingBlock."

    |active retVal wasBlocked gotSema|

    active := Processor activeProcess.
    process == active ifTrue:[
        "I have already got the lock"
        ^ aBlock value
    ].

    "/
    "/ sema wait & process := active
    "/ and:
    "/ proces := nil & sema signal
    "/ must both be done atomic
    "/ Scenario:
    "/   ... recLock critical
    "/         got lock
    "/         evaluated
    "/         set process to nil
    "/         -> timer interrupt
    "/              recLock critical in timeOut action
    "/              process isNil
    "/                 sema wait !!!!!! DEADLOCK
    "/
    wasBlocked := OperatingSystem blockInterrupts.
    [
        gotSema := sema waitWithTimeoutMs:timeoutMs.
        gotSema notNil ifTrue:[
            process := active.
            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
            retVal := aBlock value.
        ].
    ] ifCurtailed:[
        "be careful - the unwind may occur both while waiting
         AND while evaluating the block"
        gotSema notNil ifTrue:[
            OperatingSystem blockInterrupts.
            process := nil.
            sema signal.
        ].
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ].
    gotSema notNil ifTrue:[
        OperatingSystem blockInterrupts.
        process := nil.
        sema signal.
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ] ifFalse:[
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        retVal := blockingBlock value.
    ].

    ^ retVal.
! !

!RecursionLock class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.37 2013-01-23 22:28:47 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.37 2013-01-23 22:28:47 cg Exp $'
! !