"
 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' }"

"{ NameSpace: Smalltalk }"

AbstractLock subclass:#RecursionLock
	instanceVariableNames:''
	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
    "same as new, for easy exchangability with regular mutual-exclusion Semaphores."

    ^ self new
! !

!RecursionLock methodsFor:'acquire & release'!

release
    "
    Release the lock.
    "
    super release ifFalse:[ 
        self error: ('Calling process does not own the lock (caller: %1, owner: %2)' bindWith: Processor activeProcess id with: (process isNil ifTrue:['<no owner>'] ifFalse:[process id])).
    ].

    "Created: / 03-10-2017 / 13:06:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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:$).
! !

!RecursionLock methodsFor:'queries'!

numberOfWaitingProcesses
    "return the number of waiting processes"

    ^ sema numberOfWaitingProcesses

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

wouldBlock
    "Check if the resource represented by the receiver is
     already in use by another process.
     Attention: if asked without some global lock (blockedInterrupts),
     the returned value may be outdated right away."

    |p|

    ^ (p := process) notNil and:[Processor activeProcess ~~ p and:[p isDead not]]
! !

!RecursionLock methodsFor:'signaling'!

signal
    self breakPoint: #jv.
    self release ifFalse:[
        self error: 'Attempt to release a (recursion) lock by process the does not own it!!'
    ]

    "Modified: / 25-08-2017 / 08:41:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!RecursionLock methodsFor:'waiting'!

wait
    self breakPoint: #jv.
    self acquire.

    "Modified: / 25-08-2017 / 08:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!RecursionLock class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_HG

    ^ '$Changeset: <not expanded> $'
! !