--- a/ProcessorScheduler.st Wed Oct 19 09:22:53 2016 +0100
+++ b/ProcessorScheduler.st Fri Dec 09 22:31:28 2016 +0000
@@ -78,105 +78,105 @@
(for examples, see ProcessMonitor or MemoryMonitor).
This pure-event mode may not be supported in the future
- (actually, it is no longer maintained, so dont run the system without Processes).
+ (actually, it is no longer maintained, so don't run the system without Processes).
[instance variables:]
- quiescentProcessLists - list of waiting processes
- scheduler - the scheduler process itself
- zombie - internal temporary (recently died process)
- activeProcess - the current process
- activeProcessId - the current processes id
- currentPriority - the current processes priority
- readFdArray - fd-sema-checkBlock triple-association
- readSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- readCheckArray
- writeFdArray - fd-sema-checkBlock triple-association
- writeSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- writeCheckArray
- timeoutArray - time-action-process-sema quadruple-association
- timeoutActionArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- timeoutProcessArray
- timeoutSemaphoreArray
- idleActions - actions to be executed when idle
- preWaitActions - actions to be executed BEFORE going into an OS-wait
- anyTimeouts - flag if any timeouts are pending
- dispatching - flag if dispatch process is running (i.e. NOT initializing)
- interruptedProcess - the currently interrupted process.
- useIOInterrupts - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)
- gotIOInterrupt - flag if I came out of a wait due to an I/O interrupt
- osChildExitActions - OS chid process actions
- gotChildSignalInterrupt - flag if I came out of a wait due to an OS child interrupt
- exitWhenNoMoreUserProcesses - flag which controls if ST/X should exit when the last process dies (for standalone apps)
- suspendScheduler - internal use
- timeSliceProcess - the timeSlicer process
- supportDynamicPriorities - flag if dynamic priorities should be supported by the timeSlicer
- scheduledProcesses - list of scheduled processes for the timeSlicers dynamic prio handling
+ quiescentProcessLists - list of waiting processes
+ scheduler - the scheduler process itself
+ zombie - internal temporary (recently died process)
+ activeProcess - the current process
+ activeProcessId - the current processes id
+ currentPriority - the current processes priority
+ readFdArray - fd-sema-checkBlock triple-association
+ readSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ readCheckArray
+ writeFdArray - fd-sema-checkBlock triple-association
+ writeSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ writeCheckArray
+ timeoutArray - time-action-process-sema quadruple-association
+ timeoutActionArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ timeoutProcessArray
+ timeoutSemaphoreArray
+ idleActions - actions to be executed when idle
+ preWaitActions - actions to be executed BEFORE going into an OS-wait
+ anyTimeouts - flag if any timeouts are pending
+ dispatching - flag if dispatch process is running (i.e. NOT initializing)
+ interruptedProcess - the currently interrupted process.
+ useIOInterrupts - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)
+ gotIOInterrupt - flag if I came out of a wait due to an I/O interrupt
+ osChildExitActions - OS chid process actions
+ gotChildSignalInterrupt - flag if I came out of a wait due to an OS child interrupt
+ exitWhenNoMoreUserProcesses - flag which controls if ST/X should exit when the last process dies (for standalone apps)
+ suspendScheduler - internal use
+ timeSliceProcess - the timeSlicer process
+ supportDynamicPriorities - flag if dynamic priorities should be supported by the timeSlicer
+ scheduledProcesses - list of scheduled processes for the timeSlicers dynamic prio handling
[class variables:]
- KnownProcesses <WeakArray> 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.
-
- HighestPriority The highest allowed prio for processes
-
- SchedulingPriority The priority of the scheduler (must
- me higher than any other).
-
- MaxNumberOfProcesses if non-nil, no more than this
- number of processes are allowed
- (for debugging)
-
- TimeSliceInterval for preemptive priority scheduling only:
- the time interval in millis, at which processes
- are timesliced
-
- TimeSlicingPriorityLimit for preemptive priority scheduling only:
- processes are only timesliced, if running
- at or below this priority.
-
- EventPollingInterval for systems which do not support select on
- a fileDescriptor: the polling interval in millis.
+ KnownProcesses <WeakArray> 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.
+
+ HighestPriority The highest allowed prio for processes
+
+ SchedulingPriority The priority of the scheduler (must
+ me higher than any other).
+
+ MaxNumberOfProcesses if non-nil, no more than this
+ number of processes are allowed
+ (for debugging)
+
+ TimeSliceInterval for preemptive priority scheduling only:
+ the time interval in millis, at which processes
+ are timesliced
+
+ TimeSlicingPriorityLimit for preemptive priority scheduling only:
+ processes are only timesliced, if running
+ at or below this priority.
+
+ EventPollingInterval for systems which do not support select on
+ a fileDescriptor: the polling interval in millis.
most interesting 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:
+ 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:
[see also:]
- Process
- Delay Semaphore SemaphoreSet SharedQueue
- WindowGroup
- (``Working with processes'': programming/processes.html)
+ Process
+ Delay Semaphore SemaphoreSet SharedQueue
+ WindowGroup
+ (``Working with processes'': programming/processes.html)
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -274,7 +274,7 @@
Processor isNil ifTrue:[
"create the one and only processor"
- Processor := self basicNew initialize.
+ Smalltalk at:#Processor put:(self basicNew initialize).
].
"
@@ -365,17 +365,17 @@
This may raise an exception, if a VM process could not be created."
MaxNumberOfProcesses notNil ifTrue:[
- KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
- (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
- "
- the number of processes has reached the (soft) limit.
- This limit prevents runaway programs from creating too many
- processes. If you continue in the debugger, the process will be
- created as usual. If you dont want this, abort or terminate.
- "
- self error:'too many processes'.
- ]
- ]
+ KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
+ (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
+ "
+ the number of processes has reached the (soft) limit.
+ This limit prevents runaway programs from creating too many
+ processes. If you continue in the debugger, the process will be
+ created as usual. If you don't want this, abort or terminate.
+ "
+ self error:'too many processes'.
+ ]
+ ]
].
%{
@@ -383,11 +383,11 @@
extern int __threadCreate();
tid = __threadCreate(aProcess,
- 0 /* stackSize: no longer needed */,
- __isSmallInteger(id) ? __intVal(id) /* assign id */
- : -1 /* let VM assign one */ );
+ 0 /* stackSize: no longer needed */,
+ __isSmallInteger(id) ? __intVal(id) /* assign id */
+ : -1 /* let VM assign one */ );
if (tid) {
- RETURN ( __mkSmallInteger(tid));
+ RETURN ( __mkSmallInteger(tid));
}
%}
.
@@ -397,7 +397,7 @@
or if it ran out of memory, when allocating internal data
structures.
"
- ^ ObjectMemory allocationFailureSignal raise.
+ ^ AllocationFailure raise.
!
threadDestroy:id
@@ -579,7 +579,7 @@
interruptCounter
"for statistics: counts the overall number of interrupts"
-
+
^ interruptCounter
"
@@ -607,7 +607,7 @@
timedActionCounter
"for statistics: counts the overall number of timer actions"
-
+
^ timedActionCounter
"
@@ -666,7 +666,7 @@
handle all timeout actions
"
anyTimeouts ifTrue:[
- self evaluateTimeouts
+ self evaluateTimeouts
].
"first do a quick check for semaphores using checkActions - this is needed for
@@ -678,40 +678,40 @@
"
nActions := readCheckArray size.
1 to:nActions do:[:index |
- checkBlock := readCheckArray at:index.
- (checkBlock notNil and:[checkBlock value]) ifTrue:[
- sema := readSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- ].
- ]
+ checkBlock := readCheckArray at:index.
+ (checkBlock notNil and:[checkBlock value]) ifTrue:[
+ sema := readSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ].
+ ]
].
nActions := writeCheckArray size.
1 to:nActions do:[:index |
- checkBlock := writeCheckArray at:index.
- (checkBlock notNil and:[checkBlock value]) ifTrue:[
- sema := writeSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- ].
- ]
+ checkBlock := writeCheckArray at:index.
+ (checkBlock notNil and:[checkBlock value]) ifTrue:[
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ].
+ ]
].
"now, someone might be runnable ..."
p := self highestPriorityRunnableProcess.
p isNil ifTrue:[
- "/ no one runnable, hard wait for event or timeout
- "/ Trace ifTrue:['w' printCR.].
- self waitForEventOrTimeout.
-
- "/ check for OS process termination
- gotChildSignalInterrupt ifTrue:[
- gotChildSignalInterrupt := false.
- self handleChildSignalInterrupt
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ "/ no one runnable, hard wait for event or timeout
+ "/ Trace ifTrue:['w' printCR.].
+ self waitForEventOrTimeout.
+
+ "/ check for OS process termination
+ gotChildSignalInterrupt ifTrue:[
+ gotChildSignalInterrupt := false.
+ self handleChildSignalInterrupt
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
pri := p priority.
@@ -726,7 +726,7 @@
we schedule a timer interrupt to interrupt us after 1/20s of a second
- effectively polling the filedescriptors 20 times a second.
(which is bad, since low prio processes will be hurt in performance)
- Therefore, dont let benchmarks run with low prio ...
+ Therefore, don't let benchmarks run with low prio ...
Higher prio processes must be suspended,
same prio ones must yield or suspend to get back control
@@ -742,13 +742,13 @@
"
pri < TimingPriority ifTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- millis == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ]
- ]
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ millis == 0 ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ]
+ ]
].
"
@@ -761,38 +761,38 @@
pri < UserInterruptPriority ifTrue:[
"comment out this if above is uncommented"
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- millis == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ].
- ].
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ millis == 0 ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ].
+ ].
"---"
- useIOInterrupts ifTrue:[
+ useIOInterrupts ifTrue:[
"/ readFdArray do:[:fd |
"/ (fd notNil and:[fd >= 0]) ifTrue:[
"/ OperatingSystem enableIOInterruptsOn:fd
"/ ].
"/ ].
- ] ifFalse:[
- millis notNil ifTrue:[
- millis := millis min:EventPollingInterval
- ] ifFalse:[
- millis := EventPollingInterval
- ]
- ]
+ ] ifFalse:[
+ millis notNil ifTrue:[
+ millis := millis min:EventPollingInterval
+ ] ifFalse:[
+ millis := EventPollingInterval
+ ]
+ ]
].
millis notNil ifTrue:[
- "/ Trace ifTrue:['C' print. millis printCR.].
- "schedule a clock interrupt after millis milliseconds"
- OperatingSystem enableTimer:millis rounded.
+ "/ Trace ifTrue:['C' print. millis printCR.].
+ "schedule a clock interrupt after millis milliseconds"
+ OperatingSystem enableTimer:millis rounded.
].
scheduledProcesses notNil ifTrue:[
- scheduledProcesses add:p
+ scheduledProcesses add:p
].
"
@@ -804,17 +804,17 @@
"/ Trace ifTrue:['<-' printCR.].
"... when we arrive here, we are back on stage.
- Either by an ALARM or IO signal, or by a suspend of another process
+ Either by an ALARM or IO signal, or by a suspend of another process
"
millis notNil ifTrue:[
- OperatingSystem disableTimer.
+ OperatingSystem disableTimer.
].
"/ check for OS process termination
gotChildSignalInterrupt ifTrue:[
- gotChildSignalInterrupt := false.
- self handleChildSignalInterrupt
+ gotChildSignalInterrupt := false.
+ self handleChildSignalInterrupt
].
"/ check for new input
@@ -822,8 +822,8 @@
OperatingSystem unblockInterrupts.
(gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
- gotIOInterrupt := false.
- self checkForIOWithTimeout:0.
+ gotIOInterrupt := false.
+ self checkForIOWithTimeout:0.
].
wasBlocked ifTrue:[OperatingSystem blockInterrupts].
@@ -841,8 +841,8 @@
"avoid confusion if entered twice"
dispatching == true ifTrue:[
- 'Processor [info]: already in dispatch' infoPrintCR.
- ^ self
+ 'Processor [info]: already in dispatch' infoPrintCR.
+ ^ self
].
dispatching := true.
@@ -851,35 +851,43 @@
"/ (thanks to stefans objectAllocation monitor,
"/ this safes a bit of memory allocation in the scheduler)
- dispatchAction := [ [dispatching] whileTrue:[ self dispatch ] ].
-
- handlerAction := [:ex |
- (HaltInterrupt accepts:ex creator) ifTrue:[
- "/ in a standalone application, we do not want those
- Smalltalk isStandAloneApp ifTrue:[
- Smalltalk isStandAloneDebug ifFalse:[
- ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
- ex proceed.
- ]
- ].
- ].
-
- ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
- ex return
- ].
+ dispatchAction :=
+ [
+ [dispatching] whileTrue:[
+ self dispatch
+ ]
+ ].
+
+ handlerAction :=
+ [:ex |
+ (HaltInterrupt accepts:ex creator) ifTrue:[
+ "/ in a standalone application, we do not want those
+ (Smalltalk isStandAloneApp and:[Smalltalk isStandAloneDebug not]) ifTrue:[
+ ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
+ ex proceed.
+ ].
+ "/ MiniDebugger enter. -- should this be done when some --debug/--verbose was given?
+ ex proceed.
+ ].
+
+ ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
+ ex return
+ ].
ignoredSignals := SignalSet
- with:HaltInterrupt
- with:TerminateProcessRequest
- with:RecursionError
- with:AbortAllOperationRequest.
+ with:HaltInterrupt
+ with:TerminateProcessRequest
+ with:RecursionError
+ with:AbortAllOperationRequest.
"/
"/ I made this an extra call to dispatch; this allows recompilation
"/ of the dispatch-handling code in the running system.
"/
[dispatching] whileTrue:[
- ignoredSignals handle:handlerAction do:dispatchAction
+ ignoredSignals
+ handle:handlerAction
+ do:dispatchAction
].
"/ we arrive here in standalone Apps,
@@ -1133,9 +1141,9 @@
gotChildSignalInterrupt := true.
interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 12.4.1996 / 10:12:18 / stefan"
@@ -1211,7 +1219,7 @@
"/ start the OS-Process
pid := aBlockReturningPid value.
pid notNil ifTrue:[
- osChildExitActions at:pid put:actionBlock.
+ osChildExitActions at:pid put:actionBlock.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ pid
@@ -1287,16 +1295,16 @@
"
no interrupts now - activeProcess has already been changed
- (dont add any message sends here)
+ (don't add any message sends here)
"
"/ ok := self threadSwitchFrom:oldProcess to:aProcess id:id singleStep:singleStep.
%{
extern OBJ ___threadSwitch();
if (__isSmallInteger(id)) {
- ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
+ ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
} else {
- ok = false;
+ ok = false;
}
%}.
@@ -1308,41 +1316,40 @@
activeProcessId := oldId.
currentPriority := oldProcess priority.
- ok == true ifFalse:[
- "
- switch failed for some reason -
- destroy (hard-terminate) the bad process.
- This happens when:
- - the stack went above the absolute limit
- (VM switches back to scheduler)
- - a halted process cannot execute its interrupt
- actions (win32 only)
- "
- (id := p id) ~~ SysProcessId ifTrue:[
- id notNil ifTrue:[
- 'Processor [warning]: problem with process ' errorPrint.
- id errorPrint.
- (nm := p name) notNil ifTrue:[
- ' (' errorPrint. nm errorPrint. ')' errorPrint.
- ].
-
- ok == #halted ifTrue:[
- "/ that process was halted (win32 only)
- p state:#halted.
- '; stopped it.' errorPrintCR.
- self suspend:p.
- ] ifFalse:[
- '; hard-terminate it.' errorPrintCR.
- 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
- p state:#cleanup.
- self terminateNoSignal:p.
- ]
- ]
- ]
+ ok ~~ true ifTrue:[
+ "
+ switch failed for some reason -
+ destroy (hard-terminate) the bad process.
+ This happens when:
+ - the stack went above the absolute limit
+ (VM switches back to scheduler)
+ - a halted process cannot execute its interrupt
+ actions (win32 only)
+ "
+ id := p id.
+ (id ~~ SysProcessId and:[id notNil]) ifTrue:[
+ 'Processor [warning]: problem with process ' errorPrint.
+ id errorPrint.
+ (nm := p name) notNil ifTrue:[
+ ' (' errorPrint. nm errorPrint. ')' errorPrint.
+ ].
+
+ ok == #halted ifTrue:[
+ "/ that process was halted (win32 only)
+ p state:#halted.
+ '; stopped it.' errorPrintCR.
+ self suspend:p.
+ ] ifFalse:[
+ '; hard-terminate it.' errorPrintCR.
+ 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
+ p state:#cleanup.
+ self terminateNoSignal:p.
+ ]
+ ]
].
zombie notNil ifTrue:[
- self class threadDestroy:zombie.
- zombie := nil
+ self class threadDestroy:zombie.
+ zombie := nil
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -1549,60 +1556,81 @@
"Modified: 17.4.1997 / 12:59:33 / stefan"
!
+anyScheduledWindowGroupAtAll
+ "return true, if there is any window group with active topviews.
+ This is used to determine if we should stop scheduling
+ in standAlone applications."
+
+ Screen notNil ifTrue:[
+ Screen allScreens notEmptyOrNil ifTrue:[
+ WindowGroup scheduledWindowGroups notEmptyOrNil ifTrue:[^ true].
+ ].
+ ].
+ ^ false
+
+ "
+ Processor anyScheduledWindowGroupAtAll
+ "
+!
+
anyUserProcessAtAll
"return true, if there is any user process still running,
or waiting on a semaphore.
This is used to determine if we should stop scheduling
in standAlone applications.
- A user process has a non-zero processGroup."
-
- |listArray l prio "{ Class: SmallInteger }"
- wasBlocked|
+ A user process has a non-zero processGroup.
+ Should be called with interrupts blocked."
+
+ |listArray l prio "{ Class: SmallInteger }"|
prio := HighestPriority.
- wasBlocked := OperatingSystem blockInterrupts.
listArray := quiescentProcessLists.
[prio >= 1] whileTrue:[
- l := listArray at:prio.
- l notNil ifTrue:[
- l linksDo:[:aProcess |
- aProcess isUserProcess ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
- ]
- ]
- ].
- prio := prio - 1
+ l := listArray at:prio.
+ l notNil ifTrue:[
+ l linksDo:[:aProcess |
+ aProcess isUserProcess ifTrue:[
+ "/ 'anyUserProcess: found quiescent ' _errorPrint. aProcess asString _errorPrintCR.
+ ^ true.
+ ]
+ ]
+ ].
+ prio := prio - 1
].
+ (scheduledProcesses notNil
+ and:[scheduledProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]) ifTrue:[
+ "/ 'anyUserProcess: found scheduled ' _errorPrint.
+ "/ (scheduledProcesses detect:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]) asString _errorPrintCR.
+ ^ true.
+ ].
+
"/ any user process waiting on a sema?
(readSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "/ 'anyUserProcess: found on read sema' _errorPrintCR.
+ ^ true.
].
(writeSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "/ 'anyUserProcess: found on write sema' _errorPrintCR.
+ ^ true.
].
(timeoutSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "/ 'anyUserProcess: found on timeout sema' _errorPrintCR.
+ ^ true.
].
(timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ ^ true.
].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ false
"
@@ -1911,8 +1939,8 @@
If the process is the current one, reschedule.
Notice:
- This method should only be called by Process>>suspend or
- Process>>suspendWithState:"
+ This method should only be called by Process>>suspend or
+ Process>>suspendWithState:"
|pri l p wasBlocked|
@@ -1920,30 +1948,31 @@
some debugging stuff
"
aProcess isNil ifTrue:[
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
- ^ self
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
+ ^ self
].
aProcess isDead ifTrue:[
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
- self threadSwitch:scheduler.
- ^ self
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
+ self threadSwitch:scheduler.
+ ^ self
].
aProcess == scheduler ifTrue:[
- "only the scheduler may suspend itself"
- activeProcess == scheduler ifTrue:[
- suspendScheduler := true.
- [suspendScheduler] whileTrue:[
- self dispatch.
- ].
- ^ self
- ].
-
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
- ^ self
+ "only the scheduler may suspend itself"
+ activeProcess == scheduler ifTrue:[
+ suspendScheduler := true.
+ [suspendScheduler] whileTrue:[
+ self dispatch.
+ ].
+ ^ self
+ ].
+
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
+ ^ self
].
- aProcess hasInterruptActions ifTrue:[
- aProcess interrupt.
+ (aProcess == activeProcess) ifTrue:[
+ "this is a no-op if the process has no interrupt actions"
+ aProcess interrupt.
].
wasBlocked := OperatingSystem blockInterrupts.
@@ -1955,23 +1984,23 @@
the ifAbsent block, because [] is a shared cheap block, created at compile time
"
(l isNil or:[(l removeIdentical:aProcess ifAbsent:nil) isNil]) ifTrue:[
- "/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
- "/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
- aProcess == activeProcess ifTrue:[
- self threadSwitch:scheduler.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ "/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
+ "/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
+ aProcess == activeProcess ifTrue:[
+ self threadSwitch:scheduler.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
(aProcess == activeProcess) ifTrue:[
- "we can immediately switch sometimes"
- l isEmpty ifTrue:[
- p := scheduler
- ] ifFalse:[
- p := l firstLink
- ].
- self threadSwitch:p
+ "we can immediately switch sometimes"
+ l isEmpty ifTrue:[
+ p := scheduler
+ ] ifFalse:[
+ p := l firstLink
+ ].
+ self threadSwitch:p
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2017,17 +2046,19 @@
|pri id l wasBlocked|
aProcess isNil ifTrue:[^ self].
+
aProcess == scheduler ifTrue:[
- InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
- ^ self
+ InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
+ ^ self
].
wasBlocked := OperatingSystem blockInterrupts.
id := aProcess id.
id isNil ifTrue:[ "already dead"
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ self checkForEndOfDispatch.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
aProcess setId:nil state:#dead.
@@ -2037,36 +2068,38 @@
pri := aProcess priority.
l := quiescentProcessLists at:pri.
l notNil ifTrue:[
- (l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
- l isEmpty ifTrue:[
- quiescentProcessLists at:pri put:nil
- ]
- ]."
+ (l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
+ l isEmpty ifTrue:[
+ quiescentProcessLists at:pri put:nil
+ ]
+ ]."
].
aProcess == activeProcess ifTrue:[
- "
- hard case - it's the currently running process
- we must have the next active process destroy this one
- (we cannot destroy the chair we are sitting on ... :-)
- "
- zombie notNil ifTrue:[
- self error:'active process is zombie' mayProceed:true.
- self class threadDestroy:zombie.
- ].
-
- self unRemember:aProcess.
- zombie := id.
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self threadSwitch:scheduler.
- "not reached"
- ^ self
+ "
+ hard case - it's the currently running process
+ we must have the next active process destroy this one
+ (we cannot destroy the chair we are sitting on ... :-)
+ "
+ zombie notNil ifTrue:[
+ self error:'active process is zombie' mayProceed:true.
+ self class threadDestroy:zombie.
+ ].
+
+ self unRemember:aProcess.
+ zombie := id.
+
+ self checkForEndOfDispatch.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self threadSwitch:scheduler.
+ "not reached"
+ ^ self
].
self unRemember:aProcess.
self class threadDestroy:id.
+ self checkForEndOfDispatch.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
"Modified: / 23-09-1996 / 13:50:24 / stefan"
@@ -2311,27 +2344,27 @@
myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
flipFlop := true.
- 'Processor [info]: timeslicer started' infoPrintCR.
+ Smalltalk verbose ifTrue:[ 'Processor [info]: timeslicer started' infoPrintCR ].
[
- t ~~ TimeSliceInterval ifTrue:[
- "/ interval changed -> need a new delay
- myDelay delay:(t := TimeSliceInterval).
- ].
- myDelay wait.
- self slice.
-
- "/ every other tick, recompute priorities.
- flipFlop := flipFlop not.
- flipFlop ifTrue:[
- scheduledProcesses notNil ifTrue:[
- supportDynamicPriorities ifTrue:[
- self recomputeDynamicPriorities.
- ].
- scheduledProcesses clearContents.
- ] ifFalse:[
- scheduledProcesses := IdentitySet new.
- ].
- ].
+ t ~~ TimeSliceInterval ifTrue:[
+ "/ interval changed -> need a new delay
+ myDelay delay:(t := TimeSliceInterval).
+ ].
+ myDelay wait.
+ self slice.
+
+ "/ every other tick, recompute priorities.
+ flipFlop := flipFlop not.
+ flipFlop ifTrue:[
+ scheduledProcesses notNil ifTrue:[
+ supportDynamicPriorities ifTrue:[
+ self recomputeDynamicPriorities.
+ ].
+ scheduledProcesses clearContents.
+ ] ifFalse:[
+ scheduledProcesses := IdentitySet new.
+ ].
+ ].
] loop.
! !
@@ -2339,52 +2372,62 @@
disableFd:aFileDescriptor doSignal:doSignal
"disable triggering of a semaphore for aFileDescriptor..
- If doSignal is true, the associated semaphore is signaled."
+ If doSignal is true, the associated semaphore is signaled.
+ Answer a collection of semaphores that haven't been signaled."
|idx "{ Class: SmallInteger }"
- wasBlocked sema|
+ wasBlocked sema semaCollection|
wasBlocked := OperatingSystem blockInterrupts.
useIOInterrupts ifTrue:[
OperatingSystem disableIOInterruptsOn:aFileDescriptor.
].
- idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
+ idx := readFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
readFdArray at:idx put:nil.
readCheckArray at:idx put:nil.
(sema := readSemaphoreArray at:idx) notNil ifTrue:[
readSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
- ].
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
].
- idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ idx := readFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
- idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1.
+ idx := writeFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
writeFdArray at:idx put:nil.
writeCheckArray at:idx put:nil.
(sema := writeSemaphoreArray at:idx) notNil ifTrue:[
writeSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
- ].
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
].
- idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ idx := writeFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
- idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:1.
+ idx := exceptFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
exceptFdArray at:idx put:nil.
(sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
exceptSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
+ ].
+ idx := exceptFdArray indexOf:aFileDescriptor startingAt:idx+1.
+ ].
+
+ semaCollection isNil ifTrue:[
+ semaCollection := #().
+ ] ifFalse:[
+ doSignal ifTrue:[
+ semaCollection do:[:eachSema|
+ eachSema signalForAll.
+ semaCollection := #().
].
].
- idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ semaCollection
!
disableSemaphore:aSemaphore
@@ -2397,34 +2440,34 @@
idx := 0.
[idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- useIOInterrupts ifTrue:[
- fd := readFdArray at:idx.
- fd notNil ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- ].
- readFdArray at:idx put:nil.
- readSemaphoreArray at:idx put:nil.
- readCheckArray at:idx put:nil.
+ useIOInterrupts ifTrue:[
+ fd := readFdArray at:idx.
+ fd notNil ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ ].
+ readFdArray at:idx put:nil.
+ readSemaphoreArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
].
idx := 0.
[idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- useIOInterrupts ifTrue:[
- fd := writeFdArray at:idx.
- fd notNil ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- ].
- writeFdArray at:idx put:nil.
- writeSemaphoreArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
+ useIOInterrupts ifTrue:[
+ fd := writeFdArray at:idx.
+ fd notNil ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ ].
+ writeFdArray at:idx put:nil.
+ writeSemaphoreArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
].
idx := 0.
[idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- exceptFdArray at:idx put:nil.
- exceptSemaphoreArray at:idx put:nil.
+ exceptFdArray at:idx put:nil.
+ exceptSemaphoreArray at:idx put:nil.
].
self removeTimeoutForSemaphore:aSemaphore.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2904,18 +2947,17 @@
!
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
+ "add the argument, aBlock to the list of time-scheduled-blocks;
+ to be evaluated by aProcess when the millisecondClock value passes
aMillisecondTime.
- If that block is already in the timeout list,
- its trigger-time is changed.
- The process specified by the argument, aProcess will be interrupted
- for execution of the block.
+ If that block is already in the timeout list, its trigger-time is changed.
+ The process specified by the argument, aProcess
+ will be interrupted for execution of the block.
If aProcess is nil, the block will be evaluated by the scheduler itself
- (which is dangerous - the block should not raise any error conditions).
+ (which is dangerous: the block should not raise any error conditions).
If the process is active at trigger time, the interrupt will occur in
- whatever method it is executing; if suspended at trigger time, it will be
- resumed.
+ whatever method it is executing;
+ if suspended at trigger time, it will be resumed.
The block will be removed from the timed-block list after evaluation
(i.e. it will trigger only once).
Returns an ID, which can be used in #removeTimeoutWidthID:"
@@ -2926,21 +2968,21 @@
wasBlocked := OperatingSystem blockInterrupts.
index := timeoutActionArray identityIndexOf:aBlock startingAt:1.
index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime
+ timeoutArray at:index put:aMillisecondTime
] ifFalse:[
- index := timeoutArray indexOf:nil.
- index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime.
- timeoutActionArray at:index put:aBlock.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:aProcess
- ] ifFalse:[
- timeoutArray := timeoutArray copyWith:aMillisecondTime.
- timeoutActionArray := timeoutActionArray copyWith:aBlock.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
- timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
- index := timeoutArray size.
- ].
+ index := timeoutArray indexOf:nil.
+ index ~~ 0 ifTrue:[
+ timeoutArray at:index put:aMillisecondTime.
+ timeoutActionArray at:index put:aBlock.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:aProcess
+ ] ifFalse:[
+ timeoutArray := timeoutArray copyWith:aMillisecondTime.
+ timeoutActionArray := timeoutActionArray copyWith:aBlock.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
+ timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
+ index := timeoutArray size.
+ ].
].
anyTimeouts := true.
@@ -3044,7 +3086,7 @@
block := timeoutActionArray at:index.
block notNil ifTrue:[
"/ usually (>99%), there is only one single timeout action to call;
- "/ avoid creation of an OrderedCollection
+ "/ avoid creation of an OrderedCollection
firstBlockToEvaluate isNil ifTrue:[
firstBlockToEvaluate := block.
firstProcess := timeoutProcessArray at:index.
@@ -3086,7 +3128,7 @@
].
"/ usually (>99%), there is only one single timeout action to call;
- "/ above code avoided the creation of an OrderedCollection
+ "/ above code avoided the creation of an OrderedCollection
blocksAndProcessesToEvaluate isNil ifTrue:[
firstBlockToEvaluate notNil ifTrue:[
timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
@@ -3096,16 +3138,17 @@
firstProcess isDead ifTrue:[
"/ a timedBlock for a process which has already terminated
"/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+ "/ (executing here may be dangerous, since it would run at scheduler priority here,
"/ and thereby could block the whole smalltalk system.
"/ For this reason is it IGNORED here.)
-"/ Could handle it in timeoutProcess, but we don't,
-"/ because otherwise timeouts might be reissued forever...
-"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
-"/ timeoutHandlerProcess interruptWith:block.
-"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') infoPrintCR.
-"/ ].
+
+ "/ Could handle it in timeoutProcess, but we don't,
+ "/ because otherwise timeouts might be reissued forever...
+ "/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+ "/ timeoutHandlerProcess interruptWith:block.
+ "/ ] ifFalse:[
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') errorPrintCR.
+ "/ ].
] ifFalse:[
firstProcess interruptWith:firstBlockToEvaluate
]
@@ -3123,16 +3166,17 @@
p isDead ifTrue:[
"/ a timedBlock for a process which has already terminated
"/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+ "/ (executing here may be dangerous, since it would run at scheduler priority here,
"/ and thereby could block the whole smalltalk system.
"/ For this reason is it IGNORED here.)
-"/ Could handle it in timeoutProcess, but we don't,
-"/ because otherwise timeouts might be reissued forever...
-"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
-"/ timeoutHandlerProcess interruptWith:block.
-"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') infoPrintCR.
-"/ ].
+
+ "/ Could handle it in timeoutProcess, but we don't,
+ "/ because otherwise timeouts might be reissued forever...
+ "/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+ "/ timeoutHandlerProcess interruptWith:block.
+ "/ ] ifFalse:[
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') errorPrintCR.
+ "/ ].
] ifFalse:[
timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
p interruptWith:block
@@ -3173,8 +3217,10 @@
wasBlocked := OperatingSystem blockInterrupts.
index := 0.
- [index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:index+1.
- index ~~ 0] whileTrue:[
+ [
+ index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:index+1.
+ index ~~ 0
+ ] whileTrue:[
timeoutArray at:index put:nil.
timeoutSemaphoreArray at:index put:nil.
timeoutActionArray at:index put:nil.
@@ -3263,10 +3309,15 @@
(i.e. it will always just wait forever, and perform timeout actions
in its interrupt handler)."
+ |mySema|
+
+ mySema := Semaphore new name:'timeoutHandler'.
[
[
- (Semaphore new name:'timeoutHandler') wait.
+ mySema wait.
] on:Exception do:[:ex|
+ "/ an error occurred in one of the timeout actions.
+
"ignore errors, but tell the user"
InfoPrinting == true ifTrue:[
('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
@@ -3309,6 +3360,37 @@
!ProcessorScheduler methodsFor:'waiting'!
+checkForEndOfDispatch
+ |wasBlocked|
+
+ exitWhenNoMoreUserProcesses ifTrue:[
+ "/ check if there are any processes at all
+ "/ stop dispatching if there is none
+ "/ (and anyTimeouts is false, which means that no timeout blocks are present)
+ "/ and no readSemaphores are present (which means that noone is waiting for input)
+ "/ and no writeSemaphores are present
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ "/ 'scheduled: ' _errorPrint. self anyScheduledWindowGroupAtAll asString _errorPrintCR.
+ "/ 'anyUserProcess: ' _errorPrint. self anyUserProcessAtAll asString _errorPrintCR.
+
+ self anyScheduledWindowGroupAtAll ifFalse:[
+ self anyUserProcessAtAll ifFalse:[
+ Smalltalk verbose ifTrue:[
+ 'Processor [info]: end of dispatch' infoPrintCR.
+ ].
+ dispatching := false.
+ "/ false ifTrue:[
+ "/ MiniInspector basicNew printInstVarsOf:self.
+ "/ MiniDebugger enter:thisContext withMessage:'about to exit' mayProceed:true.
+ "/ ].
+ ].
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+!
+
checkForIOWithTimeout:millis
"this is called, when there is absolutely nothing to do;
hard wait for either input to arrive, or output to be possible
@@ -3494,47 +3576,15 @@
gotIOInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 21.12.1995 / 16:17:40 / stefan"
"Modified: 4.8.1997 / 14:23:08 / cg"
!
-noMoreUserProcesses
- "/ check if there are any processes at all
- "/ stop dispatching if there is none
- "/ (and anyTimeouts is false, which means that no timeout blocks are present)
- "/ and no readSemaphores are present (which means that noone is waiting for input)
- "/ and no writeSemaphores are present
-
- anyTimeouts ifFalse:[
- ^ self anyUserProcessAtAll not.
- ].
- ^ false
-"/ |anySema|
-"/
-"/
-"/ anyTimeouts ifFalse:[
-"/ anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/ anySema ifFalse:[
-"/ anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/ anySema ifFalse:[
-"/ self anyUserProcessAtAll ifFalse:[
-"/ ^ true
-"/ ]
-"/ ].
-"/ ].
-"/ ].
-"/ ^ false
-
- "
- Processor noMoreUserProcesses
- "
-!
-
removeCorruptedFds
"this is sent when select returns an error due to some invalid
fileDescriptor. May happen, if someone does a readWait/writeWait on a
@@ -3546,91 +3596,91 @@
readFdArray/writeFdArray in the debugger)"
readFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- readFdArray at:idx put:nil.
- readCheckArray at:idx put:nil.
- (sema := readSemaphoreArray at:idx) notNil ifTrue:[
- readSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ].
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ readFdArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
+ (sema := readSemaphoreArray at:idx) notNil ifTrue:[
+ readSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ].
].
writeFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- writeFdArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
- (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
- writeSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ writeFdArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
+ (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+ writeSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ]
].
exceptFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- exceptFdArray at:idx put:nil.
- (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
- exceptSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ exceptFdArray at:idx put:nil.
+ (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
+ exceptSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ]
].
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- osChildExitActions keysDo:[:eachPid |
- |result sema|
-
- eachPid notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ]
- ]
- ].
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ osChildExitActions keysDo:[:eachPid |
+ |result sema|
+
+ eachPid notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
+ osChildExitActions safeRemoveKey:eachPid.
+ ]
+ ]
+ ].
].
"Modified: 12.4.1996 / 09:32:58 / stefan"
@@ -3642,9 +3692,9 @@
what to do now."
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
!
@@ -3694,9 +3744,9 @@
of whichever process is currently running."
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 18.10.1996 / 20:35:54 / cg"
@@ -3713,80 +3763,81 @@
doingGC := true.
[doingGC] whileTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- (millis notNil and:[millis <= 0]) ifTrue:[
- ^ self "oops - hurry up checking"
- ].
- ].
-
- "
- if its worth doing, collect a bit of garbage;
- but not, if a backgroundCollector is active
- "
- ObjectMemory backgroundCollectorRunning ifTrue:[
- doingGC := false
- ] ifFalse:[
- doingGC := ObjectMemory gcStepIfUseful.
- ].
-
- "then do idle actions"
- (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
- idleActions do:[:aBlock |
- aBlock value.
- ].
- ^ self "go back checking"
- ].
-
- doingGC ifTrue:[
- (self checkForIOWithTimeout:0) ifTrue:[
- ^ self "go back checking"
- ]
- ]
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ (millis notNil and:[millis <= 0]) ifTrue:[
+ ^ self "oops - hurry up checking"
+ ].
+ ].
+
+ "
+ if its worth doing, collect a bit of garbage;
+ but not, if a backgroundCollector is active
+ "
+ ObjectMemory backgroundCollectorRunning ifTrue:[
+ doingGC := false
+ ] ifFalse:[
+ doingGC := ObjectMemory gcStepIfUseful.
+ ].
+
+ "then do idle actions"
+ (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
+ idleActions do:[:aBlock |
+ aBlock value.
+ ].
+ ^ self "go back checking"
+ ].
+
+ doingGC ifTrue:[
+ (self checkForIOWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ]
+ ]
].
exitWhenNoMoreUserProcesses ifTrue:[
- "/ check if there are any processes at all
- "/ stop dispatching if there is none
- "/ (and anyTimeouts is false, which means that no timeout blocks are present)
- "/ and no readSemaphores are present (which means that noone is waiting for input)
- "/ and no writeSemaphores are present
-
- self noMoreUserProcesses ifTrue:[
- dispatching := false.
- ^ self
- ].
+ "/ check if there are any processes at all
+ "/ stop dispatching if there is none
+ "/ (and anyTimeouts is false, which means that no timeout blocks are present)
+ "/ and no readSemaphores are present (which means that noone is waiting for input)
+ "/ and no writeSemaphores are present
+
+ "/ cg: changed to only check when a process terminated
+ "/ self checkForEndOfDispatch.
+ dispatching ifFalse:[
+ ^ self
+ ].
].
preWaitActions notNil ifTrue:[
- preWaitActions do:[:action | action value].
+ preWaitActions do:[:action | action value].
].
"/
"/ absolutely nothing to do - simply wait
"/
OperatingSystem supportsSelect ifFalse:[
- "SCO instant ShitStation has a bug here,
- waiting always 1 sec in the select - therefore we delay a bit and
- return - effectively polling in 50ms cycles
- "
- (self checkForIOWithTimeout:0) ifTrue:[
- ^ self "go back checking"
- ].
- OperatingSystem millisecondDelay:EventPollingInterval.
- ^ self
+ "SCO instant ShitStation has a bug here,
+ waiting always 1 sec in the select - therefore we delay a bit and
+ return - effectively polling in 50ms cycles
+ "
+ (self checkForIOWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ].
+ OperatingSystem millisecondDelay:EventPollingInterval.
+ ^ self
].
useIOInterrupts ifTrue:[
- dT := 999999
+ dT := 999999
] ifFalse:[
- dT := EventPollingInterval
+ dT := EventPollingInterval
].
millis isNil ifTrue:[
- millis := dT.
+ millis := dT.
] ifFalse:[
- millis := millis rounded min:dT.
+ millis := millis rounded min:dT.
].
self checkForIOWithTimeout:millis