RecursionLock.st
changeset 10860 cd924455cfa9
parent 8568 624bfd00371f
child 11769 57f4dc3de6db
--- a/RecursionLock.st	Mon Feb 04 10:26:55 2008 +0100
+++ b/RecursionLock.st	Mon Feb 04 10:27:51 2008 +0100
@@ -9,8 +9,6 @@
  other person.  No title to or ownership of the software is
  hereby transferred.
 "
-
-
 "{ Package: 'stx:libbasic' }"
 
 Object subclass:#RecursionLock
@@ -215,10 +213,46 @@
     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 == active ifTrue:[
+"/        ^ aBlock value
+"/    ].
+
+    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"
 ! !
 
 !RecursionLock class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.32 2004-09-21 18:00:49 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.33 2008-02-04 09:27:51 cg Exp $'
 ! !