help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] Race in Process>>suspend


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] Race in Process>>suspend
Date: Thu, 06 Dec 2007 08:56:43 +0100
User-agent: Thunderbird 2.0.0.9 (Macintosh/20071031)

Process>>#suspend manipulates process lists in a non-atomic way. It is a big big problem if the VM interrupts Process>>#suspend and decides to manipulate the same list (in response to an external event). Fixed by making Process>>#suspend atomic, which simplifies many things (but changes the scheduling order in a way such that processes.st needs to be adjusted a little).

The bug was reported on the Squeak list; the fix, while conceptually similar, has a completely different shape.

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

        * kernel/BlkClosure.st: Don't modify the stack top in #asContext:.
        * kernel/ProcSched.st: Remove #changePriorityListOf:to:suspend:.
        * kernel/Process.st: Implement #suspend with a primitive.
        Use #resume to restart the process in the right priority list when
        the priority is changed and the process was not/is not to be suspended.
        Remove #setPriorityFrom:to:suspend:.

        * tests/processes.st: Be more robust in running processes to a
        sync point.  Avoid busy waiting which may or may not work depending
        on the execution order of the process.

        * libgst/interp.c: Extract part of suspend_process into
        remove_process_from_list.  Use it in resume_process if the process
        is active.  Yield the active process.
        * libgst/prims.def: Add VMpr_Process_suspend.

* looking for address@hidden/smalltalk--devo--2.2--patch-657 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-657
M  kernel/BlkClosure.st
M  kernel/ProcSched.st
M  kernel/Process.st
M  libgst/interp.c
M  tests/processes.st
M  libgst/prims.def

* modified files

--- orig/kernel/BlkClosure.st
+++ mod/kernel/BlkClosure.st
@@ -165,15 +165,17 @@ creation of Processes from blocks.'>
         Note that the block has no home, so it cannot contain returns."
 
        <category: 'private'>
-       | top block |
-       block := BlockContext fromClosure: self parent: parent.
-       parent isNil 
-           ifFalse: 
-               [top := parent sp == 0 
+       ^BlockContext
+           fromClosure: [
+               | top |
+               top := parent isNil
+                   ifTrue: [nil]
+                   ifFalse: [
+                       parent sp == 0 
                            ifTrue: [parent receiver]
-                           ifFalse: [parent at: parent sp].
-               parent sp: parent sp - 1].
-       ^block
+                           ifFalse: [parent at: parent sp]].
+               self value. top]
+           parent: parent.
     ]
 
     on: anException do: aBlock [


--- orig/kernel/ProcSched.st
+++ mod/kernel/ProcSched.st
@@ -66,20 +66,6 @@ Object subclass: ProcessorScheduler [
        ^self activeProcess priority
     ]
 
-    changePriorityListOf: aProcess to: aPriority suspend: aBoolean [
-       "Private - Move aProcess to the execution list for aPriority,
-        answer the new execution list"
-
-       <category: 'basic'>
-       (processLists at: aProcess priority) remove: aProcess ifAbsent: [].
-       ^aBoolean 
-           ifTrue: [nil]
-           ifFalse: 
-               [(processLists at: aPriority)
-                   addLast: aProcess;
-                   yourself]
-    ]
-
     processesAt: aPriority [
        "Answer a linked list of processes at the given priority"
 


--- orig/kernel/Process.st
+++ mod/kernel/Process.st
@@ -114,13 +114,8 @@ can suspend themselves and resume themse
         another process. Suspending is nothing more than taking ourselves out
         of every scheduling list and THEN yielding control to another process"
 
-       <category: 'basic'>
-       self isSuspended ifTrue: [^nil].
-       myList := Processor 
-                   changePriorityListOf: self
-                   to: priority
-                   suspend: true.
-       self yield
+       <category: 'builtins'>
+       <primitive: VMpr_Process_suspend>
     ]
 
     finalize [
@@ -237,45 +232,20 @@ can suspend themselves and resume themse
        "Change the receiver's priority to anInteger"
 
        <category: 'accessing'>
-       | old |
-       anInteger < Processor lowestPriority 
-           | (anInteger > Processor highestPriority) 
-               ifTrue: 
+       (anInteger between: Processor lowestPriority 
+           and: Processor highestPriority) 
+               ifFalse: 
                    [SystemExceptions.ArgumentOutOfRange 
                        signalOn: anInteger
                        mustBeBetween: Processor lowestPriority
                        and: Processor highestPriority].
-       self 
-           setPriorityFrom: Processor activePriority
-           to: anInteger
-           suspend: false
-    ]
-
-    setPriorityFrom: activePriority to: anInteger suspend: aBoolean [
-       "Change the priority to anInteger.  If aBoolean is true,
-        suspend the process after having done so; if it is false,
-        check if it is nicer to relinquish control from the running
-        process (based on the priority of the active process, that
-        is passed in activePriority) and if this is the case, preempt it."
 
-       <category: 'accessing'>
-       | state |
-       
-       [state := #wait.
-       self isReady ifTrue: [state := #ready].
-       self isActive ifTrue: [state := #active].
-       state = #wait 
-           ifFalse: 
-               [myList := Processor 
-                           changePriorityListOf: self
-                           to: anInteger
-                           suspend: aBoolean].
-       priority := anInteger.
-       (aBoolean or: 
-               [(state = #ready and: [activePriority < priority]) 
-                   or: [state = #active and: [activePriority > priority]]]) 
-           ifTrue: [Processor yield]] 
-               valueWithoutPreemption
+       [
+           | waiting |
+           waiting := self isActive not and: [ self isReady not ].
+           priority := anInteger.
+           waiting ifFalse: [self resume]
+       ] valueWithoutPreemption
     ]
 
     valueWithoutInterrupts: aBlock [
@@ -304,7 +274,7 @@ can suspend themselves and resume themse
                    ifTrue: [^SystemExceptions.ProcessTerminated signalOn: 
self].
                semaphore := myList.
                suspended := self isReady not.
-               block := suspended 
+               block := suspended
                            ifFalse: 
                                [self suspend.
                                aBlock]
@@ -372,14 +342,12 @@ can suspend themselves and resume themse
 
        | closure activePriority |
        activePriority := Processor activePriority.
-       closure := 
-               [
-               [
-               [self 
-                   setPriorityFrom: activePriority
-                   to: aPriority
-                   suspend: aBoolean.
-               aBlockClosure value] 
+       closure :=
+           [[[
+               "Inlined #priority: to be able to suspend the process."
+               priority := aPriority.
+               aBoolean ifTrue: [self suspend] ifFalse: [self resume].
+               aBlockClosure value]
                        on: SystemExceptions.ProcessBeingTerminated
                        do: 
                            [:sig | 


--- orig/libgst/interp.c
+++ mod/libgst/interp.c
@@ -1462,8 +1462,8 @@ add_first_link (OOP semaphoreOOP,
     sem->lastLink = processOOP;
 }
 
-void
-suspend_process (OOP processOOP)
+static void
+remove_process_from_list (OOP processOOP)
 {
   gst_semaphore sem;
   gst_process process, lastProcess;
@@ -1504,6 +1504,12 @@ suspend_process (OOP processOOP)
     }
 
   process->nextLink = _gst_nil_oop;
+}
+
+void
+suspend_process (OOP processOOP)
+{
+  remove_process_from_list (processOOP);
   if (get_scheduled_process() == processOOP)
     ACTIVE_PROCESS_YIELD ();
 }
@@ -1685,11 +1691,25 @@ resume_process (OOP processOOP,
 
   /* 2002-19-12: tried get_active_process instead of get_scheduled_process.  */
   activeOOP = get_active_process ();
-  if (processOOP == activeOOP)
-    return (true);
-
   active = (gst_process) OOP_TO_OBJ (activeOOP);
   process = (gst_process) OOP_TO_OBJ (processOOP);
+  priority = TO_INT (process->priority);
+
+  /* As a special exception, don't preempt a process that has disabled
+     interrupts. ### this behavior is currently disabled.  */
+  ints_enabled = IS_NIL (active->interrupts)
+                || TO_INT(active->interrupts) <= 0;
+
+  /* resume_process is also used when changing the priority of a ready/active
+     process.  In this case, first remove the process from its current list.  
*/
+  if (processOOP == activeOOP)
+    {
+      gcc_assert (!alwaysPreempt);
+      remove_process_from_list (processOOP);
+    }
+  else if (priority >= TO_INT (active->priority) /* && ints_enabled */ )
+    alwaysPreempt = true;
+
   if (IS_NIL (processOOP) || is_process_terminating (processOOP))
     /* The process was terminated - nothing to resume, fail */
     return (false);
@@ -1701,17 +1721,10 @@ resume_process (OOP processOOP,
       return (true);
     }
 
-  /* As a special exception, don't preempt a process that has disabled
-     interrupts. ### this behavior is currently disabled.  */
-  ints_enabled = IS_NIL (active->interrupts)
-                || TO_INT(active->interrupts) <= 0;
-
-  priority = TO_INT (process->priority);
   processLists = GET_PROCESS_LISTS ();
   processList = ARRAY_AT (processLists, priority);
 
-  if ((priority >= TO_INT (active->priority) /* && ints_enabled */ )
-      || alwaysPreempt)
+  if (alwaysPreempt)
     {
       /* We're resuming a process with a *equal or higher* priority, so sleep
          the current one and activate the new one */
@@ -1719,11 +1732,14 @@ resume_process (OOP processOOP,
       activate_process (processOOP);
     }
   else
-    /* this process has a lower priority than the active one, so the
-       policy is that it doesn't preempt the currently running one.
-       Anyway, it must be the first in its priority queue - so don't
-       put it to sleep.  */
-    add_first_link (processList, processOOP);
+    {
+      /* this process has a lower priority than the active one, so the
+         policy is that it doesn't preempt the currently running one.
+         Anyway, it must be the first in its priority queue - so don't
+         put it to sleep.  */
+      add_first_link (processList, processOOP);
+      ACTIVE_PROCESS_YIELD ();
+    }
 
   return (true);
 }


--- orig/libgst/prims.def
+++ mod/libgst/prims.def
@@ -2809,6 +2809,17 @@ primitive VMpr_Semaphore_waitAfterSignal
   PRIM_SUCCEEDED;
 }
 
+/* Process suspend */
+primitive VMpr_Process_suspend [succeed]
+{
+  OOP oop1;
+  _gst_primitives_executed++;
+
+  oop1 = STACKTOP ();
+  suspend_process (oop1);
+  PRIM_SUCCEEDED;
+}
+
 /* Process resume */
 primitive VMpr_Process_resume [succeed,fail,check_interrupt]
 {


--- orig/tests/processes.st
+++ mod/tests/processes.st
@@ -51,12 +51,15 @@ Eval [
 
 "Test Process suspend/resume"
 Eval [
+    goOn := false.
     p := [
         'inside p' printNl.
+       goOn := true.
         p suspend.
         'suspension finished' printNl ] newProcess name: 'test 2'; yourself.
     p printNl.
     p resume.
+    [ goOn ] whileFalse: [ Processor yield ].
     p printNl.
     p executeUntilTermination.
     p printNl
@@ -65,12 +68,15 @@ Eval [
 
 "Test processes yielding control to each other without suspending themselves"
 Eval [
+    goOn := false.
     p := [
         'inside p' printNl.
+       goOn := true.
         Processor yield.
         'yielded back to p' printNl ] newProcess name: 'test 3'; yourself.
     p printNl.
     p resume.
+    [ goOn ] whileFalse: [ Processor yield ].
     p printNl.
     p executeUntilTermination.
     p printNl
@@ -85,6 +91,7 @@ Eval [
         'wait finished' printNl ] newProcess name: 'test 4'; yourself.
     p printNl.
     p resume.
+    [ s size = 0 ] whileTrue: [ Processor yield ].
     p printNl.
     s signal.
     p printNl
@@ -94,7 +101,7 @@ Eval [
 "Now test process interrupts"
 Eval [
     s := Semaphore new.
-    ([ [ false ] whileFalse: [ ] ]
+    ([ [ false ] whileFalse: [ Processor yield ] ]
         forkAt: Processor userBackgroundPriority)
         name: 'background';
         queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ].
@@ -123,11 +130,14 @@ Eval [
 
 "Resume a process and check that it is removed from the semaphore"
 Eval [
+    | p1 p2 s p1ok p2ok |
     s := Semaphore new.
     p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
     p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
+    [ s size = 2 ] whileFalse: [ Processor yield ].
     p2 resume.
     s signal.
+    p1 ensureTermination.
     ^p1ok & p2ok & s size = 0
 ]
 
@@ -136,8 +146,10 @@ Eval [
     s := Semaphore new.
     p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
     p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
+    [ s size = 2 ] whileFalse: [ Processor yield ].
     p1 resume.
     s signal.
+    p2 ensureTermination.
     ^p1ok & p2ok & s size = 0
 ]
 




reply via email to

[Prev in Thread] Current Thread [Next in Thread]