hg/stx-libbasic: comparison ProcessorScheduler.st

equal deleted inserted replaced

-:77ad9497363c
+:0402b3e0d43b
 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
-(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
+quiescentProcessLists           - list of waiting processes
-	scheduler                       - the scheduler process itself
+scheduler                       - the scheduler process itself
-	zombie                          - internal temporary (recently died process)
+zombie                          - internal temporary (recently died process)
-	activeProcess                   - the current process
+activeProcess                   - the current process
-	activeProcessId                 - the current processes id
+activeProcessId                 - the current processes id
-	currentPriority                 - the current processes priority
+currentPriority                 - the current processes priority
-	readFdArray                     - fd-sema-checkBlock triple-association
+readFdArray                     - fd-sema-checkBlock triple-association
-	readSemaphoreArray                (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+readSemaphoreArray                (stupid historic 3-separate arrays for hi-speed-optimization reasons)
-	readCheckArray
+readCheckArray
-	writeFdArray                    - fd-sema-checkBlock triple-association
+writeFdArray                    - fd-sema-checkBlock triple-association
-	writeSemaphoreArray               (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+writeSemaphoreArray               (stupid historic 3-separate arrays for hi-speed-optimization reasons)
-	writeCheckArray
+writeCheckArray
-	timeoutArray                    - time-action-process-sema quadruple-association
+timeoutArray                    - time-action-process-sema quadruple-association
-	timeoutActionArray                (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+timeoutActionArray                (stupid historic 3-separate arrays for hi-speed-optimization reasons)
-	timeoutProcessArray
+timeoutProcessArray
-	timeoutSemaphoreArray
+timeoutSemaphoreArray
-	idleActions                     - actions to be executed when idle
+idleActions                     - actions to be executed when idle
-	preWaitActions                  - actions to be executed BEFORE going into an OS-wait
+preWaitActions                  - actions to be executed BEFORE going into an OS-wait
-	anyTimeouts                     - flag if any timeouts are pending
+anyTimeouts                     - flag if any timeouts are pending
-	dispatching                     - flag if dispatch process is running (i.e. NOT initializing)
+dispatching                     - flag if dispatch process is running (i.e. NOT initializing)
-	interruptedProcess              - the currently interrupted process.
+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)
+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
+gotIOInterrupt                  - flag if I came out of a wait due to an I/O interrupt
-	osChildExitActions              - OS chid process actions
+osChildExitActions              - OS chid process actions
-	gotChildSignalInterrupt         - flag if I came out of a wait due to an OS child interrupt
+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)
+exitWhenNoMoreUserProcesses     - flag which controls if ST/X should exit when the last process dies (for standalone apps)
-	suspendScheduler                - internal use
+suspendScheduler                - internal use
-	timeSliceProcess                - the timeSlicer process
+timeSliceProcess                - the timeSlicer process
-	supportDynamicPriorities        - flag if dynamic priorities should be supported by the timeSlicer
+supportDynamicPriorities        - flag if dynamic priorities should be supported by the timeSlicer
-	scheduledProcesses              - list of scheduled processes for the timeSlicers dynamic prio handling
+scheduledProcesses              - list of scheduled processes for the timeSlicers dynamic prio handling
 [class variables:]
-	KnownProcesses          <WeakArray>     all known processes
+KnownProcesses          <WeakArray>     all known processes
-	KnownProcessIds         <Collection>    and their IDs
+KnownProcessIds         <Collection>    and their IDs
-	PureEventDriven         <Boolean>       true, if no process support
+PureEventDriven         <Boolean>       true, if no process support
-						is available
+is available
-	UserSchedulingPriority  <Integer>       the priority at which normal
+UserSchedulingPriority  <Integer>       the priority at which normal
-						user interfaces run
+user interfaces run
-	UserInterruptPriority                   the priority at which user-
+UserInterruptPriority                   the priority at which user-
-						interrupts (Cntl-C) processing
+interrupts (Cntl-C) processing
-						takes place. Processes with
+takes place. Processes with
-						a greater or equal priority are
+a greater or equal priority are
-						not interruptable.
+not interruptable.
-	TimingPriority                          the priority used for timing.
+TimingPriority                          the priority used for timing.
-						Processes with a greater or
+Processes with a greater or
-						equal priority are not interrupted
+equal priority are not interrupted
-						by timers.
+by timers.
-	HighestPriority                         The highest allowed prio for processes
+HighestPriority                         The highest allowed prio for processes
-	SchedulingPriority                      The priority of the scheduler (must
+SchedulingPriority                      The priority of the scheduler (must
-						me higher than any other).
+me higher than any other).
-	MaxNumberOfProcesses                    if non-nil, no more than this
+MaxNumberOfProcesses                    if non-nil, no more than this
-						number of processes are allowed
+number of processes are allowed
-						(for debugging)
+(for debugging)
-	TimeSliceInterval                       for preemptive priority scheduling only:
+TimeSliceInterval                       for preemptive priority scheduling only:
-						the time interval in millis, at which processes
+the time interval in millis, at which processes
-						are timesliced
+are timesliced
-	TimeSlicingPriorityLimit                for preemptive priority scheduling only:
+TimeSlicingPriorityLimit                for preemptive priority scheduling only:
-						processes are only timesliced, if running
+processes are only timesliced, if running
-						at or below this priority.
+at or below this priority.
-	EventPollingInterval                    for systems which do not support select on
+EventPollingInterval                    for systems which do not support select on
-						a fileDescriptor: the polling interval in millis.
+a fileDescriptor: the polling interval in millis.
 most interesting methods:
-	Processor>>suspend:                  (see also Process>>suspend)
+Processor>>suspend:                  (see also Process>>suspend)
-	Processor>>resume:                   (see also Process>>resume)
+Processor>>resume:                   (see also Process>>resume)
-	Processor>>terminate:                (see also Process>>terminate)
+Processor>>terminate:                (see also Process>>terminate)
-	Processor>>yield
+Processor>>yield
-	Processor>>changePriority:for:       (see also Process>>priority:
+Processor>>changePriority:for:       (see also Process>>priority:
-	Processor>>signal:afterSeconds:      (see also Delay>>forSeconds:)
+Processor>>signal:afterSeconds:      (see also Delay>>forSeconds:)
-	Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
+Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
-	Processor>>signal:onInput:           (see also ExternalStream>>readWait)
+Processor>>signal:onInput:           (see also ExternalStream>>readWait)
-	Processor>>signal:onOutput:          (see also ExternalStream>>writeWait)
+Processor>>signal:onOutput:          (see also ExternalStream>>writeWait)
-	Processor>>disableSemaphore:
+Processor>>disableSemaphore:
 [see also:]
-	Process
+Process
-	Delay Semaphore SemaphoreSet SharedQueue
+Delay Semaphore SemaphoreSet SharedQueue
-	WindowGroup
+WindowGroup
-	(``Working with processes'': programming/processes.html)
+(``Working with processes'': programming/processes.html)
 [author:]
-	Claus Gittinger
+Claus Gittinger
 "
 !
 scheduling
 "
 ].
 Processor isNil ifTrue:[
 	"create the one and only processor"
-	Processor := self basicNew initialize.
+	Smalltalk at:#Processor put:(self basicNew initialize).
 ].
 "
 allow configurations without processes
 (but such configurations are no longer distributed)
 "physical creation of a process.
 (warning: low level entry, no administration done).
 This may raise an exception, if a VM process could not be created."
 MaxNumberOfProcesses notNil ifTrue:[
-	KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
+KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
-	    (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
+(KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
-		"
+"
-		 the number of processes has reached the (soft) limit.
+the number of processes has reached the (soft) limit.
-		 This limit prevents runaway programs from creating too many
+This limit prevents runaway programs from creating too many
-		 processes. If you continue in the debugger, the process will be
+processes. If you continue in the debugger, the process will be
-		 created as usual. If you dont want this, abort or terminate.
+created as usual. If you don't want this, abort or terminate.
-		"
+"
-		self error:'too many processes'.
+self error:'too many processes'.
-	    ]
+]
-	]
+]
 ].
 %{
 int tid;
 extern int __threadCreate();
 tid = __threadCreate(aProcess,
-			 0   /* stackSize: no longer needed */,
+0   /* stackSize: no longer needed */,
-			 __isSmallInteger(id) ? __intVal(id)     /* assign id */
+__isSmallInteger(id) ? __intVal(id)     /* assign id */
-					      : -1              /* let VM assign one */  );
+: -1              /* let VM assign one */  );
 if (tid) {
-	RETURN ( __mkSmallInteger(tid));
+RETURN ( __mkSmallInteger(tid));
 }
 %}
 .
 "
 arrive here, if creation of process in VM failed.
 This may happen, if the VM does not support more processes,
 or if it ran out of memory, when allocating internal data
 structures.
 "
-^ ObjectMemory allocationFailureSignal raise.
+^ AllocationFailure raise.
 !
 threadDestroy:id
 "physical destroy other process ...
 (warning: low level entry, no administration done)"
 "Processor currentPriority"
 !
 interruptCounter
 "for statistics: counts the overall number of interrupts"
 ^ interruptCounter
 "
 Processor interruptCounter
 "
 ^ scheduler
 !
 timedActionCounter
 "for statistics: counts the overall number of timer actions"
 ^ timedActionCounter
 "
 Processor timedActionCounter
 "
 "
 handle all timeout actions
 "
 anyTimeouts ifTrue:[
-	self evaluateTimeouts
+self evaluateTimeouts
 ].
 "first do a quick check for semaphores using checkActions - this is needed for
 devices like the X-connection, where some events might be in the event
 queue but the sockets input queue is empty.
 Also, this is needed for poor MSDOS, where WaitForObject does not work with
 sockets and pipes (sigh)
 "
 nActions := readCheckArray size.
 1 to:nActions do:[:index |
-	checkBlock := readCheckArray at:index.
+checkBlock := readCheckArray at:index.
-	(checkBlock notNil and:[checkBlock value]) ifTrue:[
+(checkBlock notNil and:[checkBlock value]) ifTrue:[
-	    sema := readSemaphoreArray at:index.
+sema := readSemaphoreArray at:index.
-	    sema notNil ifTrue:[
+sema notNil ifTrue:[
-		sema signalOnce.
+sema signalOnce.
-	    ].
+].
-	]
+]
 ].
 nActions := writeCheckArray size.
 1 to:nActions do:[:index |
-	checkBlock := writeCheckArray at:index.
+checkBlock := writeCheckArray at:index.
-	(checkBlock notNil and:[checkBlock value]) ifTrue:[
+(checkBlock notNil and:[checkBlock value]) ifTrue:[
-	    sema := writeSemaphoreArray at:index.
+sema := writeSemaphoreArray at:index.
-	    sema notNil ifTrue:[
+sema notNil ifTrue:[
-		sema signalOnce.
+sema signalOnce.
-	    ].
+].
-	]
+]
 ].
 "now, someone might be runnable ..."
 p := self highestPriorityRunnableProcess.
 p isNil ifTrue:[
-	"/ no one runnable, hard wait for event or timeout
+"/ no one runnable, hard wait for event or timeout
-	"/ Trace ifTrue:['w' printCR.].
+"/ Trace ifTrue:['w' printCR.].
-	self waitForEventOrTimeout.
+self waitForEventOrTimeout.
-	"/ check for OS process termination
+"/ check for OS process termination
-	gotChildSignalInterrupt ifTrue:[
+gotChildSignalInterrupt ifTrue:[
-	    gotChildSignalInterrupt := false.
+gotChildSignalInterrupt := false.
-	    self handleChildSignalInterrupt
+self handleChildSignalInterrupt
-	].
+].
-	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-	^ self
+^ self
 ].
 pri := p priority.
 "
 This is done by enabling ioInterrupts for all file descriptors.
 If ioInterrupts are not available (OS does not support them),
 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
 "
 (a future version will have a process running to handle a timeout queue)
 "
 "
 pri < TimingPriority ifTrue:[
-	anyTimeouts ifTrue:[
+anyTimeouts ifTrue:[
-	    millis := self timeToNextTimeout.
+millis := self timeToNextTimeout.
-	    millis == 0 ifTrue:[
+millis == 0 ifTrue:[
-		wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-		^ self
+^ self
-	    ]
+]
-	]
+]
 ].
 "
 "
 if the process to run has a lower than UserInterruptPriority,
 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:[
+anyTimeouts ifTrue:[
-	    millis := self timeToNextTimeout.
+millis := self timeToNextTimeout.
-	    millis == 0 ifTrue:[
+millis == 0 ifTrue:[
-		wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-		^ self
+^ self
-	    ].
+].
-	].
+].
 "---"
-	useIOInterrupts ifTrue:[
+useIOInterrupts ifTrue:[
 "/            readFdArray do:[:fd |
 "/                (fd notNil and:[fd >= 0]) ifTrue:[
 "/                    OperatingSystem enableIOInterruptsOn:fd
 "/                ].
 "/            ].
-	] ifFalse:[
+] ifFalse:[
-	    millis notNil ifTrue:[
+millis notNil ifTrue:[
-		millis := millis min:EventPollingInterval
+millis := millis min:EventPollingInterval
-	    ] ifFalse:[
+] ifFalse:[
-		millis := EventPollingInterval
+millis := EventPollingInterval
-	    ]
+]
-	]
+]
 ].
 millis notNil ifTrue:[
-	"/ Trace ifTrue:['C' print. millis printCR.].
+"/ Trace ifTrue:['C' print. millis printCR.].
-	"schedule a clock interrupt after millis milliseconds"
+"schedule a clock interrupt after millis milliseconds"
-	OperatingSystem enableTimer:millis rounded.
+OperatingSystem enableTimer:millis rounded.
 ].
 scheduledProcesses notNil ifTrue:[
-	scheduledProcesses add:p
+scheduledProcesses add:p
 ].
 "
 now let the process run - will come back here by reschedule
 from ioInterrupt, scheduler or timerInterrupt ... (running at max+1)
 "/ Trace ifTrue:['->' print. p printCR.].
 self threadSwitch:p.
 "/ 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.
+gotChildSignalInterrupt := false.
-	self handleChildSignalInterrupt
+self handleChildSignalInterrupt
 ].
 "/ check for new input
 OperatingSystem unblockInterrupts.
 (gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
-	gotIOInterrupt := false.
+gotIOInterrupt := false.
-	self checkForIOWithTimeout:0.
+self checkForIOWithTimeout:0.
 ].
 wasBlocked ifTrue:[OperatingSystem blockInterrupts].
 "Modified: / 12.4.1996 / 10:14:18 / stefan"
 |dispatchAction handlerAction ignoredSignals|
 "avoid confusion if entered twice"
 dispatching == true ifTrue:[
-	'Processor [info]: already in dispatch' infoPrintCR.
+'Processor [info]: already in dispatch' infoPrintCR.
-	^ self
+^ self
 ].
 dispatching := true.
 "/ create the relevant blocks & signalSet outside of the
 "/ while-loop
 "/ (thanks to stefans objectAllocation monitor,
 "/  this safes a bit of memory allocation in the scheduler)
-dispatchAction := [ [dispatching] whileTrue:[ self dispatch ] ].
+dispatchAction :=
+[
-handlerAction := [:ex |
+[dispatching] whileTrue:[
-			(HaltInterrupt accepts:ex creator) ifTrue:[
+self dispatch
-			    "/ in a standalone application, we do not want those
+]
-			    Smalltalk isStandAloneApp ifTrue:[
+].
-				Smalltalk isStandAloneDebug ifFalse:[
-				    ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
+handlerAction :=
-				    ex proceed.
+[: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.
-			('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
+ex proceed.
-			ex return
+].
-		     ].
+"/ 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:HaltInterrupt
-			with:TerminateProcessRequest
+with:TerminateProcessRequest
-			with:RecursionError
+with:RecursionError
-			with:AbortAllOperationRequest.
+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,
 "/ when the last process at or above UserSchedulingPriority process died.
 "/ regular ST/X stays in above loop forever
 what to do now."
 gotChildSignalInterrupt := true.
 interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
 activeProcess ~~ scheduler ifTrue:[
-interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+	interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 "Modified: 12.4.1996 / 10:12:18 / stefan"
 !
 OperatingSystem enableChildSignalInterrupts.        "/ no-op in windows
 wasBlocked := OperatingSystem blockInterrupts.
 "/ 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
 "Created: / 25.3.1997 / 10:54:56 / stefan"
 activeProcess := aProcess.
 activeProcessId := id.
 "
 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;
 }
 %}.
 "time passes spent in some other process ...
 ... here again"
 p := activeProcess.
 activeProcess := oldProcess.
 activeProcessId := oldId.
 currentPriority := oldProcess priority.
-ok == true ifFalse:[
+ok ~~ true ifTrue:[
-	"
+"
-	 switch failed for some reason -
+switch failed for some reason -
-	 destroy (hard-terminate) the bad process.
+destroy (hard-terminate) the bad process.
-	 This happens when:
+This happens when:
-	 - the stack went above the absolute limit
+- the stack went above the absolute limit
-	   (VM switches back to scheduler)
+(VM switches back to scheduler)
-	 - a halted process cannot execute its interrupt
+- a halted process cannot execute its interrupt
-	   actions (win32 only)
+actions (win32 only)
-	"
+"
-	(id := p id) ~~ SysProcessId ifTrue:[
+id := p id.
-	    id notNil ifTrue:[
+(id ~~ SysProcessId and:[id notNil]) ifTrue:[
-		'Processor [warning]: problem with process ' errorPrint.
+'Processor [warning]: problem with process ' errorPrint.
-		id errorPrint.
+id errorPrint.
-		(nm := p name) notNil ifTrue:[
+(nm := p name) notNil ifTrue:[
-		    ' (' errorPrint. nm errorPrint. ')' errorPrint.
+' (' errorPrint. nm errorPrint. ')' errorPrint.
-		].
+].
-		ok == #halted ifTrue:[
+ok == #halted ifTrue:[
-		    "/ that process was halted (win32 only)
+"/ that process was halted (win32 only)
-		    p state:#halted.
+p state:#halted.
-		   '; stopped it.' errorPrintCR.
+'; stopped it.' errorPrintCR.
-		   self suspend:p.
+self suspend:p.
-		] ifFalse:[
+] ifFalse:[
-		   '; hard-terminate it.' errorPrintCR.
+'; hard-terminate it.' errorPrintCR.
-		   'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
+'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
-		   p state:#cleanup.
+p state:#cleanup.
-		   self terminateNoSignal:p.
+self terminateNoSignal:p.
-		]
+]
-	    ]
+]
-	]
 ].
 zombie notNil ifTrue:[
-	self class threadDestroy:zombie.
+self class threadDestroy:zombie.
-	zombie := nil
+zombie := nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: / 23-07-2010 / 10:32:11 / cg"
 ! !
 "
 "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."
+A user process has a non-zero processGroup.
+Should be called with interrupts blocked."
-|listArray l prio "{ Class: SmallInteger }"
-wasBlocked|
+|listArray l prio "{ Class: SmallInteger }"|
 prio := HighestPriority.
-wasBlocked := OperatingSystem blockInterrupts.
 listArray := quiescentProcessLists.
 [prio >= 1] whileTrue:[
-	l := listArray at:prio.
+l := listArray at:prio.
-	l notNil ifTrue:[
+l notNil ifTrue:[
-	    l linksDo:[:aProcess |
+l linksDo:[:aProcess |
-		aProcess isUserProcess ifTrue:[
+aProcess isUserProcess ifTrue:[
-		    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+"/ 'anyUserProcess: found quiescent ' _errorPrint. aProcess asString _errorPrintCR.
-		    ^ true.
+^ true.
-		]
+]
-	    ]
+]
-	].
+].
-	prio := prio - 1
+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].
+"/ 'anyUserProcess: found on read sema' _errorPrintCR.
-	^ true.
+^ 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].
+"/ 'anyUserProcess: found on write sema' _errorPrintCR.
-	^ true.
+^ 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].
+"/ 'anyUserProcess: found on timeout sema' _errorPrintCR.
-	^ true.
+^ true.
 ].
 (timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ]
 ) ifTrue:[
-	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+^ true.
-	^ true.
+].
-].
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ false
 "
 Processor anyUserProcessAtAll
 "
 suspend:aProcess
 "remove the argument, aProcess from the list of runnable processes.
 If the process is the current one, reschedule.
 Notice:
-	 This method should only be called by Process>>suspend or
+This method should only be called by Process>>suspend or
-	 Process>>suspendWithState:"
+Process>>suspendWithState:"
 |pri l p wasBlocked|
 "
 some debugging stuff
 "
 aProcess isNil ifTrue:[
-	InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
+InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
-	^ self
+^ self
 ].
 aProcess isDead ifTrue:[
-	InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
+InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
-	self threadSwitch:scheduler.
+self threadSwitch:scheduler.
-	^ self
+^ self
 ].
 aProcess == scheduler ifTrue:[
-	"only the scheduler may suspend itself"
+"only the scheduler may suspend itself"
-	activeProcess == scheduler ifTrue:[
+activeProcess == scheduler ifTrue:[
-	    suspendScheduler := true.
+suspendScheduler := true.
-	    [suspendScheduler] whileTrue:[
+[suspendScheduler] whileTrue:[
-		self dispatch.
+self dispatch.
-	    ].
+].
-	    ^ self
+^ self
-	].
+].
-	InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
+InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
-	^ self
+^ self
 ].
-aProcess hasInterruptActions ifTrue:[
+(aProcess == activeProcess) ifTrue:[
-	aProcess interrupt.
+"this is a no-op if the process has no interrupt actions"
+aProcess interrupt.
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 pri := aProcess priority.
 "notice: this is slightly faster than putting the if-code into
 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.
+"/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
-	"/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
+"/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
-	aProcess == activeProcess ifTrue:[
+aProcess == activeProcess ifTrue:[
-	    self threadSwitch:scheduler.
+self threadSwitch:scheduler.
-	].
+].
-	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-	^ self
+^ self
 ].
 (aProcess == activeProcess) ifTrue:[
-	"we can immediately switch sometimes"
+"we can immediately switch sometimes"
-	l isEmpty ifTrue:[
+l isEmpty ifTrue:[
-	    p := scheduler
+p := scheduler
-	] ifFalse:[
+] ifFalse:[
-	    p := l firstLink
+p := l firstLink
-	].
+].
-	self threadSwitch:p
+self threadSwitch:p
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: / 23.9.1996 / 13:49:24 / stefan"
 (see zombie handling)"
 |pri id l wasBlocked|
 aProcess isNil ifTrue:[^ self].
 aProcess == scheduler ifTrue:[
-	InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
+InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
-	^ self
+^ self
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 id := aProcess id.
 id isNil ifTrue:[   "already dead"
-	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+self checkForEndOfDispatch.
-	^ self
+wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+^ self
 ].
 aProcess setId:nil state:#dead.
 "remove the process from the runnable list"
 pri := aProcess priority.
 l := quiescentProcessLists at:pri.
 l notNil ifTrue:[
-	(l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
+(l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
-	    l isEmpty ifTrue:[
+l isEmpty ifTrue:[
-		quiescentProcessLists at:pri put:nil
+quiescentProcessLists at:pri put:nil
-	    ]
+]
-	]."
+]."
 ].
 aProcess == activeProcess ifTrue:[
-	"
+"
-	 hard case - it's the currently running process
+hard case - it's the currently running process
-	 we must have the next active process destroy this one
+we must have the next active process destroy this one
-	 (we cannot destroy the chair we are sitting on ... :-)
+(we cannot destroy the chair we are sitting on ... :-)
-	"
+"
-	zombie notNil ifTrue:[
+zombie notNil ifTrue:[
-	    self error:'active process is zombie' mayProceed:true.
+self error:'active process is zombie' mayProceed:true.
-	    self class threadDestroy:zombie.
+self class threadDestroy:zombie.
-	].
+].
-	self unRemember:aProcess.
+self unRemember:aProcess.
-	zombie := id.
+zombie := id.
-	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+self checkForEndOfDispatch.
-	self threadSwitch:scheduler.
+wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-	"not reached"
+self threadSwitch:scheduler.
-	^ self
+"not reached"
+^ self
 ].
 self unRemember:aProcess.
 self class threadDestroy:id.
+self checkForEndOfDispatch.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: / 23-09-1996 / 13:50:24 / stefan"
 "Modified: / 20-03-1997 / 16:03:39 / cg"
 "Modified (comment): / 10-08-2011 / 19:57:08 / cg"
 |myDelay t flipFlop|
 myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
 flipFlop := true.
-'Processor [info]: timeslicer started' infoPrintCR.
+Smalltalk verbose ifTrue:[ 'Processor [info]: timeslicer started' infoPrintCR ].
 [
-	t ~~ TimeSliceInterval ifTrue:[
+t ~~ TimeSliceInterval ifTrue:[
-	    "/ interval changed -> need a new delay
+"/ interval changed -> need a new delay
-	    myDelay delay:(t := TimeSliceInterval).
+myDelay delay:(t := TimeSliceInterval).
-	].
+].
-	myDelay wait.
+myDelay wait.
-	self slice.
+self slice.
-	"/ every other tick, recompute priorities.
+"/ every other tick, recompute priorities.
-	flipFlop := flipFlop not.
+flipFlop := flipFlop not.
-	flipFlop ifTrue:[
+flipFlop ifTrue:[
-	    scheduledProcesses notNil ifTrue:[
+scheduledProcesses notNil ifTrue:[
-		supportDynamicPriorities ifTrue:[
+supportDynamicPriorities ifTrue:[
-		    self recomputeDynamicPriorities.
+self recomputeDynamicPriorities.
-		].
+].
-		scheduledProcesses clearContents.
+scheduledProcesses clearContents.
-	    ] ifFalse:[
+] ifFalse:[
-		scheduledProcesses := IdentitySet new.
+scheduledProcesses := IdentitySet new.
-	    ].
+].
-	].
+].
 ] loop.
 ! !
 !ProcessorScheduler methodsFor:'semaphore signalling'!
 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:[
+	    semaCollection isNil ifTrue:[semaCollection := Set new].
-		sema signalForAll.
+	    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:[
+	    semaCollection isNil ifTrue:[semaCollection := Set new].
-		sema signalForAll.
+	    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:[
+	    semaCollection isNil ifTrue:[semaCollection := Set new].
-		sema signalForAll.
+	    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
 "disable triggering of a semaphore"
 wasBlocked := OperatingSystem blockInterrupts.
 idx := 0.
 [idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 idx ~~ 0] whileTrue:[
-useIOInterrupts ifTrue:[
+	useIOInterrupts ifTrue:[
-fd := readFdArray at:idx.
+	    fd := readFdArray at:idx.
-fd notNil ifTrue:[
+	    fd notNil ifTrue:[
-OperatingSystem disableIOInterruptsOn:fd
+		OperatingSystem disableIOInterruptsOn:fd
-].
+	    ].
-].
+	].
-readFdArray at:idx put:nil.
+	readFdArray at:idx put:nil.
-readSemaphoreArray at:idx put:nil.
+	readSemaphoreArray at:idx put:nil.
-readCheckArray at:idx put:nil.
+	readCheckArray at:idx put:nil.
 ].
 idx := 0.
 [idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 idx ~~ 0] whileTrue:[
-useIOInterrupts ifTrue:[
+	useIOInterrupts ifTrue:[
-fd := writeFdArray at:idx.
+	    fd := writeFdArray at:idx.
-fd notNil ifTrue:[
+	    fd notNil ifTrue:[
-OperatingSystem disableIOInterruptsOn:fd
+		OperatingSystem disableIOInterruptsOn:fd
-].
+	    ].
-].
+	].
-writeFdArray at:idx put:nil.
+	writeFdArray at:idx put:nil.
-writeSemaphoreArray at:idx put:nil.
+	writeSemaphoreArray at:idx put:nil.
-writeCheckArray 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.
+	exceptFdArray at:idx put:nil.
-exceptSemaphoreArray at:idx put:nil.
+	exceptSemaphoreArray at:idx put:nil.
 ].
 self removeTimeoutForSemaphore:aSemaphore.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:19:33 / cg"
 "Modified: 23.9.1996 / 14:34:18 / cg"
 !
 addTimedBlock:aBlock for:aProcess atMilliseconds:aMillisecondTime
-"add the argument, aBlock to the list of time-scheduled-blocks; to be
+"add the argument, aBlock to the list of time-scheduled-blocks;
-evaluated by aProcess when the millisecondClock value passes
+to be evaluated by aProcess when the millisecondClock value passes
 aMillisecondTime.
-If that block is already in the timeout list,
+If that block is already in the timeout list, its trigger-time is changed.
-its trigger-time is changed.
+The process specified by the argument, aProcess
-The process specified by the argument, aProcess will be interrupted
+will be interrupted for execution of the block.
-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
+whatever method it is executing;
-resumed.
+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:"
 |index "{ Class: SmallInteger }"
 wasBlocked|
 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 := timeoutArray indexOf:nil.
-	index ~~ 0 ifTrue:[
+index ~~ 0 ifTrue:[
-	    timeoutArray at:index put:aMillisecondTime.
+timeoutArray at:index put:aMillisecondTime.
-	    timeoutActionArray at:index put:aBlock.
+timeoutActionArray at:index put:aBlock.
-	    timeoutSemaphoreArray at:index put:nil.
+timeoutSemaphoreArray at:index put:nil.
-	    timeoutProcessArray at:index put:aProcess
+timeoutProcessArray at:index put:aProcess
-	] ifFalse:[
+] ifFalse:[
-	    timeoutArray := timeoutArray copyWith:aMillisecondTime.
+timeoutArray := timeoutArray copyWith:aMillisecondTime.
-	    timeoutActionArray := timeoutActionArray copyWith:aBlock.
+timeoutActionArray := timeoutActionArray copyWith:aBlock.
-	    timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
+timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
-	    timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
+timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
-	    index := timeoutArray size.
+index := timeoutArray size.
-	].
+].
 ].
 anyTimeouts := true.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ index
 ] ifFalse:[
 "to support pure-events"
 block := timeoutActionArray at:index.
 block notNil ifTrue:[
 "/ usually (>99%), there is only one single timeout action to call;
 "/ avoid creation of an OrderedCollection
 firstBlockToEvaluate isNil ifTrue:[
 firstBlockToEvaluate := block.
 firstProcess := timeoutProcessArray at:index.
 ] ifFalse:[
 blocksAndProcessesToEvaluate isNil ifTrue:[
 wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
 ].
 ].
 "/ usually (>99%), there is only one single timeout action to call;
 "/ above code avoided the creation of an OrderedCollection
 blocksAndProcessesToEvaluate isNil ifTrue:[
 firstBlockToEvaluate notNil ifTrue:[
 timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
 (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
 firstBlockToEvaluate value
 ] ifFalse:[
 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...
+"/ Could handle it in timeoutProcess, but we don't,
-"/                    (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+"/ because otherwise timeouts might be reissued forever...
-"/                        timeoutHandlerProcess interruptWith:block.
+"/      (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
-"/                    ] ifFalse:[
+"/          timeoutHandlerProcess interruptWith:block.
-('ProcessorScheduler [warning]: cannot evaluate timedBlock (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') infoPrintCR.
+"/      ] ifFalse:[
-"/                    ].
+('ProcessorScheduler [warning]: cannot evaluate timedBlock (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') errorPrintCR.
+"/      ].
 ] ifFalse:[
 firstProcess interruptWith:firstBlockToEvaluate
 ]
 ]
 ].
 timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
 ] ifFalse:[
 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...
+"/ Could handle it in timeoutProcess, but we don't,
-"/                    (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+"/ because otherwise timeouts might be reissued forever...
-"/                        timeoutHandlerProcess interruptWith:block.
+"/      (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
-"/                    ] ifFalse:[
+"/          timeoutHandlerProcess interruptWith:block.
-('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') infoPrintCR.
+"/      ] ifFalse:[
-"/                    ].
+('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') errorPrintCR.
+"/      ].
 ] ifFalse:[
 timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
 p interruptWith:block
 ]
 ]
 wasBlocked|
 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.
 timeoutProcessArray at:index put:nil.
 ].
 "The timeoutHandlerProcess does nothing but wait.
 It exists only, so that timeout blocks may be executed in its context
 (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.
 thisContext fullPrintAll.
 ].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
 !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
 or a timeout to occur."
 Notice, that at the time of the message, we are still in the context
 of whichever process is currently running."
 gotIOInterrupt := true.
 activeProcess ~~ scheduler ifTrue:[
-interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+	interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	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
 an #EBADF error, leading to high-frequency polling and a locked up system.
 (you could still fix things by interrupting on the console and fixing the
 readFdArray/writeFdArray in the debugger)"
 readFdArray keysAndValuesDo:[:idx :fd |
-|result sema|
+	|result sema|
-fd notNil ifTrue:[
+	fd notNil ifTrue:[
-result := OperatingSystem
+	    result := OperatingSystem
-selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+			selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
-readableInto:nil writableInto:nil exceptionInto:nil
+			   readableInto:nil writableInto:nil exceptionInto:nil
-withTimeOut:0.
+			   withTimeOut:0.
-result < 0 ifTrue:[
+	    result < 0 ifTrue:[
-'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+		'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
-readFdArray at:idx put:nil.
+		readFdArray at:idx put:nil.
-readCheckArray at:idx put:nil.
+		readCheckArray at:idx put:nil.
-(sema := readSemaphoreArray at:idx) notNil ifTrue:[
+		(sema := readSemaphoreArray at:idx) notNil ifTrue:[
-readSemaphoreArray at:idx put:nil.
+		    readSemaphoreArray at:idx put:nil.
-self removeTimeoutForSemaphore:sema.
+		    self removeTimeoutForSemaphore:sema.
-sema signalForAll.
+		    sema signalForAll.
-].
+		].
-]
+	    ]
-].
+	].
 ].
 writeFdArray keysAndValuesDo:[:idx :fd |
-|result sema|
+	|result sema|
-fd notNil ifTrue:[
+	fd notNil ifTrue:[
-result := OperatingSystem
+	    result := OperatingSystem
-selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
+			selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
-readableInto:nil writableInto:nil exceptionInto:nil
+			   readableInto:nil writableInto:nil exceptionInto:nil
-withTimeOut:0.
+			   withTimeOut:0.
-result < 0 ifTrue:[
+	    result < 0 ifTrue:[
-'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+		'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
-writeFdArray at:idx put:nil.
+		writeFdArray at:idx put:nil.
-writeCheckArray at:idx put:nil.
+		writeCheckArray at:idx put:nil.
-(sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+		(sema := writeSemaphoreArray at:idx) notNil ifTrue:[
-writeSemaphoreArray at:idx put:nil.
+		    writeSemaphoreArray at:idx put:nil.
-self removeTimeoutForSemaphore:sema.
+		    self removeTimeoutForSemaphore:sema.
-sema signalForAll.
+		    sema signalForAll.
-].
+		].
-]
+	    ]
-]
+	]
 ].
 exceptFdArray keysAndValuesDo:[:idx :fd |
-|result sema|
+	|result sema|
-fd notNil ifTrue:[
+	fd notNil ifTrue:[
-result := OperatingSystem
+	    result := OperatingSystem
-selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
+			selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
-readableInto:nil writableInto:nil exceptionInto:nil
+			   readableInto:nil writableInto:nil exceptionInto:nil
-withTimeOut:0.
+			   withTimeOut:0.
-result < 0 ifTrue:[
+	    result < 0 ifTrue:[
-'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+		'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
-exceptFdArray at:idx put:nil.
+		exceptFdArray at:idx put:nil.
-(sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
+		(sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
-exceptSemaphoreArray at:idx put:nil.
+		    exceptSemaphoreArray at:idx put:nil.
-self removeTimeoutForSemaphore:sema.
+		    self removeTimeoutForSemaphore:sema.
-sema signalForAll.
+		    sema signalForAll.
-].
+		].
-]
+	    ]
-]
+	]
 ].
 OperatingSystem isMSWINDOWSlike ifTrue:[
-"/
+	"/
-"/ win32 does a WaitForMultipleObjects in select...
+	"/ win32 does a WaitForMultipleObjects in select...
-"/ unix waits for SIGCHLD
+	"/ unix waits for SIGCHLD
-"/
+	"/
-osChildExitActions keysDo:[:eachPid |
+	osChildExitActions keysDo:[:eachPid |
-|result sema|
+	    |result sema|
-eachPid notNil ifTrue:[
+	    eachPid notNil ifTrue:[
-result := OperatingSystem
+		result := OperatingSystem
-selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
+			    selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
-readableInto:nil writableInto:nil exceptionInto:nil
+			       readableInto:nil writableInto:nil exceptionInto:nil
-withTimeOut:0.
+			       withTimeOut:0.
-result < 0 ifTrue:[
+		result < 0 ifTrue:[
-'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
+		    'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
-osChildExitActions safeRemoveKey:eachPid.
+		    osChildExitActions safeRemoveKey:eachPid.
-]
+		]
-]
+	    ]
-].
+	].
 ].
 "Modified: 12.4.1996 / 09:32:58 / stefan"
 "Modified: 27.1.1997 / 20:09:27 / cg"
 !
 schedulerInterrupt
 "forced reschedule - switch to scheduler process which will decide
 what to do now."
 activeProcess ~~ scheduler ifTrue:[
-interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+	interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 !
 timeToNextTimeout
 "return the delta-T (in millis) to next timeout, or nil if
 This method is called by the VM' interrupt handling mechanism.
 Notice, that at the time of the message, we are still in the context
 of whichever process is currently running."
 activeProcess ~~ scheduler ifTrue:[
-interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+	interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 "Modified: 18.10.1996 / 20:35:54 / cg"
 !
 |millis doingGC dT|
 doingGC := true.
 [doingGC] whileTrue:[
-	anyTimeouts ifTrue:[
+anyTimeouts ifTrue:[
-	    millis := self timeToNextTimeout.
+millis := self timeToNextTimeout.
-	    (millis notNil and:[millis <= 0]) ifTrue:[
+(millis notNil and:[millis <= 0]) ifTrue:[
-		^ self    "oops - hurry up checking"
+^ self    "oops - hurry up checking"
-	    ].
+].
-	].
+].
-	"
+"
-	 if its worth doing, collect a bit of garbage;
+if its worth doing, collect a bit of garbage;
-	 but not, if a backgroundCollector is active
+but not, if a backgroundCollector is active
-	"
+"
-	ObjectMemory backgroundCollectorRunning ifTrue:[
+ObjectMemory backgroundCollectorRunning ifTrue:[
-	    doingGC := false
+doingGC := false
-	] ifFalse:[
+] ifFalse:[
-	    doingGC := ObjectMemory gcStepIfUseful.
+doingGC := ObjectMemory gcStepIfUseful.
-	].
+].
-	"then do idle actions"
+"then do idle actions"
-	(idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
+(idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
-	    idleActions do:[:aBlock |
+idleActions do:[:aBlock |
-		aBlock value.
+aBlock value.
-	    ].
+].
-	    ^ self   "go back checking"
+^ self   "go back checking"
-	].
+].
-	doingGC ifTrue:[
+doingGC ifTrue:[
-	    (self checkForIOWithTimeout:0) ifTrue:[
+(self checkForIOWithTimeout:0) ifTrue:[
-		^ self  "go back checking"
+^ self  "go back checking"
-	    ]
+]
-	]
+]
 ].
 exitWhenNoMoreUserProcesses ifTrue:[
-	"/ check if there are any processes at all
+"/ check if there are any processes at all
-	"/ stop dispatching if there is none
+"/ stop dispatching if there is none
-	"/ (and anyTimeouts is false, which means that no timeout blocks are present)
+"/ (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 readSemaphores are present (which means that noone is waiting for input)
-	"/ and no writeSemaphores are present
+"/ and no writeSemaphores are present
-	self noMoreUserProcesses ifTrue:[
+"/ cg: changed to only check when a process terminated
-	    dispatching := false.
+"/ self checkForEndOfDispatch.
-	    ^ self
+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,
+"SCO instant ShitStation has a bug here,
-	 waiting always 1 sec in the select - therefore we delay a bit and
+waiting always 1 sec in the select - therefore we delay a bit and
-	 return - effectively polling in 50ms cycles
+return - effectively polling in 50ms cycles
-	"
+"
-	(self checkForIOWithTimeout:0) ifTrue:[
+(self checkForIOWithTimeout:0) ifTrue:[
-	    ^ self  "go back checking"
+^ self  "go back checking"
-	].
+].
-	OperatingSystem millisecondDelay:EventPollingInterval.
+OperatingSystem millisecondDelay:EventPollingInterval.
-	^ self
+^ 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
 "Modified: 14.12.1995 / 13:37:46 / stefan"

branch	jv
changeset 23072	0402b3e0d43b
parent 23071	77ad9497363c
parent 21027	ad86468de3a0
child 23073	7e7d5e29738c