RecursionLock.st
branchjv
changeset 23085 9effc2bcf8a6
parent 23084 0ffb59b273ff
child 23086 d3f84ef999e6
--- 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