diff -r 77ad9497363c -r 0402b3e0d43b ProcessorScheduler.st --- 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 all known processes - KnownProcessIds and their IDs - - PureEventDriven true, if no process support - is available - - UserSchedulingPriority 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 all known processes + KnownProcessIds and their IDs + + PureEventDriven true, if no process support + is available + + UserSchedulingPriority 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