[PATCH] Race in Process>>suspend

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  <[hidden email]>

        * 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 [hidden email]--2004b/smalltalk--devo--2.2--patch-657 to compare with
* comparing to [hidden email]--2004b/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
 ]
 




_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk