>From 7a3a836e5566291b5d95341ddeae9be451434bfc Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Mon, 24 Mar 2014 09:14:22 +0100
Subject: [PATCH] Update process creation, process resume does not resume
waiting process and changing priority is checking the right priority queue.
Adds tests
---
kernel/MthContext.st | 15 ++
kernel/Process.st | 103 +++-----
kernel/SysExcept.st | 28 +++
libgst/prims.def | 7 +-
packages/kernel-tests/kernel/ProcessTests.st | 341 +++++++++++++++++++++++++++
packages/kernel-tests/package.xml | 2 +
tests/processes.ok | 3 +-
tests/processes.st | 10 +-
8 files changed, 433 insertions(+), 76 deletions(-)
create mode 100644 packages/kernel-tests/kernel/ProcessTests.st
diff --git a/kernel/MthContext.st b/kernel/MthContext.st
index 4f6af36..bc9e024 100644
--- a/kernel/MthContext.st
+++ b/kernel/MthContext.st
@@ -41,6 +41,21 @@ ContextPart subclass: MethodContext [
bits of information about the execution environment, and contain the
execution stack.'>
+ MethodContext class >> stack: size flags: anInteger method: aMethod ip: anIpInteger sp: anSpInteger [
+
+ ^ (self new: size)
+ flag: anInteger method: aMethod ip: anIpInteger sp: anSpInteger;
+ yourself
+ ]
+
+ flag: anInteger method: aMethod ip: anIpInteger sp: anSpInteger [
+
+ flags := anInteger.
+ ip := anIpInteger.
+ sp := anSpInteger.
+ method := aMethod.
+ ]
+
printOn: aStream [
"Print a representation for the receiver on aStream"
diff --git a/kernel/Process.st b/kernel/Process.st
index 751a80d..546cf1e 100644
--- a/kernel/Process.st
+++ b/kernel/Process.st
@@ -52,6 +52,16 @@ can suspend themselves and resume themselves however they wish.'>
suspend: aBoolean
]
+ Process class >> termination [
+
+
+ Termination isNil ifFalse: [ ^ Termination ].
+ ^ [
+ Termination isNil ifTrue: [ Termination := MethodContext stack: 4 flags: 6 method: UndefinedObject>>#__terminate ip: 0 sp: -1 ].
+ Termination
+ ] valueWithoutPreemption
+ ]
+
debugger [
"Return the object in charge of debugging the receiver. This always returns
nil unless the DebugTools package is loaded."
@@ -69,17 +79,6 @@ can suspend themselves and resume themselves however they wish.'>
ifFalse: [suspendedContext]
]
- makeUntrusted: aBoolean [
- "Set whether the receiver is trusted or not."
-
-
- | ctx |
- ctx := self context.
- [ctx isNil] whileFalse:
- [ctx makeUntrusted: aBoolean.
- ctx := ctx parentContext]
- ]
-
lowerPriority [
"Lower a bit the priority of the receiver. A #lowerPriority will
cancel a previous #raisePriority, and vice versa."
@@ -169,7 +168,7 @@ can suspend themselves and resume themselves however they wish.'>
self removeToBeFinalized.
suspendedContext := nil.
- self suspend
+ self suspend.
]
printOn: aStream [
@@ -265,12 +264,12 @@ can suspend themselves and resume themselves however they wish.'>
and: Processor highestPriority].
[
- | activePriority |
- activePriority := Processor activePriority.
+ | oldPriority |
+ oldPriority := priority.
priority := anInteger.
"Atomically move the process to the right list, preempting
the current process if necessary."
- self isReady ifTrue: [self resume].
+ (myList == (Processor processesAt: oldPriority)) ifTrue: [self primResume: false].
] valueWithoutPreemption
]
@@ -300,9 +299,9 @@ can suspend themselves and resume themselves however they wish.'>
^self].
self isTerminated ifFalse: [
block := [self evaluate: [anException signal]
- ifNotTerminated: [self resume]].
+ ifNotTerminated: [self primResume: false]].
suspendedContext := block asContext: suspendedContext.
- self resume]]
+ self primResume: false]]
]
queueInterrupt: aBlock [
@@ -332,7 +331,7 @@ can suspend themselves and resume themselves however they wish.'>
ifTrue: [[self evaluate: aBlock ifNotTerminated: [self suspend]]]
ifFalse: [[self evaluate: aBlock ifNotTerminated: [semaphore wait]]]].
suspendedContext := block asContext: suspendedContext.
- self resume]
+ self primResume: false]
]
evaluate: aBlock ifNotTerminated: unwindBlock [
@@ -340,7 +339,7 @@ can suspend themselves and resume themselves however they wish.'>
| terminated |
terminated := false.
- [aBlock on: ProcessBeingTerminated
+ [aBlock on: SystemExceptions.ProcessBeingTerminated
do:
[:sig |
terminated := true.
@@ -377,58 +376,16 @@ can suspend themselves and resume themselves however they wish.'>
valueWithoutPreemption
]
- startExecution: aDirectedMessage [
- "It is important to retrieve this before we start the
- process, because we want to choose whether to continue
- running the new process based on the *old* activePriority,
- not the one of the new process which is the maximum one."
-
-
- [aDirectedMessage send] on: SystemExceptions.ProcessBeingTerminated
- do: [:sig | sig return]
- ]
-
onBlock: aBlockClosure at: aPriority suspend: aBoolean [
- "It is important to retrieve this before we start the
- process, because we want to choose whether to continue
- running the new process based on the *old* activePriority,
- not the one of the new process which is the maximum one."
-
- | closure activePriority |
- activePriority := Processor activePriority.
- closure :=
- [[[
- "#priority: is inlined for two reasons. First, to be able to
- suspend the process, and second because we need to invert
- the test on activePriority! This because here we may want to
- yield to the creator, while in #priority: we may want to yield
- to the process whose priority was changed."
- priority := aPriority.
- aBoolean
- ifTrue: [self suspend]
- ifFalse: [
- aPriority < activePriority ifTrue: [ Processor yield ] ].
- aBlockClosure value]
- on: SystemExceptions.ProcessBeingTerminated
- do:
- [:sig |
- "If we terminate in the handler, the 'ensure' blocks are not
- evaluated. Instead, if the handler returns, the unwinding
- is done properly."
-
- sig return]]
- ensure: [self primTerminate]].
-
- "Start the Process immediately so that we get into the
- #on:do: handler. Otherwise, we will not be able to
- terminate the process with #terminate. The #resume will
- preempt the forking process."
- suspendedContext := closure asContext: nil.
- priority := Processor unpreemptedPriority.
- self
- addToBeFinalized;
- resume
+
+ | closure |
+ closure := [ [ aBlockClosure value ] ensure: [ self primTerminate ] ].
+ suspendedContext := closure asContext: (self class termination) copy.
+ priority := aPriority.
+ self addToBeFinalized.
+ aBoolean ifTrue: [ ^ self ].
+ self primResume: false
]
isActive [
@@ -485,6 +442,14 @@ can suspend themselves and resume themselves however they wish.'>
"Resume the receiver's execution"
+ self isWaiting ifTrue: [ ^ SystemExceptions.ProcessWaiting signalOn: self ].
+ self primResume: false.
+ ]
+
+ primResume: aBoolean [
+ "Resume the receiver's execution"
+
+
SystemExceptions.ProcessTerminated signalOn: self
]
diff --git a/kernel/SysExcept.st b/kernel/SysExcept.st
index 1adcb6f..562d9f3 100644
--- a/kernel/SysExcept.st
+++ b/kernel/SysExcept.st
@@ -298,6 +298,15 @@ Notification subclass: ProcessBeingTerminated [
semaphore := aSemaphore
]
+
+ defaultAction [
+
+ 'ici' printNl.
+ thisContext backtrace.
+ thisContext environment continue: nil
+ ]
+
+
]
]
@@ -885,6 +894,25 @@ InvalidValue subclass: ProcessTerminated [
Namespace current: SystemExceptions [
+InvalidValue subclass: ProcessWaiting [
+
+
+
+
+ description [
+ "Answer a textual description of the exception."
+
+
+ ^'process is/was waiting on a semaphore'
+ ]
+]
+
+]
+
+
+
+Namespace current: SystemExceptions [
+
InvalidValue subclass: InvalidProcessState [
diff --git a/libgst/prims.def b/libgst/prims.def
index a67c3fd..eb9df4d 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -2880,10 +2880,15 @@ primitive VMpr_Process_suspend [succeed,check_interrupt]
primitive VMpr_Process_resume [succeed,fail,check_interrupt]
{
OOP oop1;
+ OOP oop2;
_gst_primitives_executed++;
+ if (numArgs != 1)
+ PRIM_FAILED;
+
+ oop2 = POP_OOP ();
oop1 = STACKTOP ();
- if (resume_process (oop1, false))
+ if (resume_process (oop1, oop2 == _gst_true_oop))
PRIM_SUCCEEDED;
else
PRIM_FAILED;
diff --git a/packages/kernel-tests/kernel/ProcessTests.st b/packages/kernel-tests/kernel/ProcessTests.st
new file mode 100644
index 0000000..c5c25be
--- /dev/null
+++ b/packages/kernel-tests/kernel/ProcessTests.st
@@ -0,0 +1,341 @@
+"======================================================================
+|
+| Process Tests
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2014
+| Free Software Foundation, Inc.
+| Written by Gwenael Casaccio.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+TestCase subclass: TestProcess [
+
+ testProcessCreation [
+
+ | p_1 ok |
+ Processor activeProcess name: 'test creation'.
+ Processor activeProcess priority: 4.
+
+ p_1 := [ ] newProcess.
+ p_1 name: 'p_11'.
+
+ self assert: p_1 isSuspended.
+ 1 to: 9 do: [ :i | self assert: ((Processor processesAt: i) includes: p_1) not ].
+
+ p_1 := [
+ | p_1 |
+ p_1 := Processor activeProcess.
+ p_1 name: 'p_12'.
+
+ self assert: (p_1 instVarAt: 4) first == p_1.
+ self assert: (Processor processesAt: 4) == (p_1 instVarAt: 4).
+ self assert: (Processor processesAt: 4) first == p_1.
+ ] fork.
+
+ self assert: p_1 isTerminated.
+
+ ok := #test_creation.
+ p_1 := [
+ | p_1 |
+ p_1 := Processor activeProcess.
+ p_1 name: 'p_13'.
+
+ ok := #p_13.
+ ] forkAt: 2.
+
+ self assert: ok = #test_creation.
+
+ ok := #test_creation.
+ p_1 := [
+ | p_1 |
+ p_1 := Processor activeProcess.
+ p_1 name: 'p_14'.
+
+ self assert: ok = #test_creation.
+
+ ok := #p_14.
+ ] forkAt: 6.
+
+ self assert: ok = #p_14.
+ ]
+
+ testResume [
+
+ | p_1 sem ok |
+ Processor activeProcess
+ priority: 4;
+ raisePriority;
+ name: 'test resume'.
+
+ ok := false.
+ [
+ p_1 := Processor activeProcess.
+ p_1 name: 'p_11'.
+ ok := true
+ ] fork.
+
+ self should: [ p_1 resume ] raise: SystemExceptions.ProcessTerminated.
+ self assert: p_1 isTerminated.
+ self assert: ok.
+
+ ok := false.
+ [
+ p_1 := Processor activeProcess.
+ p_1 name: 'p_12'.
+ p_1 suspend.
+ ok := true.
+ ] fork.
+
+ self assert: p_1 name = 'p_12'.
+ self assert: p_1 isSuspended.
+ self assert: (p_1 instVarAt: 4) isNil.
+ self shouldnt: [ p_1 resume ] raise: SystemExceptions.ProcessTerminated.
+ self assert: p_1 isTerminated.
+ self assert: ok.
+
+ ok := false.
+ [
+ p_1 := Processor activeProcess.
+ p_1 name: 'p_13'.
+ Processor yield.
+ ok := true.
+ ] fork.
+
+ self assert: ok not.
+ self assert: p_1 isReady.
+ p_1 resume.
+ self assert: ok.
+ self assert: p_1 isTerminated.
+
+ ok := false.
+ p_1 := [
+ p_1 name: 'p_14'.
+ ok := true.
+ ] forkAt: 4.
+
+ self assert: ok not.
+ self assert: p_1 isReady.
+ p_1 resume. " does not resume process inf. priority "
+ self assert: ok not.
+ self assert: p_1 isReady.
+ Processor yield. " schedule it "
+ self assert: ok.
+ self assert: p_1 isTerminated.
+
+ ok := true.
+ sem := Semaphore new.
+ p_1 := [ sem wait. ok := false. ] fork.
+
+ self should: [ p_1 resume ] raise: SystemExceptions.ProcessWaiting.
+ self assert: ok.
+
+ sem signal.
+ ]
+
+ testScheduling [
+
+ | array p_1 p_2 p_3 p_4 stream |
+ Processor activeProcess priority: 4.
+ array := OrderedCollection new.
+
+ [ 10 timesRepeat: [ array add: Processor activeProcess priority ] ] forkAt: 6.
+ [ 10 timesRepeat: [ array add: Processor activeProcess priority ] ] forkAt: 5.
+ p_1 := [ 10 timesRepeat: [ array add: Processor activeProcess priority ] ] forkAt: 4.
+ p_2 := [ 10 timesRepeat: [ array add: Processor activeProcess priority ] ] forkAt: 3.
+
+ self assert: array size = 30.
+ 1 to: 10 do: [ :i | self assert: (array at: i) = 6 ].
+ 11 to: 20 do: [ :i | self assert: (array at: i) = 5 ].
+ 21 to: 30 do: [ :i | self assert: (array at: i) = 4 ].
+
+ [ p_2 isTerminated ] whileFalse: [ Processor yield ].
+
+ self assert: array size = 40.
+ 31 to: 40 do: [ :i | self assert: (array at: i) = 3 ].
+
+ array := OrderedCollection new.
+ p_1 := [
+ 5 timesRepeat: [
+ 10 timesRepeat: [ array add: #A ].
+ Processor yield.
+ ]
+ ] forkAt: 6.
+ p_2 := [
+ 5 timesRepeat: [
+ 10 timesRepeat: [ array add: #B ].
+ Processor yield.
+ ]
+ ] forkAt: 6.
+
+ self assert: array size = 100.
+
+ stream := ReadStream on: array.
+ 5 timesRepeat: [
+ 10 timesRepeat: [ self assert: stream next = #A ].
+ 10 timesRepeat: [ self assert: stream next = #B ].
+ ].
+
+ array := OrderedCollection new.
+ p_1 := [
+ 5 timesRepeat: [
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ ]
+ ] forkAt: 6.
+ p_2 := [
+ 5 timesRepeat: [
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ ]
+ ] forkAt: 5.
+ p_3 := [
+ 5 timesRepeat: [
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ ]
+ ] forkAt: 4.
+ p_4 := [
+ 5 timesRepeat: [
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ 5 timesRepeat: [ array add: Processor activeProcess priority ].
+ Processor yield.
+ ]
+ ] forkAt: 3.
+
+ [ p_1 isTerminated and: [ p_2 isTerminated and: [ p_3 isTerminated and: [ p_4 isTerminated ] ] ] ] whileFalse: [ Processor yield ].
+ "array printNl."
+ ]
+
+ testPriority [
+
+ | p_1 ok |
+ Processor activeProcess priority: 4.
+ Processor activeProcess name: 'test priority'.
+
+ p_1 := [ ] newProcess.
+ self assert: p_1 priority = Processor activeProcess priority.
+ self assert: (p_1 instVarAt: 4) isNil.
+
+ p_1 lowerPriority.
+ self assert: p_1 priority = (Processor activeProcess priority - 1).
+ self assert: (p_1 instVarAt: 4) isNil.
+
+ p_1 := [ ] forkAt: 3.
+ self assert: p_1 priority = 3.
+ self assert: (p_1 instVarAt: 4) == (Processor processesAt: 3).
+
+ p_1 lowerPriority.
+ self assert: p_1 priority = 2.
+ self assert: (p_1 instVarAt: 4) == (Processor processesAt: 2).
+
+ ok := false.
+ p_1 := [
+ ok := true.
+ Processor yield.
+ ] forkAt: 3.
+ self assert: p_1 priority = 3.
+ self assert: (p_1 instVarAt: 4) == (Processor processesAt: 3).
+ self assert: ok not.
+
+ p_1 priority: 6.
+ self assert: p_1 priority = 6.
+ self assert: (p_1 instVarAt: 4) == (Processor processesAt: 6).
+ self assert: ok.
+ Processor yield.
+ self assert: p_1 isTerminated.
+ ]
+
+ testTerminate [
+
+ | p_1 ok ko sem |
+ Processor activeProcess priority: 4.
+ ok := false.
+ ko := true.
+ p_1 := [ [
+ Processor activeProcess terminate.
+ ko := false.
+ ] ensure: [ ok := true ]
+ ] fork.
+
+ self assert: p_1 isTerminated.
+ self assert: ok.
+ self assert: ko.
+
+ ok := false.
+ ko := true.
+ p_1 := [ [ Processor yield. ko := false ] ensure: [ ok := true ] ] newProcess.
+ p_1 resume.
+ p_1 terminate.
+ self assert: p_1 isTerminated.
+ self assert: ok.
+ self assert: ko.
+
+ ok := true.
+ ko := true.
+ p_1 := [ [ ko := false ] ensure: [ ok := false ] ] newProcess.
+ p_1 terminate.
+ self assert: p_1 isTerminated.
+ self assert: ok.
+ self assert: ko.
+
+ ok := false.
+ ko := true.
+ sem := Semaphore new.
+ p_1 := [ [ sem wait. ko := false ] ensure: [ ok := true ] ] fork.
+
+ p_1 terminate.
+ self assert: p_1 isTerminated.
+ self assert: ok.
+ self assert: ko.
+ ]
+
+ testProcessQueue [
+
+ | p_1 |
+ Processor activeProcess priority: 4.
+
+ p_1 := [ Processor yield ] newProcess.
+ 1 to: 9 do: [ : i | self assert: ((Processor processesAt: i) noneSatisfy: [ : proc | proc == p_1 ]) ].
+ p_1 resume.
+ 1 to: 3 do: [ : i | self assert: ((Processor processesAt: i) noneSatisfy: [ : proc | proc == p_1 ]) ].
+ 4 to: 4 do: [ : i | self assert: ((Processor processesAt: i) count: [ : proc | proc == p_1 ]) == 1 ].
+ 5 to: 9 do: [ : i | self assert: ((Processor processesAt: i) noneSatisfy: [ : proc | proc == p_1 ]) ].
+
+ p_1 := [ Processor yield ] forkAt: 3.
+ 1 to: 2 do: [ : i | self assert: ((Processor processesAt: i) noneSatisfy: [ : proc | proc == p_1 ]) ].
+ 3 to: 3 do: [ : i | self assert: ((Processor processesAt: i) count: [ : proc | proc == p_1 ]) == 1 ].
+ 4 to: 9 do: [ : i | self assert: ((Processor processesAt: i) noneSatisfy: [ : proc | proc == p_1 ]) ].
+ p_1 priority: 1.
+ 1 to: 1 do: [ : i | self assert: ((Processor processesAt: i) count: [ : proc | proc == p_1 ]) == 1 ].
+ 2 to: 9 do: [ : i | self assert: ((Processor processesAt: i) noneSatisfy: [ : proc | proc == p_1 ]) ].
+ ]
+]
diff --git a/packages/kernel-tests/package.xml b/packages/kernel-tests/package.xml
index 6a84aad..5172ed1 100644
--- a/packages/kernel-tests/package.xml
+++ b/packages/kernel-tests/package.xml
@@ -2,6 +2,7 @@
Kernel-Tests
+ TestProcess
TestBehavior
TestCCallable
TestCompiledMethod
@@ -9,6 +10,7 @@
TestMappedCollection
TestObject
TestRegexp
+ kernel/ProcessTests.st
kernel/BehaviorTests.st
kernel/CCallableTest.st
kernel/CompiledMethodTests.st
diff --git a/tests/processes.ok b/tests/processes.ok
index f1b0638..932c2ce 100644
--- a/tests/processes.ok
+++ b/tests/processes.ok
@@ -32,12 +32,13 @@ returned value is Process new "<0>"
Execution begins...
Process('background' at userBackgroundPriority, active)
Process('background' at userBackgroundPriority, ready to run)
-Process('background' at userBackgroundPriority, terminated)
+Process('background' at userBackgroundPriority, suspended)
returned value is Process new "<0>"
Execution begins...
Process('interrupted' at userInterruptPriority, active)
Process('interrupted' at userInterruptPriority, suspended)
+'should go back to sleep'
Process('interrupted' at userInterruptPriority, terminated)
returned value is Process new "<0>"
diff --git a/tests/processes.st b/tests/processes.st
index a557165..7353452 100644
--- a/tests/processes.st
+++ b/tests/processes.st
@@ -32,7 +32,7 @@ Process extend [
executeUntilTermination [
self isTerminated ifTrue: [ ^self ].
- self isActive ifFalse: [ self resume ].
+ self isActive ifFalse: [ self primResume: false ].
[ self isTerminated ] whileFalse: [ Processor yield ]
]
@@ -90,7 +90,7 @@ Eval [
s wait.
'wait finished' printNl ] newProcess name: 'test 4'; yourself.
p printNl.
- p resume.
+ p primResume: false.
[ s size = 0 ] whileTrue: [ Processor yield ].
p printNl.
s signal.
@@ -108,7 +108,7 @@ Eval [
s wait.
p printNl.
- p ensureTermination.
+ p suspend.
p printNl
]
@@ -135,7 +135,7 @@ Eval [
p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
[ s size = 2 ] whileFalse: [ Processor yield ].
- p2 resume.
+ p2 primResume: false.
s signal.
p1 ensureTermination.
^p1ok & p2ok & s size = 0
@@ -147,7 +147,7 @@ Eval [
p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
[ s size = 2 ] whileFalse: [ Processor yield ].
- p1 resume.
+ p1 primResume: false.
s signal.
p2 ensureTermination.
^p1ok & p2ok & s size = 0
--
1.8.3.2