[Top][All Lists]
[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
]
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Race in Process>>suspend,
Paolo Bonzini <=