--- a/RecursionLock.st Wed Aug 30 12:38:37 2017 +0100
+++ b/RecursionLock.st Thu Aug 31 10:17:00 2017 +0100
@@ -147,9 +147,13 @@
%}.
"/ Inflate the lock if it's not yet inflated.
"/
- "/ Note, that #inflate method checks again if it's inflated or not,
+ "/ Note that #inflate method checks again if it's inflated or not,
"/ it may haopen some other thread inflated the lock in between the check
"/ here and code in #inflate.
+ "/
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change.
process class == SmallInteger ifTrue:[ self inflate ].
^ super acquireWithTimeoutMs: timeout
!
@@ -174,7 +178,7 @@
"/
"/ Note that `someobject class == SmallInteger` is handled as a special
"/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
- "/ very fast - just bitwise and + non-zero test. Don't change!
+ "/ very fast - just bitwise and + non-zero test. Don't change.
process class == SmallInteger ifTrue:[ self inflate ].
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])).
@@ -191,6 +195,26 @@
"Modified: / 29-08-2017 / 09:53:37 / 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:'private'!
inflate
@@ -213,7 +237,7 @@
wasBlocked := OperatingSystem blockInterrupts.
"/ Note that `someobject class == SmallInteger` is handled as a special
"/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
- "/ very fast - just bitwise and + non-zero test. Don't change!
+ "/ very fast - just bitwise and + non-zero test. Don't change
process class == SmallInteger ifTrue:[
self processAndCountInto: processAndCount.
process := processAndCount at: 1.
@@ -271,26 +295,6 @@
! !
-!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
@@ -323,6 +327,46 @@
"Modified: / 25-08-2017 / 08:41:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!RecursionLock methodsFor:'synchronized evaluation'!
+
+critical:aBlock
+ "Evaluate aBlock as a critical region. Same process may
+ enter critical region again, i.e., nesting allowed."
+
+ <exception: #unwind>
+
+ | acquired retval |
+
+ acquired := self acquireWithTimeoutMs: nil.
+ acquired == true ifTrue:[
+ retval := aBlock value
+ ].
+ thisContext unmarkForUnwind.
+ acquired == true ifTrue:[
+ self release.
+ ].
+ ^ retval
+
+ "Created: / 31-08-2017 / 10:12:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!RecursionLock methodsFor:'unwinding'!
+
+unwindHandlerInContext:aContext
+ aContext selector == #critical: ifTrue:[
+ | acquired |
+ acquired := aContext varAt: 1.
+ acquired == true ifTrue:[
+ ^ [ aContext varAt: 1 put: nil. self release ]
+ ] ifFalse:[
+ ^ nil.
+ ].
+ ].
+ self shouldNeverBeReached.
+
+ "Created: / 31-08-2017 / 10:11:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!RecursionLock methodsFor:'waiting'!
wait