>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