[Help-smalltalk] [PATCH] Fix Semaphore>>#critical: race conditions for real

[Paolo Bonzini]

This fixes all the race conditions that were recently fixed in Squeak. 
The fixes are less intrusive (luckily) for gst because it has a 
ProcessBeingTerminated notification.

This also includes a fix for #pass and #outer which were not copying 
fields right from the Signal of the outer exception handler to the 
Signal of the nested exception handler.

Fixes to Delay will come later.

Paolo

2007-10-06  Paolo Bonzini  <address@hidden>

        * kernel/AnsiExcept.st: Add semaphore field to
        ProcessBeingTerminated.  Remove #copyFrom:.
        * kernel/ExcHandling.st: remove #activateOuterHandlerFor:,
        inline it in the callers.  Remove #copyFrom:.
        * kernel/Process.st: In #terminate, pass semaphore if waiting on one.
        * kernel/RecursionLock.st: Remove #enter/#exit, inline them since
        we have to use Semaphore>>#critical:.
        * kernel/Semaphore.st: Rewrite #critical: to avoid races.
        * tests/processes.st: Add race condition testcases.


--- orig/kernel/AnsiExcept.st
+++ mod/kernel/AnsiExcept.st
@@ -226,14 +226,6 @@ CoreException, so the two mechanisms are
            signal
     ]
 
-    copyFrom: aSignal [
-       "Private - Initialize from another instance of Signal"
-
-       <category: 'private - copying'>
-       (aSignal isKindOf: Exception) ifTrue: [self initialize: aSignal 
creator].
-       super copyFrom: aSignal
-    ]
-
     creator [
        <category: 'private - copying'>
        ^creator
@@ -443,7 +435,9 @@ Namespace current: SystemExceptions [
 Notification subclass: ProcessBeingTerminated [
     
     <category: 'Language-Exceptions'>
-    <comment: nil>
+    <comment: 'I am raised when a process is terminated.'>
+
+    | semaphore |
 
     description [
        "Answer a textual description of the exception."
@@ -451,6 +445,20 @@ Notification subclass: ProcessBeingTermi
        <category: 'accessing'>
        ^'the current process is being terminated'
     ]
+
+    semaphore [
+       "If the process was waiting on a semaphore, answer it."
+
+       <category: 'accessing'>
+       ^semaphore
+    ]
+
+    semaphore: aSemaphore [
+       "If the process was waiting on a semaphore, answer it."
+
+       <category: 'accessing'>
+       semaphore := aSemaphore
+    ]
 ]
 
 ]


--- orig/kernel/ExcHandling.st
+++ mod/kernel/ExcHandling.st
@@ -350,21 +350,6 @@ hold on to a CoreException via a class-i
            previousState: nil
     ]
 
-    activateOuterHandlerFor: aSignal [
-       "Private - Raise the exception described by the receiver, passing a
-        Signal modeled after aSignal, and returning the return value of the
-        handler."
-
-       <category: 'private'>
-       | signal |
-       <exceptionHandlingInternal: true>
-       signal := (signalClass new)
-                   initException: self;
-                   copyFrom: aSignal.
-       self instantiateNextHandler: signal.
-       ^signal activateHandler: true
-    ]
-
     actualDefaultHandler [
        "Private - Answer the default handler for the receiver. It differs from
         #defaultHandler because if the default handler of the parent has to be
@@ -570,7 +555,8 @@ with a lower priority.'>
 
        <category: 'exception handling'>
        <exceptionHandlingInternal: false>
-       ^self exception activateOuterHandlerFor: self
+        self exception instantiateNextHandler: self copy.
+        ^self activateHandler: true
     ]
 
     pass [
@@ -580,7 +566,8 @@ with a lower priority.'>
 
        <category: 'exception handling'>
        <exceptionHandlingInternal: false>
-       ^self return: (self exception activateOuterHandlerFor: self)
+        self exception instantiateNextHandler: self copy.
+        ^self return: (self activateHandler: true)
     ]
 
     resume [
@@ -620,8 +607,8 @@ with a lower priority.'>
 
        <category: 'exception handling'>
        Kernel.CoreException resetAllHandlers.
-       replacementException return: (replacementException exception 
-                   activateOuterHandlerFor: replacementException)
+        replacementException exception instantiateNextHandler: 
replacementException.
+        ^replacementException return: (replacementException activateHandler: 
true)
     ]
 
     retry [
@@ -717,16 +704,6 @@ with a lower priority.'>
            ifFalse: [context at: context numArgs + 1 put: previousState]
     ]
 
-    copyFrom: aSignal [
-       "Private - Initialize from another instance of Signal"
-
-       <category: 'private'>
-       self
-           initArguments: aSignal arguments;
-           messageText: aSignal messageText;
-           tag: aSignal tag
-    ]
-
     initArguments: args [
        "Private - set the Signal's arguments to args."
 


--- orig/kernel/Process.st
+++ mod/kernel/Process.st
@@ -136,11 +136,16 @@ can suspend themselves and resume themse
         a ProcessBeingTerminated notification."
 
        <category: 'basic'>
-       
+       | semaphore |
+
        [self isTerminated ifTrue: [^self].
        Processor activeProcess == self 
            ifFalse: 
-               [self queueInterrupt: [SystemExceptions.ProcessBeingTerminated 
signal].
+               [semaphore := self isWaiting ifTrue: [myList].
+               self queueInterrupt:
+                   [SystemExceptions.ProcessBeingTerminated new
+                       semaphore: semaphore;
+                       signal].
                ^self]] 
                valueWithoutPreemption.
        SystemExceptions.ProcessBeingTerminated signal


--- orig/kernel/RecursionLock.st
+++ mod/kernel/RecursionLock.st
@@ -101,26 +101,10 @@ Object subclass: RecursionLock [
        self isOwnerProcess ifTrue: [^aBlock value].
 
        "Look out for race conditions!"
-       [self enter] on: ProcessBeingTerminated
-           do: 
-               [:ex | 
-               self exit.
-               ex pass].
-       ^aBlock ensure: [self exit]
-    ]
-
-    enter [
-       <category: 'private'>
-       
-       [sema wait.
-       owner := Processor activeProcess] valueWithoutPreemption
-    ]
-
-    exit [
-       <category: 'private'>
-       
-       [owner := nil.
-       sema signal] valueWithoutPreemption
+       sema critical: [
+           [owner := Processor activeProcess.
+           aBlock value]
+               ensure: [owner := nil]].
     ]
 
     initialize [


--- orig/kernel/Semaphore.st
+++ mod/kernel/Semaphore.st
@@ -64,12 +64,21 @@ I also provide some methods for implemen
        "Look out for race conditions!"
 
        <category: 'mutual exclusion'>
-       [self wait] on: ProcessBeingTerminated
-           do: 
-               [:ex | 
-               self signal.
-               ex pass].
-       ^aBlock ensure: [self signal]
+       | caught |
+       ^[
+           [
+               "The VM will not preempt the process between the two statements.
+                Note that it is *wrong* to set the variable to true before
+                obtaining the semaphore, but the exception handler straightens
+                that.  On the other hand, setting the variable to true after 
the
+                wait would be wrong if the process was preempted and terminated
+                after the wait (hence, with `caught' still set to false and the
+                semaphore obtained)."
+               caught := true.
+               self wait ] on: ProcessBeingTerminated do: [ :ex |
+                   ex semaphore isNil ifFalse: [ caught := false ] ].
+           aBlock value ]
+               ensure: [caught ifTrue: [self signal] ]
     ]
 
     name [


--- orig/tests/processes.ok
+++ mod/tests/processes.ok
@@ -52,3 +52,9 @@ returned value is true
 
 Execution begins...
 returned value is true
+
+Execution begins...
+returned value is true
+
+Execution begins...
+returned value is true


--- orig/tests/processes.st
+++ mod/tests/processes.st
@@ -177,3 +177,34 @@ Eval [
     s wait.
     ^s size = 0
 ]
+
+Eval [
+    "A semaphore that has just left the wait in Semaphore>>critical:
+     should signal the associated semaphore before leaving."
+    | s p |
+    s := Semaphore new.
+    p := [s critical:[]] forkAt: Processor activePriority - 1.
+
+    "Wait until p entered the critical section"
+    [p isWaiting] whileFalse: [Processor yield].
+
+    "Now that p entered it, signal the semaphore. p now 'owns' the semaphore
+     but since we are running at higher priority than p it will not get to do
+     anything."
+    s signal.
+    p ensureTermination.
+    ^s signals = 1
+]
+
+Eval [
+    "A process that has entered the wait in Semaphore>>critical:,
+     but never obtains the semaphore, should leave it without
+     signaling the semaphore."
+    | s p |
+    s := Semaphore new.
+    p := [s critical:[]] fork.
+    [p isWaiting] whileFalse: [Processor yield].
+    p ensureTermination.
+    ^s signals = 0
+]
+