On 25/03/2014 17:33, Paolo Bonzini wrote:
Il 25/03/2014 15:00, Gwenaël Casaccio ha scritto:
+ <category: 'private'>
+
+ Termination isNil ifFalse: [ ^ Termination ].
+ ^ [
+ Termination isNil ifTrue: [ Termination := MethodContext
+ stack: 4
+ flags: 6
+ method: UndefinedObject>>#__terminate
+ ip: 0
+ sp: -1 ].
+ Termination
+ ] valueWithoutPreemption
+ ]
Can you explain this better? What does it have to do with #ensure:?
Also, can you just use ##( ... ) and avoid #valueWithoutPreemption?
Paolo
I've rewritten the patch, termination is initialized in ProcessScheduler.
I need termination otherwhise the test is not working:
"Now test process interrupts"
Eval [
s := Semaphore new.
([ [ false ] whileFalse: [ Processor yield ] ]
forkAt: Processor userBackgroundPriority)
name: 'background';
queueInterrupt: [ (p := Processor activeProcess) printNl. s
signal ].
s wait.
p printNl.
p ensureTermination.
p printNl
]
Gwen
>From 547b31a734d2fb8139593b47b86053b8f1b56974 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <[email protected]>
Date: Fri, 11 Apr 2014 11:01:24 +0200
Subject: [PATCH] Change the process creation
The process is added on the correct priority queue and there are no need to
change the priority queue. Also if the process is suspended, it's not
executed.
2014-04-11 Gwenael Casaccio <[email protected]>
* kernel/Process.st: Change the process creation it set on the right
priority queue, the previous implementation sets it on a wrong priority
queue.
* kernel/ProcSched.st: Initialize the termination context variable.
* kernel/MthContext.st: Add a new MethodContext builder.
* kernel/SysExcept.st: ProcessBeingTerminated>>defaultHandler execute
all the ensure blocks.
---
ChangeLog | 10 ++++++++
kernel/MthContext.st | 17 ++++++++++++++
kernel/ProcSched.st | 1 +
kernel/Process.st | 64 ++++++++++++++++++----------------------------------
kernel/SysExcept.st | 5 ++++
5 files changed, 55 insertions(+), 42 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 7369612..4aa2f2c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2014-04-11 Gwenael Casaccio <[email protected]>
+
+ * kernel/Process.st: Change the process creation it set on the right
+ priority queue, the previous implementation sets it on a wrong priority
+ queue.
+ * kernel/ProcSched.st: Initialize the termination context variable.
+ * kernel/MthContext.st: Add a new MethodContext builder.
+ * kernel/SysExcept.st: ProcessBeingTerminated>>defaultHandler execute
+ all the ensure blocks.
+
2014-03-31 Gwenael Casaccio <[email protected]>
* kernel/Object.st: Make Object>>FinalizableObjects thread safe.
diff --git a/kernel/MthContext.st b/kernel/MthContext.st
index 4f6af36..00cafde 100644
--- a/kernel/MthContext.st
+++ b/kernel/MthContext.st
@@ -41,6 +41,23 @@ 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 [
+ <category: 'instance creation'>
+
+ ^ (self new: size)
+ flag: anInteger method: aMethod ip: anIpInteger sp: anSpInteger;
+ yourself
+ ]
+
+ flag: anInteger method: aMethod ip: anIpInteger sp: anSpInteger [
+ <category: 'initialization'>
+
+ flags := anInteger.
+ ip := anIpInteger.
+ sp := anSpInteger.
+ method := aMethod.
+ ]
+
printOn: aStream [
"Print a representation for the receiver on aStream"
diff --git a/kernel/ProcSched.st b/kernel/ProcSched.st
index 77698db..1090658 100644
--- a/kernel/ProcSched.st
+++ b/kernel/ProcSched.st
@@ -286,6 +286,7 @@ Object subclass: ProcessorScheduler [
<category: 'idle tasks'>
| finalizerProcess |
+ Process terminationContext.
idleTasks := OrderedCollection with: 0.
gcSemaphore := Semaphore new.
eventSemaphore := Semaphore new.
diff --git a/kernel/Process.st b/kernel/Process.st
index 652b841..76d0742 100644
--- a/kernel/Process.st
+++ b/kernel/Process.st
@@ -40,6 +40,17 @@ Link subclass: Process [
executable blocks that have a priority associated with them, and they
can suspend themselves and resume themselves however they wish.'>
+ Process class >> terminationContext [
+ <category: 'private'>
+
+ Termination := MethodContext
+ stack: 4
+ flags: 6
+ method: UndefinedObject>>#__terminate
+ ip: 0
+ sp: -1
+ ]
+
Process class >> on: aBlockClosure at: aPriority suspend: aBoolean [
"Private - Create a process running aBlockClosure at the given
priority. The process is suspended immediately after
@@ -370,48 +381,17 @@ can suspend themselves and resume themselves however they wish.'>
valueWithoutPreemption
]
- onBlock: aBlockClosure at: aPriority suspend: aBoolean [
- <category: 'private'>
- "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
- ]
+ onBlock: aBlockClosure at: aPriority suspend: suspended [
+ <category: 'private'>
+
+ | closure |
+ closure := [ [ aBlockClosure value ] ensure: [ self primTerminate ] ].
+ suspendedContext := closure asContext: Termination copy.
+ priority := aPriority.
+ self addToBeFinalized.
+ suspended ifTrue: [ ^ self ].
+ self resume
+ ]
isActive [
"Answer whether the receiver is running"
diff --git a/kernel/SysExcept.st b/kernel/SysExcept.st
index 1adcb6f..80d61a9 100644
--- a/kernel/SysExcept.st
+++ b/kernel/SysExcept.st
@@ -298,6 +298,11 @@ Notification subclass: ProcessBeingTerminated [
<category: 'accessing'>
semaphore := aSemaphore
]
+
+ defaultAction [
+ <category: 'accessing'>
+ thisContext environment continue: nil
+ ]
]
]
--
1.8.3.2
_______________________________________________
help-smalltalk mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/help-smalltalk
