--- a/ProcessorScheduler.st Fri Aug 05 02:55:07 1994 +0200
+++ b/ProcessorScheduler.st Fri Aug 05 02:59:40 1994 +0200
@@ -11,17 +11,19 @@
"
Object subclass:#ProcessorScheduler
- instanceVariableNames:'quiescentProcessLists
+ instanceVariableNames:'quiescentProcessLists scheduler
zombie
activeProcess currentPriority
readFds readSemaphores readChecks
- writeFds writeSemaphores writeChecks
- timeouts timeoutActions timeoutSemaphores
- idleActions anyTimeouts dispatching
- timeoutProcess'
+ writeFds writeSemaphores
+ timeouts timeoutActions timeoutProcesses timeoutSemaphores
+ idleActions anyTimeouts dispatching'
classVariableNames:'KnownProcesses KnownProcessIds
PureEventDriven
- UserSchedulingPriority TimingPriority'
+ UserSchedulingPriority
+ UserInterruptPriority
+ TimingPriority
+ SchedulingPriority'
poolDictionaries:''
category:'Kernel-Processes'
!
@@ -29,6 +31,8 @@
ProcessorScheduler comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.18 1994-08-05 00:59:25 claus Exp $
'!
Smalltalk at:#Processor put:nil!
@@ -51,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.17 1994-06-02 16:21:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.18 1994-08-05 00:59:25 claus Exp $
"
!
@@ -60,6 +64,62 @@
This class has only one instance, which is bound to the global
'Processor'. It is responsible for scheduling among the smalltalk
processes (threads; not to confuse with heavy weight unix processes).
+
+ Scheduling is fully done in smalltalk (the always runnable scheduler-
+ process, running at highest priority does this).
+ The main primitive support is used in threadSwitch, which passes
+ control to another process (usually selected by the scheduler).
+ Thus it is possible to modify the schedulers policy.
+ (To answer a frequently asked question:
+ dont add preemtive round-robin here; this can be implemented without
+ any need to change the scheduler. See goodies/timeslicing.st for how
+ this is done in a very elegant way).
+
+ Notice: Smalltalk/X can (still) be compiled & configured without
+ process support. This non-process mode is called 'pureEventDriven' mode
+ and is useful to quickly port ST/X to systems, where these facilities
+ are either not needed (server applications), or are difficult to
+ implement (threads require some assembler support functions).
+ To allow pureEvent mode, kludges are built into some places in the
+ system, where either a process is forked, or a timeout is used instead
+ (for examples, see ProcessMonitor or MemoryMonitor).
+
+ This pure-event mode may not be supported in the future.
+
+ class variables:
+
+ KnownProcesses <Collection> all known processes
+ KnownProcessIds <Collection> and their IDs
+ PureEventDriven <Boolean> true, if no process support
+ is available
+ UserSchedulingPriority <Integer> the priority at which normal
+ user interfaces run
+ UserInterruptPriority the priority at which user-
+ interrupts (Cntl-C) processing
+ takes place. Processes with
+ a greater or equal priority are
+ not interruptable.
+ TimingPriority the priority used for timing.
+ Processes with a greater or
+ equal priority are not interrupted
+ by timers.
+ SchedulingPriority The priority of the scheduler (must
+ me higher than any other).
+
+
+ most interresting methods:
+
+ Processor>>suspend: (see also Process>>suspend)
+ Processor>>resume: (see also Process>>resume)
+ Processor>>terminate: (see also Process>>terminate)
+ Processor>>yield
+ Processor>>changePriority:for: (see also Process>>priority:
+
+ Processor>>signal:afterSeconds: (see also Delay>>forSeconds:)
+ Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
+ Processor>>signal:onInput: (see also ExternalStream>>readWait)
+ Processor>>signal:onOutput: (see also ExternalStream>>writeWait)
+ Processor>>disableSemaphore:
"
! !
@@ -69,6 +129,11 @@
"class setup: create the one-and-only instance of myself and
setup some priority values."
+ UserSchedulingPriority := 8.
+ UserInterruptPriority := 24.
+ TimingPriority := 16.
+ SchedulingPriority := 31.
+
KnownProcesses isNil ifTrue:[
KnownProcesses := WeakArray new:10.
KnownProcesses watcher:self.
@@ -89,18 +154,15 @@
"
PureEventDriven := self threadsAvailable not.
PureEventDriven ifTrue:[
- 'no process support - running event driven' errorPrintNewline
+ 'no process support - running event driven' errorPrintNL
].
-
- UserSchedulingPriority := 8.
- TimingPriority := 16.
!
update:something
"being a dependent of the ObjectMemory, this is the notification
that something happened"
- something == #returnFromSnapshot ifTrue:[
+ something == #restarted ifTrue:[
self reinstallProcesses
]
!
@@ -115,7 +177,7 @@
"how, exactly should this be done ?"
p id ~~ 0 ifTrue:[
- 'process restart not implemented' errorPrintNewline
+ 'process restart not implemented' errorPrintNL
]
]
]
@@ -144,7 +206,9 @@
(KnownProcesses at:index) isNil ifTrue:[
id := KnownProcessIds at:index.
id notNil ifTrue:[
- Transcript showCr:('terminate thread (no longer refd) ', id printString).
+ Transcript showCr:('terminate thread ',
+ id printString,
+ ' (no longer refd)').
self threadDestroy:id.
KnownProcessIds at:index put:nil.
]
@@ -179,6 +243,12 @@
"turn on process driven mode"
PureEventDriven := false
+!
+
+knownProcesses
+ "return a collection of all (living) processes in the system"
+
+ ^ KnownProcesses select:[:p | p notNil]
! !
!ProcessorScheduler class methodsFor:'primitive process primitives'!
@@ -194,13 +264,13 @@
%}
!
-threadInterrupt:id with:aBlock
- "make the process evaluate aBlock when it awakes the next time"
+threadInterrupt:id
+ "make the process evaluate an interrupt"
%{ /* NOCONTEXT */
- if (_isSmallInteger(id) && __isBlock(aBlock)) {
- __threadInterrupt(_intVal(id), aBlock);
+ if (_isSmallInteger(id)) {
+ __threadInterrupt(_intVal(id));
}
%}
!
@@ -246,47 +316,57 @@
"continue execution in aProcess.
(warning: low level entry, no administration is done here)"
- |id pri ok oldProcess oldPri p|
+ |id pri ok oldProcess oldPri p singleStep wasBlocked|
aProcess isNil ifTrue:[^ self].
aProcess == activeProcess ifTrue:[^ self].
+ wasBlocked := OperatingSystem blockInterrupts.
+
oldProcess := activeProcess.
oldPri := currentPriority.
id := aProcess id.
pri := aProcess priority.
+ singleStep := aProcess isSingleStepping.
aProcess state:#active.
+ oldProcess state == #active ifTrue:[
+ oldProcess state:#run.
+ ].
"no interrupts now - activeProcess has already been changed
(dont add any message sends here)"
activeProcess := aProcess.
currentPriority := pri.
%{
- extern OBJ __threadSwitch();
+ extern OBJ __threadSwitch(), __threadSwitchWithSingleStep();
- ok = __threadSwitch(__context, _intVal(id));
+ if (singleStep == true)
+ ok = __threadSwitchWithSingleStep(__context, _intVal(id));
+ else
+ ok = __threadSwitch(__context, _intVal(id));
%}.
"time passes ...
... here again"
ok ifFalse:[
- "
- switch failed for some reason -
- destroy the bad process
- "
- p := activeProcess.
- activeProcess := oldProcess.
- currentPriority := oldPri.
- p id ~~ 0 ifTrue:[
- p state:#suspended.
- p terminate.
- ]
+ "
+ switch failed for some reason -
+ destroy the bad process
+ "
+ p := activeProcess.
+ activeProcess := oldProcess.
+ currentPriority := oldPri.
+ p id ~~ 0 ifTrue:[
+ p state:#suspended.
+ p terminate.
+ ]
].
zombie notNil ifTrue:[
self class threadDestroy:zombie.
zombie := nil
- ]
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
scheduleForInterrupt:aProcess
@@ -298,8 +378,10 @@
aProcess == activeProcess ifTrue:[^ self].
id := aProcess id.
- self class threadInterrupt:id with:[aProcess interrupt].
- "and, make the process runnable"
+ self class threadInterrupt:id.
+ "
+ and, make the process runnable
+ "
aProcess resume
! !
@@ -314,23 +396,27 @@
highestPriority
"return the highest priority value processes can have"
- "must be below schedulingPriority - otherwise scheduler
- could be blocked ..."
- ^ 30
+ "must be below schedulingPriority -
+ otherwise scheduler could be blocked ...
+ "
+ ^ SchedulingPriority - 1
!
schedulingPriority
"return the priority at which the scheduler runs"
- "must be above highestPriority - otherwise scheduler
- could be blocked ..."
- ^ 31
+ "must be above highestPriority -
+ otherwise scheduler could be blocked ...
+ "
+ ^ SchedulingPriority
!
userInterruptPriority
- "not currently used - for ST80 compatibility only"
+ "return the priority, at which the event scheduler runs - i.e.
+ all processes running at alower priority are interruptable by Cntl-C
+ or the timer."
- ^ 24
+ ^ UserInterruptPriority
!
timingPriority
@@ -370,20 +456,20 @@
initialize
"initialize the one-and-only ProcessorScheduler"
- |nPrios l|
+ |nPrios l p|
- nPrios := self schedulingPriority.
+ nPrios := SchedulingPriority.
quiescentProcessLists := Array new:nPrios.
readFds := Array with:nil.
readChecks := Array with:nil.
readSemaphores := Array with:nil.
writeFds := Array with:nil.
- writeChecks := Array with:nil.
writeSemaphores := Array with:nil.
timeouts := Array with:nil.
timeoutSemaphores := Array with:nil.
timeoutActions := Array with:nil.
+ timeoutProcesses := Array with:nil.
anyTimeouts := false.
dispatching := false.
@@ -394,15 +480,16 @@
for a runnable process.
"
- activeProcess := Process new.
- activeProcess setId:0.
- activeProcess name:'scheduler'.
- activeProcess state:#run.
- currentPriority := self schedulingPriority.
- activeProcess setPriority:currentPriority.
+ currentPriority := SchedulingPriority.
+ p := Process new.
+ p setId:0.
+ p name:'scheduler'.
+ p state:#run.
+ p setPriority:currentPriority.
l := LinkedList new.
- l add:activeProcess.
+ l add:p.
+ scheduler := activeProcess := p.
quiescentProcessLists at:currentPriority put:l.
@@ -419,37 +506,7 @@
KnownProcesses := WeakArray new:5.
KnownProcesses watcher:self class.
KnownProcessIds := OrderedCollection new.
-
- "for now (cannot snapin processes)"
-
- quiescentProcessLists := Array new:self schedulingPriority.
-
- readFds := Array with:nil.
- readChecks := Array with:nil.
- readSemaphores := Array with:nil.
- writeFds := Array with:nil.
- writeChecks := Array with:nil.
- writeSemaphores := Array with:nil.
- dispatching := false.
-
- "handcraft the first (dispatcher-) process - this one will never
- block, but go into a select if there is nothing to do.
- Also it has a prio of max+1"
-
- activeProcess := Process new.
- activeProcess setId:0.
- activeProcess name:'scheduler'.
- activeProcess state:#run.
- currentPriority := self schedulingPriority.
- activeProcess setPriority:currentPriority.
-
- l := LinkedList new.
- l add:activeProcess.
-
- quiescentProcessLists at:currentPriority put:l.
-
- ObjectMemory ioInterruptHandler:self.
- ObjectMemory timerInterruptHandler:self.
+ self initialize
! !
!ProcessorScheduler methodsFor:'private'!
@@ -458,11 +515,11 @@
"remember aProcess for later disposal (where the underlying
system resources have to be freed)."
- |newShadow oldSize oldId
+ |newShadow oldSize oldId wasBlocked
index "{ Class: SmallInteger }"
sz "{ Class: SmallInteger }" |
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
index := 1.
sz := KnownProcessIds size.
[index <= sz] whileTrue:[
@@ -473,7 +530,7 @@
].
KnownProcesses at:index put:aProcess.
KnownProcessIds at:index put:aProcess id.
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ self
].
index := index + 1
@@ -490,19 +547,21 @@
KnownProcesses := newShadow
].
KnownProcesses at:index put:aProcess.
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
unRemember:aProcess
"forget aProcess - dispose processing will not consider this one"
- |index|
+ |index wasBlocked|
+ wasBlocked := OperatingSystem blockInterrupts.
index := KnownProcesses identityIndexOf:aProcess.
index ~~ 0 ifTrue:[
KnownProcessIds at:index put:nil.
KnownProcesses at:index put:nil.
- ]
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
! !
!ProcessorScheduler methodsFor:'process creation'!
@@ -516,11 +575,11 @@
id := self class threadCreate:aBlock.
id isNil ifTrue:[
- "
- this may happen, if the VM does not support more processes,
- or if it ran out of memory, when allocating internal data
- structures
- "
+ "
+ this may happen, if the VM does not support more processes,
+ or if it ran out of memory, when allocating internal data
+ structures
+ "
self error:'cannot create new Process'.
^ nil
].
@@ -529,6 +588,12 @@
p startBlock:aBlock.
p state:#light. "meaning: has no stack yet"
p setPriority:currentPriority.
+ "
+ give it a user-friendly name
+ "
+ activeProcess name notNil ifTrue:[
+ p name:(activeProcess name , ' (sub)')
+ ].
self remember:p.
^ p
! !
@@ -537,34 +602,38 @@
reschedule
"switch to the highest prio runnable process
- The scheduler itself is always runnable, so there is always a switch."
+ The scheduler itself is always runnable, so there is always a switch.
+ (if you want to implement your own scheduler stuff, uncomment below)"
- |l p|
+ ^ self threadSwitch:scheduler
- (self schedulingPriority) to:1 by:-1 do:[:prio |
- l := quiescentProcessLists at:prio.
- l notNil ifTrue:[
- p := l first.
- p notNil ifTrue:[
- activeProcess state == #active ifTrue:[
- activeProcess state:#run.
- ].
- ^ self threadSwitch:p
- ].
- quiescentProcessLists at:prio put:nil
- ]
- ].
- "
- no process to run - this 'cannot' happen
- (well, not quite: it may happen if the scheduler process is
- suspended - which btw. should be avoided, since noone is there
- to schedule processes then)
- "
-
- self halt:'fatal dispatcher should never be suspended'.
-
- "try to repair by just resuming ..."
- activeProcess resume
+"/ |l p maxPri "{ Class: SmallInteger }"|
+"/
+"/ maxPri := SchedulingPriority.
+"/ maxPri to:1 by:-1 do:[:prio |
+"/ l := quiescentProcessLists at:prio.
+"/ l notNil ifTrue:[
+"/ p := l first.
+"/ p notNil ifTrue:[
+"/ activeProcess state == #active ifTrue:[
+"/ activeProcess state:#run.
+"/ ].
+"/ ^ self threadSwitch:p
+"/ ].
+"/ quiescentProcessLists at:prio put:nil
+"/ ]
+"/ ].
+"/ "
+"/ no process to run - this 'cannot' happen
+"/ (well, not quite: it may happen if the scheduler process is
+"/ suspended - which btw. should be avoided, since noone is there
+"/ to schedule processes then)
+"/ "
+"/
+"/ MiniDebugger enterWithMessage:'fatal dispatcher should never be suspended'.
+"/
+"/ "try to repair by just resuming ..."
+"/ activeProcess resume
!
yield
@@ -572,61 +641,90 @@
and reschedule to the first in the list, thus switching to the
next same-prio-process."
- |l|
+ |l wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
l := quiescentProcessLists at:currentPriority.
+
+ "
+ debugging consistency checks - will be removed later
+ "
l isNil ifTrue:[
- OperatingSystem unblockInterrupts.
- 'oops - nil runnable list' errorPrintNewline.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ 'oops - nil runnable list' errorPrintNL.
+ ^ self
+ ].
+ l isEmpty ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ 'oops - empty runnable list' errorPrintNL.
^ self
].
l size == 1 ifTrue:[
"
- running one is the only one
+ the running one is the only one
"
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ self
].
-
+
"
bring running process to the end
"
l removeFirst.
l addLast:activeProcess.
- OperatingSystem unblockInterrupts.
+"/ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
"
and switch to first in the list
"
- activeProcess state:#run.
+"/ activeProcess state:#run.
self threadSwitch:(l first).
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
suspend:aProcess
"remove the argument, aProcess from the list of runnable processes.
If the process is the current one, reschedule."
- |pri l s|
+ |pri l p s wasBlocked|
- aProcess isNil ifTrue:[self error:'nil suspend'. ^ self].
- aProcess id isNil ifTrue:['bad suspend: already dead' errorPrintNewline. ^ self].
+ "
+ some debugging stuff
+ "
+ aProcess isNil ifTrue:[
+ MiniDebugger enterWithMessage:'nil suspend'.
+ ^ self
+ ].
+ aProcess id isNil ifTrue:[
+ MiniDebugger enterWithMessage:'bad suspend: already dead'.
+ ^ self
+ ].
+ aProcess == scheduler ifTrue:[
+ MiniDebugger enterWithMessage:'scheduler should never be suspended'.
+ ^ self
+ ].
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
pri := aProcess priority.
+ l := quiescentProcessLists at:pri.
- l := quiescentProcessLists at:pri.
+ "
+ debugging consisteny checks - will be removed later
+ "
l isNil ifTrue:[
- OperatingSystem unblockInterrupts.
- 'bad suspend: not running' errorPrintNewline.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+
+ 'bad suspend: empty run list' printNL.
+ "/ MiniDebugger enterWithMessage:'bad suspend: empty run list'.
+ self reschedule.
^ self
].
l remove:aProcess ifAbsent:[
- OperatingSystem unblockInterrupts.
- 'bad suspend: not running' errorPrintNewline.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ MiniDebugger enterWithMessage:'bad suspend: not on run list'.
^ self
].
@@ -634,27 +732,35 @@
quiescentProcessLists at:pri put:nil.
l := nil
].
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ "
+ this is a bit of a kludge: allow someone else to
+ set the state to something like ioWait etc.
+ In this case, do not set to suspend.
+ All of this to enhance the output of the process monitor ...
+ "
s := aProcess state.
((s == #active) or:[s == #run]) ifTrue:[
aProcess state:#suspended.
].
(aProcess == activeProcess) ifTrue:[
- "can be done a bit faster sometimes"
+ "we can immediately switch sometimes"
l notNil ifTrue:[
- self threadSwitch:(l first)
+ p := l first
] ifFalse:[
- self reschedule
- ]
+ p := scheduler
+ ].
+ self threadSwitch:p
+"/ self reschedule
].
!
resume:aProcess
- "set aProcess runnable - if its prio is higher than the currently running prio,
- reschedule."
+ "set aProcess runnable -
+ if its prio is higher than the currently running prio, switch to it."
- |l pri|
+ |l pri wasBlocked|
aProcess == activeProcess ifTrue:[^ self].
aProcess isNil ifTrue:[^ self].
@@ -662,7 +768,7 @@
"ignore, if process is already dead"
aProcess id isNil ifTrue:[^ self].
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
pri := aProcess priority.
@@ -673,27 +779,69 @@
] ifFalse:[
"if already running, ignore"
(l includes:aProcess) ifTrue:[
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ self
]
].
l addLast:aProcess.
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
(pri > currentPriority) ifTrue:[
- activeProcess state:#run.
+ "
+ its prio is higher; immediately transfer control to it
+ "
self threadSwitch:aProcess
] ifFalse:[
- aProcess state:#suspended
+ "
+ its prio is lower; it will have to wait for a while ...
+ "
+ aProcess state:#run
]
!
-processTermination
- "current process finished its startup block without termination,
- lay him to rest now"
+resumeForSingleSend:aProcess
+ "like resume, but let the process execute a single send only.
+ This is used by the debugger for single stepping."
+
+ |l pri wasBlocked|
+
+ aProcess == activeProcess ifTrue:[^ self].
+ aProcess isNil ifTrue:[^ self].
+
+ "ignore, if process is already dead"
+ aProcess id isNil ifTrue:[^ self].
+
+
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ pri := aProcess priority.
- self terminate:activeProcess.
- self reschedule
+ l := quiescentProcessLists at:pri.
+ l isNil ifTrue:[
+ l := LinkedList new.
+ quiescentProcessLists at:pri put:l
+ ] ifFalse:[
+ "if already running, ignore"
+ (l includes:aProcess) ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ]
+ ].
+ l addLast:aProcess.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+
+ (pri > currentPriority) ifTrue:[
+ "
+ its prio is higher; immediately transfer control to it
+ "
+"/ activeProcess state:#run.
+ self threadSwitch:aProcess
+ ] ifFalse:[
+ "
+ its prio is lower; it will have to wait for a while ...
+ "
+ aProcess state:#suspended
+ ]
!
terminate:aProcess
@@ -701,7 +849,7 @@
removed from its list and destroyed. Otherwise, a switch is forced
and the process is destroyed by the next running process."
- |pri id l|
+ |pri id l wasBlocked|
aProcess isNil ifTrue:[^ self].
id := aProcess id.
@@ -710,7 +858,7 @@
aProcess setId:nil.
aProcess startBlock:nil.
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
"remove the process from the runnable list"
@@ -720,7 +868,7 @@
l remove:aProcess.
l isEmpty ifTrue:[quiescentProcessLists at:pri put:nil].
].
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
aProcess exitAction notNil ifTrue:[
aProcess exitAction value.
@@ -730,13 +878,14 @@
aProcess state:#dead.
aProcess == activeProcess ifTrue:[
"
- hard case - its the currently running process
+ hard case - its the currently running process
we must have the next active process destroy this one
(we cannot destroy the chair we are sitting on ... :-)
"
zombie := id.
self unRemember:aProcess.
- self reschedule.
+ self threadSwitch:scheduler.
+"/ self reschedule.
^ self
].
self class threadDestroy:id.
@@ -744,27 +893,43 @@
^ self
!
+processTermination
+ "current process finished its startup block without termination,
+ lay him to rest now."
+
+ self terminate:activeProcess.
+ self threadSwitch:scheduler
+"/ self reschedule
+!
+
terminateActive
- "terminate the current process (i.e. myself)"
+ "terminate the current process
+ (i.e. the currently running process kills itself)"
self terminate:activeProcess
!
+interruptActive
+ "interrupt the current process (i.e. myself)"
+
+ activeProcess interrupt
+!
+
changePriority:newPrio for:aProcess
"change the priority of aProcess"
- |oldList newList oldPrio|
+ |oldList newList oldPrio wasBlocked|
oldPrio := aProcess priority.
oldPrio == newPrio ifTrue:[^ self].
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
aProcess setPriority:newPrio.
oldList := quiescentProcessLists at:oldPrio.
- (oldList includes:aProcess) ifFalse:[
- OperatingSystem unblockInterrupts.
+ (oldList isNil or:[(oldList includes:aProcess) not]) ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ self
].
@@ -777,22 +942,23 @@
quiescentProcessLists at:newPrio put:newList
].
newList addLast:aProcess.
- OperatingSystem unblockInterrupts.
-
+
"if its the current process lowering its prio
or another one raising, we have to reschedule"
aProcess == activeProcess ifTrue:[
currentPriority := newPrio.
newPrio < oldPrio ifTrue:[
- self reschedule.
+ self threadSwitch:scheduler.
+"/ self reschedule.
]
] ifFalse:[
newPrio > currentPriority ifTrue:[
- activeProcess state:#run.
+"/ activeProcess state:#run.
self threadSwitch:aProcess.
]
- ]
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
! !
!ProcessorScheduler methodsFor:'accessing'!
@@ -831,10 +997,23 @@
maxPri to:1 by:-1 do:[:prio |
l := quiescentProcessLists at:prio.
l notNil ifTrue:[
- p := l first.
- p notNil ifTrue:[^ p].
- "in the fly clear out empty lists"
- quiescentProcessLists at:prio put:nil
+ l isEmpty ifTrue:[
+ "
+ on the fly clear out empty lists
+ "
+ quiescentProcessLists at:prio put:nil
+ ] ifFalse:[
+ p := l first.
+ "
+ if it got corrupted somehow
+ "
+ p id isNil ifTrue:[
+ 'process with nil id removed' printNL.
+ l removeFirst.
+ ^ nil.
+ ].
+ ^ p
+ ].
]
].
^ nil
@@ -843,30 +1022,38 @@
!ProcessorScheduler methodsFor:'dispatching'!
dispatchLoop
- "dispatch forever - the main process is running here all the time"
+ "central dispatch loop; the scheduler process is always staying in
+ this method, looping forever."
dispatching == true ifTrue:[^ self].
dispatching := true.
+
+ "I made this an extra call to dispatch; this allows recompilation
+ of the dispatch-handling code in the running system.
+ "
[true] whileTrue:[
self dispatch
]
!
dispatch
- "central dispatch, handling timeouts and switching to the highest
- prio runnable process"
+ "It handles timeouts and switches to the highest prio runnable process"
|any millis pri p nActions "{ Class: SmallInteger }" |
- "handle all timeout actions"
+ "to avoid confusion if entered twice"
+
+ "
+ handle all timeout actions
+ "
anyTimeouts ifTrue:[
self evaluateTimeouts
].
"first do a quick check using checkActions - this is needed for
devices like X-connection, where some events might be in the event
- queue, so a select does not always help"
-
+ queue, so a select does not always help
+ "
any := false.
nActions := readChecks size.
1 to:nActions do:[:index |
@@ -902,12 +1089,15 @@
If ioInterrupts are not available, we schedule a timer interrupt
to interrupt us after 1/20s of a second - effectively polling
the filedescriptors. - which is very bad, since low prio processes
- will be hurt in performance - dont let benchmarks run with low prio ...
+ will be hurt in performance
+ - dont let benchmarks run with low prio ...
Higher prio processes must suspend, same prio ones must yield to
get back control"
-"uncommenting this will make timeouts interrupt the current process
- (i.e. run at TimingPrio); if commented, they run at UserSchedulingPrio.
+"
+ uncommenting this will make timeouts interrupt the current process
+ (i.e. as if the interrupt runs at TimingPrio);
+ if left commented, they are handled at UserSchedulingPrio.
this will all change, when timeouts are removed and all is process driven
"
@@ -919,13 +1109,21 @@
]
].
"
- pri < UserSchedulingPriority ifTrue:[
- "comment out this if above is uncommented"
+ "
+ if the process to run has a lower than UserInterruptPriority,
+ arrange for it to be interruptable by I/O.
+ This is done by enabling I/O-signals (if the OS supports them)
+ or by installing a poll-interrupt after 50ms (if the OS does not).
+ "
+ pri < UserInterruptPriority ifTrue:[
+
+"comment out this if above is uncommented"
anyTimeouts ifTrue:[
millis := self timeToNextTimeout.
millis == 0 ifTrue:[^ self].
].
+"---"
OperatingSystem supportsIOInterrupts ifTrue:[
readFds do:[:fd |
@@ -943,14 +1141,14 @@
].
millis notNil ifTrue:[
- "schedule a clock interrupt"
+ "schedule a clock interrupt after millis milliseconds"
OperatingSystem enableTimer:millis rounded.
].
"now let the process run - will come back here by reschedule
from ioInterrupt or timerInterrupt ... (running at max+1)"
- activeProcess state:#run.
+"/ activeProcess state:#run.
self threadSwitch:p.
"... when we arrive here, we are back on stage"
@@ -966,13 +1164,15 @@
ioInterrupt
"data arrived while waiting - reschedule to bring dispatcher into play"
- self reschedule
+ self threadSwitch:scheduler
+"/ self reschedule
!
timerInterrupt
"timer expired while waiting - reschedule to bring dispatcher into play"
- self reschedule
+ self threadSwitch:scheduler
+"/ self reschedule
!
timeToNextTimeout
@@ -1008,7 +1208,7 @@
any file descriptors to arrive or a timeout to happen.
If it makes sense, do some background garbage collection.
The idle actions are a leftover from previous ST/X releases and will
- vanish."
+ vanish (installing a low-prio process has the same effect)."
|millis limit doingGC|
@@ -1067,17 +1267,23 @@
!
checkForInputWithTimeout:millis
- "really nothing to do - hard wait for either input or timeout"
+ "this is called, when there is absolutely nothing to do;
+ hard wait for either input to arrive or a timeout to occur."
|fd index sema action|
- fd := OperatingSystem selectOnAnyReadable:readFds writable:writeFds error:nil withTimeOut:millis.
+ fd := OperatingSystem
+ selectOnAnyReadable:readFds
+ writable:writeFds
+ exception:nil
+ withTimeOut:millis.
fd notNil ifTrue:[
index := readFds indexOf:fd.
index ~~ 0 ifTrue:[
sema := readSemaphores at:index.
sema notNil ifTrue:[
- sema signalOnce
+ sema signalOnce.
+ ^ true
] ifFalse:[
action := readChecks at:index.
action notNil ifTrue:[
@@ -1093,7 +1299,8 @@
evaluateTimeouts
"walk through timeouts and evaluate blocks or signal semas that need to be .."
- |now aTime block blocksToEvaluate n "{ Class: SmallInteger }"|
+ |sema now aTime block blocksToEvaluate
+ processes n "{ Class: SmallInteger }"|
anyTimeouts ifFalse:[ ^ self].
@@ -1110,19 +1317,22 @@
(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
"this one should be triggered"
- (timeoutSemaphores at:index) notNil ifTrue:[
- (timeoutSemaphores at:index) signalOnce.
+ sema := timeoutSemaphores at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
timeoutSemaphores at:index put:nil
] ifFalse:[
"to support pure-events"
block := timeoutActions at:index.
block notNil ifTrue:[
blocksToEvaluate isNil ifTrue:[
- blocksToEvaluate := OrderedCollection with:block
- ] ifFalse:[
- blocksToEvaluate add:block
+ blocksToEvaluate := OrderedCollection new:10.
+ processes := OrderedCollection new:10.
].
- timeoutActions at:index put:nil
+ blocksToEvaluate add:block.
+ processes add:(timeoutProcesses at:index).
+ timeoutActions at:index put:nil.
+ timeoutProcesses at:index put:nil.
]
].
timeouts at:index put:nil.
@@ -1133,30 +1343,34 @@
].
blocksToEvaluate notNil ifTrue:[
- blocksToEvaluate do:[:aBlock |
- aBlock value
+ 1 to:blocksToEvaluate size do:[:index |
+ PureEventDriven ifTrue:[
+ (blocksToEvaluate at:index) value
+ ] ifFalse:[
+ (processes at:index) interruptWith:(blocksToEvaluate at:index)
+ ]
]
]
! !
-!ProcessorScheduler methodsFor:'adding / removing'!
+!ProcessorScheduler methodsFor:'semaphore signalling'!
-enableSemaphore:aSemaphore onInput:aFileDescriptor
- "enable a semaphore to be triggered when input on aFileDescriptor
- arrives"
+signal:aSemaphore onInput:aFileDescriptor
+ "arrange for a semaphore to be triggered when input on aFileDescriptor
+ arrives."
- self enableSemaphore:aSemaphore onInput:aFileDescriptor check:nil
+ self signal:aSemaphore onInput:aFileDescriptor orCheck:nil
!
-enableSemaphore:aSemaphore onInput:aFileDescriptor check:aBlock
- "enable a semaphore to be triggered when input on aFileDescriptor
- arrives or checkblock evaluates to true.
+signal:aSemaphore onInput:aFileDescriptor orCheck:aBlock
+ "arrange for a semaphore to be triggered when input on aFileDescriptor
+ arrives OR checkblock evaluates to true.
(checkBlock is used for buffered input, where a select may not detect
data already read into a buffer - as in Xlib)"
- |idx|
+ |idx wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
(readFds includes:aFileDescriptor) ifFalse:[
idx := readFds indexOf:nil.
idx ~~ 0 ifTrue:[
@@ -1169,15 +1383,80 @@
readChecks := readChecks copyWith:aBlock.
]
].
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+!
+
+signal:aSemaphore onOutput:aFileDescriptor
+ "arrange for a semaphore to be triggered when output on aFileDescriptor
+ is possible. (i.e. can be written without blocking)"
+
+ |idx wasBlocked|
+
+ wasBlocked := OperatingSystem blockInterrupts.
+ (writeFds includes:aFileDescriptor) ifFalse:[
+ idx := writeFds indexOf:nil.
+ idx ~~ 0 ifTrue:[
+ writeFds at:idx put:aFileDescriptor.
+ writeSemaphores at:idx put:aSemaphore.
+ ] ifFalse:[
+ writeFds := writeFds copyWith:aFileDescriptor.
+ writeSemaphores := writeSemaphores copyWith:aSemaphore.
+ ]
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+!
+
+signal:aSemaphore afterSeconds:seconds
+ "arrange for a semaphore to be triggered after some seconds"
+
+ self signal:aSemaphore afterMilliseconds:(seconds * 1000)
+!
+
+signal:aSemaphore afterMilliseconds:millis
+ "arrange for a semaphore to be triggered after some milliseconds"
+
+ |now then wasBlocked|
+
+ wasBlocked := OperatingSystem blockInterrupts.
+ now := OperatingSystem getMillisecondTime.
+ then := OperatingSystem millisecondTimeAdd:now and:millis rounded.
+ self signal:aSemaphore atMilliseconds:then.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+!
+
+signal:aSemaphore atMilliseconds:aMillisecondTime
+ "arrange for a semaphore to be triggered at a specific millisecond time"
+
+ |index wasBlocked|
+
+ wasBlocked := OperatingSystem blockInterrupts.
+ index := timeoutSemaphores identityIndexOf:aSemaphore.
+ index ~~ 0 ifTrue:[
+ timeouts at:index put:aMillisecondTime
+ ] ifFalse:[
+ index := timeouts indexOf:nil.
+ index ~~ 0 ifTrue:[
+ timeoutSemaphores at:index put:aSemaphore.
+ timeouts at:index put:aMillisecondTime.
+ timeoutActions at:index put:nil.
+ timeoutProcesses at:index put:nil
+ ] ifFalse:[
+ timeoutSemaphores := timeoutSemaphores copyWith:aSemaphore.
+ timeouts := timeouts copyWith:aMillisecondTime.
+ timeoutActions := timeoutActions copyWith:nil.
+ timeoutProcesses := timeoutProcesses copyWith:nil
+ ].
+ ].
+ anyTimeouts := true.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
disableSemaphore:aSemaphore
"disable triggering of a semaphore"
- |idx|
+ |idx wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
idx := readSemaphores identityIndexOf:aSemaphore.
idx ~~ 0 ifTrue:[
readFds at:idx put:nil.
@@ -1189,53 +1468,56 @@
timeouts at:idx put:nil.
timeoutSemaphores at:idx put:nil.
timeoutActions at:idx put:nil.
+ timeoutProcesses at:idx put:nil.
].
- OperatingSystem unblockInterrupts.
-!
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+! !
+
+!ProcessorScheduler methodsFor:'background processing'!
-enableSemaphore:aSemaphore afterSeconds:seconds
- "enable a semaphore to be triggered after some seconds"
+addIdleBlock:aBlock
+ "add the argument, aBlock to the list of idle-actions.
+ Idle blocks are evaluated whenever no other process is runnable,
+ and no events are pending.
+ Use of idle blocks is not recommended, use a low priority processes
+ instead, which has the same effect. They have been implemented to support
+ background actions in pure-event systems, where no processes are
+ available.
+ Support for idle-blocks may vanish."
- self enableSemaphore:aSemaphore afterMilliseconds:(seconds * 1000)
+ |wasBlocked|
+
+ wasBlocked := OperatingSystem blockInterrupts.
+ idleActions isNil ifTrue:[
+ idleActions := OrderedCollection new
+ ].
+ idleActions add:aBlock.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
-enableSemaphore:aSemaphore afterMilliseconds:millis
- "enable a semaphore to be triggered after some milliseconds"
+removeIdleBlock:aBlock
+ "remove the argument, aBlock from the list of idle-blocks.
+ Support for idle-blocks may vanish - use low prio processes instead."
- |now then index|
-
- now := OperatingSystem getMillisecondTime.
- then := OperatingSystem millisecondTimeAdd:now and:millis.
+ |wasBlocked|
- OperatingSystem blockInterrupts.
- index := timeoutSemaphores identityIndexOf:aSemaphore.
- index ~~ 0 ifTrue:[
- timeouts at:index put:then
- ] ifFalse:[
- index := timeouts indexOf:nil.
- index ~~ 0 ifTrue:[
- timeoutSemaphores at:index put:aSemaphore.
- timeouts at:index put:then.
- timeoutActions at:index put:nil.
- ] ifFalse:[
- timeoutSemaphores := timeoutSemaphores copyWith:aSemaphore.
- timeouts := timeouts copyWith:then.
- timeoutActions := timeoutActions copyWith:nil.
- ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ idleActions notNil ifTrue:[
+ idleActions remove:aBlock
].
- anyTimeouts := true.
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
! !
-!ProcessorScheduler methodsFor:'pure event support'!
+!ProcessorScheduler methodsFor:'I/O event actions'!
enableIOAction:aBlock on:aFileDescriptor
- "half-obsolete event support: prepare to evaluate aBlock when input on
- aFileDescriptor arrives. Will vanish."
+ "half-obsolete event support: arrange for aBlock to be
+ evaluated when input on aFileDescriptor arrives.
+ This is a leftover support for pure-event systems and may vanish."
- |idx|
+ |idx wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
(readFds includes:aFileDescriptor) ifFalse:[
idx := readFds indexOf:nil.
idx ~~ 0 ifTrue:[
@@ -1248,91 +1530,140 @@
readSemaphores := readSemaphores copyWith:nil.
]
].
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
disableFd:aFileDescriptor
- "will vanish: disable block events on aFileDescriptor"
+ "disable block events on aFileDescriptor.
+ This is a leftover support for pure-event systems and may vanish."
- |idx|
+ |idx wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
idx := readFds indexOf:aFileDescriptor.
idx ~~ 0 ifTrue:[
readFds at:idx put:nil.
readChecks at:idx put:nil.
readSemaphores at:idx put:nil
].
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+! !
+
+!ProcessorScheduler methodsFor:'timed block'!
+
+addTimedBlock:aBlock afterSeconds:delta
+ "add the argument, aBlock to the list of time-scheduled-blocks.
+ to be evaluated after delta seconds. The process which installs this timed
+ block will be interrupted for execution of the block.
+ (if it is running, the interrupt will occur in whatever method it is
+ executing; if it is suspended, it will be resumed for the execution).
+ The block will be removed from the timed-block list after evaluation
+ (i.e. it will trigger only once)."
+
+ self addTimedBlock:aBlock for:activeProcess afterMilliseconds:(delta * 1000) rounded
!
-addIdleBlock:aBlock
- "add the argument, aBlock to the list of idle-actions; to be
- evaluated whenever no events are pending.
- Will vanish - use low prio processes instead."
+addTimedBlock:aBlock for:aProcess afterSeconds:delta
+ "add the argument, aBlock to the list of time-scheduled-blocks.
+ to be evaluated after delta seconds. aProcess will be interrupted for
+ execution of the block.
+ (if it is running, the interrupt will occur in whatever method it is
+ executing; if it is suspended, it will be resumed for the execution).
+ The block will be removed from the timed-block list after evaluation
+ (i.e. it will trigger only once)."
- OperatingSystem blockInterrupts.
- idleActions isNil ifTrue:[
- idleActions := OrderedCollection new
- ].
- idleActions add:aBlock.
- OperatingSystem unblockInterrupts.
+ self addTimedBlock:aBlock for:aProcess afterMilliseconds:(delta * 1000) rounded
+!
+
+addTimedBlock:aBlock afterMilliseconds:delta
+ "add the argument, aBlock to the list of time-scheduled-blocks; to be
+ evaluated after delta milliseconds. The process which installs this timed
+ block will be interrupted for execution of the block.
+ (if it is running, the interrupt will occur in whatever method it is
+ executing; if it is suspended, it will be resumed for the execution).
+ The block will be removed from the timed-block list after evaluation
+ (i.e. it will trigger only once)."
+
+ ^ self addTimedBlock:aBlock for:activeProcess afterMilliseconds:delta
!
-removeIdleBlock:aBlock
- "remove the argument, aBlock from the list of idle-blocks.
- Will vanish - use low prio processes instead."
+addTimedBlock:aBlock for:aProcess afterMilliseconds:delta
+ "add the argument, aBlock to the list of time-scheduled-blocks; to be
+ evaluated after delta milliseconds. aProcess will be interrupted for
+ execution of the block.
+ (if it is running, the interrupt will occur in whatever method it is
+ executing; if it is suspended, it will be resumed for the execution).
+ The block will be removed from the timed-block list after evaluation
+ (i.e. it will trigger only once)."
- OperatingSystem blockInterrupts.
- idleActions notNil ifTrue:[
- idleActions remove:aBlock
- ].
- OperatingSystem unblockInterrupts.
+ |now then wasBlocked|
+
+ wasBlocked := OperatingSystem blockInterrupts.
+ now := OperatingSystem getMillisecondTime.
+ then := OperatingSystem millisecondTimeAdd:now and:delta.
+ self addTimedBlock:aBlock for:aProcess atMilliseconds:then.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
-addTimedBlock:aBlock after:delta
- "add the argument, aBlock to the list of time-sceduled-blocks; to be
- evaluated after delta seconds; the block will be removed after being
- evaluated.
- May vanish: use another process to signal a semaphore periodically."
+addTimedBlock:aBlock atMilliseconds:aMillisecondTime
+ "add the argument, aBlock to the list of time-scheduled-blocks; to be
+ evaluated when the millisecondClock value passes aMillisecondTime.
+ The process which installs this timed block will be interrupted for
+ execution of the block.
+ (if it is running, the interrupt will occur in whatever method it is
+ executing; if it is suspended, it will be resumed for the execution).
+ The block will be removed from the timed-block list after evaluation
+ (i.e. it will trigger only once)."
+
+ self addTimedBlock:aBlock for:activeProcess atMilliseconds:aMillisecondTime
+!
- |now then index|
+addTimedBlock:aBlock for:aProcess atMilliseconds:aMillisecondTime
+ "add the argument, aBlock to the list of time-scheduled-blocks; to be
+ evaluated by aProcess when the millisecondClock value passes
+ aMillisecondTime.
+ aProcess will be interrupted for execution of the block.
+ (if it is running, the interrupt will occur in whatever method it is
+ executing; if it is suspended, it will be resumed for the execution).
+ The block will be removed from the timed-block list after evaluation
+ (i.e. it will trigger only once)."
- now := OperatingSystem getMillisecondTime.
- then := OperatingSystem millisecondTimeAdd:now and:(delta * 1000).
+ |index wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
index := timeoutActions identityIndexOf:aBlock.
index ~~ 0 ifTrue:[
- timeouts at:index put:then
+ timeouts at:index put:aMillisecondTime
] ifFalse:[
index := timeouts indexOf:nil.
index ~~ 0 ifTrue:[
+ timeouts at:index put:aMillisecondTime.
timeoutActions at:index put:aBlock.
- timeouts at:index put:then.
- timeoutSemaphores at:index put:nil
+ timeoutSemaphores at:index put:nil.
+ timeoutProcesses at:index put:aProcess
] ifFalse:[
+ timeouts := timeouts copyWith:aMillisecondTime.
timeoutActions := timeoutActions copyWith:aBlock.
- timeouts := timeouts copyWith:then.
timeoutSemaphores := timeoutSemaphores copyWith:nil.
+ timeoutProcesses := timeoutProcesses copyWith:aProcess.
].
].
anyTimeouts := true.
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
removeTimedBlock:aBlock
- "remove the argument, aBlock from the list of time-sceduled-blocks.
- May vanish: use another process to signal a semaphore periodically."
+ "remove the argument, aBlock from the list of time-sceduled-blocks."
- |index|
+ |index wasBlocked|
- OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
index := timeoutActions identityIndexOf:aBlock.
(index ~~ 0) ifTrue:[
+ timeouts at:index put:nil.
timeoutActions at:index put:nil.
- timeouts at:index put:nil.
timeoutSemaphores at:index put:nil.
+ timeoutProcesses at:index put:nil.
].
- OperatingSystem unblockInterrupts.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
! !