hg/stx-libbasic: comparison ProcessorScheduler.st

equal deleted inserted replaced

-:e989f43ce274
+:c30c21be7440
 		osChildExitActions gotChildSignalInterrupt
 		exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
 		supportDynamicPriorities timeSliceNeededSemaphore
 		scheduledProcesses preWaitActions timeoutHandlerProcess
 		readableResultFdArray writableResultFdArray exceptFdArray
-		exceptResultFdArray exceptSemaphoreArray'
+		exceptResultFdArray exceptSemaphoreArray interruptCounter
+		timedActionCounter'
 	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
 		UserSchedulingPriority UserInterruptPriority TimingPriority
 		HighestPriority SchedulingPriority MaxNumberOfProcesses
 		InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
 		EventPollingInterval MaxProcessId'
 ^ currentPriority
 "Processor currentPriority"
 !
+interruptCounter
+"for statistics: counts the overall number of interrupts"
+^ interruptCounter
+"
+Processor interruptCounter
+"
+!
 interruptedProcess
 "returns the process which was interrupted by the active one"
 ^ interruptedProcess
 !
 scheduler
 "return the scheduling process"
 ^ scheduler
+!
+timedActionCounter
+"for statistics: counts the overall number of timer actions"
+^ timedActionCounter
+"
+Processor timedActionCounter
+"
 ! !
 !ProcessorScheduler methodsFor:'background processing'!
 addIdleBlock:aBlock
 "
 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.
 "
 (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"
 |nPrios "{ Class: SmallInteger }"
 p l|
 KnownProcesses isNil ifTrue:[
-KnownProcesses := WeakArray new:30.
+	KnownProcesses := WeakArray new:30.
-KnownProcesses addDependent:self class.
+	KnownProcesses addDependent:self class.
-KnownProcessIds := OrderedCollection new:30.
+	KnownProcessIds := OrderedCollection new:30.
 ].
 "
 create a collection with process lists; accessed using the priority as key
 "
 dispatching := false.
 useIOInterrupts := OperatingSystem supportsIOInterrupts.
 gotIOInterrupt := false.
 osChildExitActions := Dictionary new.
 gotChildSignalInterrupt := false.
+interruptCounter := timedActionCounter := 0.
 supportDynamicPriorities := false.
 exitWhenNoMoreUserProcesses isNil ifTrue:[
-exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
+	exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
 ].
 "
 handcraft the first (dispatcher-) process - this one will never
 block, but go into a select if there is nothing to do.
 for a runnable process.
 "
 currentPriority := SchedulingPriority.
 p := Process basicNew.
 p
-setId:0 state:#run;
+	setId:0 state:#run;
-setPriority:currentPriority;
+	setPriority:currentPriority;
-name:'scheduler';
+	name:'scheduler';
-beSystemProcess.
+	beSystemProcess.
 scheduler := activeProcess := p.
 activeProcessId := 0.
 quiescentProcessLists at:currentPriority put:(l := LinkedList new).
 "
 let me handle IO and timer interrupts
 "
 useIOInterrupts ifTrue:[ObjectMemory ioInterruptHandler:self].
 ObjectMemory
-timerInterruptHandler:self;
+	timerInterruptHandler:self;
-childSignalInterruptHandler:self.
+	childSignalInterruptHandler:self.
 "Modified: / 7.1.1997 / 16:48:26 / stefan"
 "Modified: / 4.2.1999 / 13:08:39 / cg"
 !
 <context: #return>
 |index pri aProcess l|
 OperatingSystem interruptsBlocked ifFalse:[
-MiniDebugger
+	MiniDebugger
-enterWithMessage:'vmResumeInterrupt with no interruptsBlocked'
+	    enterWithMessage:'vmResumeInterrupt with no interruptsBlocked'
-mayProceed:true.
+	    mayProceed:true.
 ].
 index := KnownProcessIds identityIndexOf:id.
 index ~~ 0 ifTrue:[
-aProcess := KnownProcesses at:index.
+	aProcess := KnownProcesses at:index.
-pri := aProcess priority.
+	pri := aProcess priority.
-l := quiescentProcessLists at:pri.
+	l := quiescentProcessLists at:pri.
-l notNil ifTrue:[
+	l notNil ifTrue:[
-(l includesIdentical:aProcess) ifTrue:[
+	    (l includesIdentical:aProcess) ifTrue:[
-"/ aProcess is on a run queue.
+		"/ aProcess is on a run queue.
-"/ CG: this situation may happen, if the wrapCall
+		"/ CG: this situation may happen, if the wrapCall
-"/ finishes before the process was layed to sleep
+		"/ finishes before the process was layed to sleep
-"/ (i.e. schedulerIRQ arrives before the threadSwitch was finished).
+		"/ (i.e. schedulerIRQ arrives before the threadSwitch was finished).
-"/ In that case, simply resume it and everything is OK.
+		"/ In that case, simply resume it and everything is OK.
-"/ If the process is state running, ignore.
+		"/ If the process is state running, ignore.
-|state|
+		|state|
-state := aProcess state.
+		state := aProcess state.
-(state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[
+		(state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[
-aProcess state:#run.
+		    aProcess state:#run.
-].
+		].
-'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint.
+		'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint.
-aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR.
+		aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR.
-^ self
+		^ self
-]
+	    ]
-] ifFalse:[
+	] ifFalse:[
-l := LinkedList new.
+	    l := LinkedList new.
-quiescentProcessLists at:pri put:l.
+	    quiescentProcessLists at:pri put:l.
-].
+	].
-l addLast:aProcess.
+	l addLast:aProcess.
-aProcess state:#run.
+	aProcess state:#run.
 ] ifFalse:[
-'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint.
+	'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint.
-id infoPrintCR.
+	id infoPrintCR.
 ]
 "Modified: / 28.9.1998 / 11:36:53 / cg"
 !
 "child changed state - switch to scheduler process which will decide
 what to do now."
 gotChildSignalInterrupt := true.
 activeProcess ~~ scheduler ifTrue:[
-	interruptedProcess := activeProcess.
+interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
-	self threadSwitch:scheduler
+interruptedProcess := activeProcess.
+self threadSwitch:scheduler
 ]
 "Modified: 12.4.1996 / 10:12:18 / stefan"
 !
 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].
+		    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ true.
+		    ^ true.
-]
+		]
-]
+	    ]
-].
+	].
-prio := prio - 1
+	prio := prio - 1
 ].
 "/ 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] ]]]
 ) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ 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] ]]]
 ) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ 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] ]]]
 ) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ true.
+	^ true.
 ].
 (timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ]
 ) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ true.
+	^ true.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ false
 |idx "{ Class: SmallInteger }"
 wasBlocked sema|
 wasBlocked := OperatingSystem blockInterrupts.
 useIOInterrupts ifTrue:[
-OperatingSystem disableIOInterruptsOn:aFileDescriptor.
+	OperatingSystem disableIOInterruptsOn:aFileDescriptor.
 ].
 idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
 [idx ~~ 0] whileTrue:[
-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.
-doSignal ifTrue:[
+	    doSignal ifTrue:[
-sema signalForAll.
+		sema signalForAll.
-].
+	    ].
-].
+	].
-idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+	idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
 ].
 idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1.
 [idx ~~ 0] whileTrue:[
-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.
-doSignal ifTrue:[
+	    doSignal ifTrue:[
-sema signalForAll.
+		sema signalForAll.
-].
+	    ].
-].
+	].
-idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+	idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
 ].
 idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:1.
 [idx ~~ 0] whileTrue:[
-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.
-doSignal ifTrue:[
+	    doSignal ifTrue:[
-sema signalForAll.
+		sema signalForAll.
-].
+	    ].
-].
+	].
-idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+	idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 disableSemaphore:aSemaphore
 wasBlocked fd|
 wasBlocked := OperatingSystem blockInterrupts.
 idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt: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 := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt: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 := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-timeoutArray at:idx put:nil.
+	timeoutArray at:idx put:nil.
-timeoutSemaphoreArray at:idx put:nil.
+	timeoutSemaphoreArray at:idx put:nil.
-timeoutActionArray at:idx put:nil.
+	timeoutActionArray at:idx put:nil.
-timeoutProcessArray at:idx put:nil.
+	timeoutProcessArray at:idx put:nil.
-idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-exceptFdArray at:idx put:nil.
+	exceptFdArray at:idx put:nil.
-exceptSemaphoreArray at:idx put:nil.
+	exceptSemaphoreArray at:idx put:nil.
-idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:19:33 / cg"
 !
 "Here we assume, that for every triple (aSemaphore, aFileDescriptor, aBlock)
 aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil"
 aFileDescriptor isNil ifTrue:[
-idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil.
+	idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil.
-idx == 0 ifTrue:[
+	idx == 0 ifTrue:[
-"aSemaphore is not registered yet, have to create a new slot"
+	    "aSemaphore is not registered yet, have to create a new slot"
-exceptFdArray := exceptFdArray copyWith:nil.
+	    exceptFdArray := exceptFdArray copyWith:nil.
-exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
+	    exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
-] ifFalse:[
+	] ifFalse:[
-slot := exceptSemaphoreArray at:idx.
+	    slot := exceptSemaphoreArray at:idx.
-slot isNil ifTrue:[
+	    slot isNil ifTrue:[
-exceptSemaphoreArray at:idx put:aSemaphore.
+		exceptSemaphoreArray at:idx put:aSemaphore.
-]
+	    ]
-]
+	]
 ] ifFalse:[
-idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil.
+	idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil.
-idx == 0 ifTrue:[
+	idx == 0 ifTrue:[
-"aFileDescriptor is not registered yet, have to create a new slot"
+	    "aFileDescriptor is not registered yet, have to create a new slot"
-exceptFdArray := exceptFdArray copyWith:aFileDescriptor.
+	    exceptFdArray := exceptFdArray copyWith:aFileDescriptor.
-exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
+	    exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
-] ifFalse:[
+	] ifFalse:[
-slot := exceptFdArray at:idx.
+	    slot := exceptFdArray at:idx.
-slot isNil ifTrue:[
+	    slot isNil ifTrue:[
-exceptFdArray at:idx put:aFileDescriptor.
+		exceptFdArray at:idx put:aFileDescriptor.
-exceptSemaphoreArray at:idx put:aSemaphore.
+		exceptSemaphoreArray at:idx put:aSemaphore.
-].
+	    ].
-].
+	].
 "/        (useIOInterrupts and:[slot isNil]) ifTrue:[
 "/            OperatingSystem enableIOInterruptsOn:aFileDescriptor
 "/        ].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 n "{ Class: SmallInteger }"
 indexOfLastTimeout "{ Class: SmallInteger }"
 halfSize "{ Class: SmallInteger }"
 wasBlocked p|
 anyTimeouts ifFalse:[ ^ self].
 anyTimeouts := false.
 "have to collect the blocks first, then evaluate them.
 This avoids problems due to newly inserted blocks."
 "/ looks ugly, but as this is called very often, reduces idle allocation by a lot.
 now := OperatingSystem getMillisecondTime.
 n := timeoutArray size.
 1 to:n do:[:index |
-	aTime := timeoutArray at:index.
+aTime := timeoutArray at:index.
-	aTime notNil ifTrue:[
+aTime notNil ifTrue:[
-	    (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[
+(OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[
-		"this one should be triggered"
+"this one should be triggered"
-		sema := timeoutSemaphoreArray at:index.
+sema := timeoutSemaphoreArray at:index.
-		sema notNil ifTrue:[
+sema notNil ifTrue:[
-		    timeoutSemaphoreArray at:index put:nil.
+timeoutSemaphoreArray at:index put:nil.
-		    sema signalOnce.
+timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF).
-		] ifFalse:[
+sema signalOnce.
-		    "to support pure-events"
+] ifFalse:[
-		    block := timeoutActionArray at:index.
+"to support pure-events"
-		    block notNil ifTrue:[
+block := timeoutActionArray at:index.
-			firstBlockToEvaluate isNil ifTrue:[
+block notNil ifTrue:[
-			    firstBlockToEvaluate := block.
+"/ usually (>99%), there is only one single timeout action to call;
-			    firstProcess := timeoutProcessArray at:index.
+"/ avoid creation of an OrderedCollection
-			] ifFalse:[
+firstBlockToEvaluate isNil ifTrue:[
-			    blocksAndProcessesToEvaluate isNil ifTrue:[
+firstBlockToEvaluate := block.
-				blocksAndProcessesToEvaluate := OrderedCollection
+firstProcess := timeoutProcessArray at:index.
-								    with:firstBlockToEvaluate
+] ifFalse:[
-								    with:firstProcess.
+blocksAndProcessesToEvaluate isNil ifTrue:[
-			    ].
+blocksAndProcessesToEvaluate := OrderedCollection
-			    blocksAndProcessesToEvaluate add:block.
+with:firstBlockToEvaluate
-			    blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
+with:firstProcess.
-			].
+].
-			timeoutActionArray at:index put:nil.
+blocksAndProcessesToEvaluate add:block.
-			timeoutProcessArray at:index put:nil.
+blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
-		    ]
+].
-		].
+timeoutActionArray at:index put:nil.
-		timeoutArray at:index put:nil.
+timeoutProcessArray at:index put:nil.
-	    ] ifFalse:[
+]
-		"there are still pending timeouts"
+].
-		anyTimeouts := true.
+timeoutArray at:index put:nil.
-		indexOfLastTimeout := index.
+] ifFalse:[
-	    ]
+"there are still pending timeouts"
-	]
+anyTimeouts := true.
+indexOfLastTimeout := index.
+]
+]
 ].
 "shrink the arrays, if they are 50% free"
 n > 20 ifTrue:[
-	halfSize := n // 2.
+halfSize := n // 2.
-	indexOfLastTimeout < halfSize ifTrue:[
+indexOfLastTimeout < halfSize ifTrue:[
-	    wasBlocked := OperatingSystem blockInterrupts.
+wasBlocked := OperatingSystem blockInterrupts.
-	    (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[   "/ no new timeouts arrived
+(timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[   "/ no new timeouts arrived
-		timeoutArray := timeoutArray copyTo:halfSize.
+timeoutArray := timeoutArray copyTo:halfSize.
-		timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
+timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
-		timeoutActionArray := timeoutActionArray copyTo:halfSize.
+timeoutActionArray := timeoutActionArray copyTo:halfSize.
-		timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
+timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
-	    ].
+].
-	    wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+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:[
+firstBlockToEvaluate notNil ifTrue:[
-	    (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
+timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF).
-		firstBlockToEvaluate value
+(firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
-	    ] ifFalse:[
+firstBlockToEvaluate value
-		firstProcess isDead ifTrue:[
+] ifFalse:[
-		    "/ a timedBlock for a process which has already terminated
+firstProcess isDead ifTrue:[
-		    "/ issue a warning and do not execute it.
+"/ a timedBlock for a process which has already terminated
-		    "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+"/ issue a warning and do not execute it.
-		    "/  and thereby could block the whole smalltalk system.
+"/ (exeuting here may be dangerous, since it would run at scheduler priority here,
-		    "/  For this reason is it IGNORED 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 for dead process: ''' , firstProcess name , '''') infoPrintCR.
+('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR.
-			('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
+('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
 "/                    ].
-		] ifFalse:[
+] ifFalse:[
-		    firstProcess interruptWith:firstBlockToEvaluate
+firstProcess interruptWith:firstBlockToEvaluate
-		]
+]
-	    ]
+]
-	].
+].
 ] ifFalse:[
-	n := blocksAndProcessesToEvaluate size.
+n := blocksAndProcessesToEvaluate size.
-	1 to:n by:2 do:[:index |
+1 to:n by:2 do:[:index |
-	    block := blocksAndProcessesToEvaluate at:index.
+timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF).
-	    p := blocksAndProcessesToEvaluate at:index+1.
+block := blocksAndProcessesToEvaluate at:index.
-	    (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+p := blocksAndProcessesToEvaluate at:index+1.
-		block value
+(p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
-	    ] ifFalse:[
+"/ 'irq*: ' infoPrint. block infoPrintCR.
-		p isDead ifTrue:[
+block value
-		    "/ a timedBlock for a process which has already terminated
+] ifFalse:[
-		    "/ issue a warning and do not execute it.
+p isDead ifTrue:[
-		    "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+"/ see comment above
-		    "/  and thereby could block the whole smalltalk system.
+('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
-		    "/  For this reason is it IGNORED here.)
+('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
-"/ Could handle it in timeoutProcess, but we don't,
+] ifFalse:[
-"/ because otherwise timeouts might be reissued forever...
+p interruptWith:block.
-"/                    (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
+"/ 'irq: ' infoPrint. block infoPrintCR.
-"/                        timeoutHandlerProcess interruptWith:block.
+]
-"/                    ] ifFalse:[
+]
-			('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+]
-			('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
-"/                    ].
-		] ifFalse:[
-		    p interruptWith:block
-		]
-	    ]
-	]
 ].
 "Modified: / 30-07-2013 / 19:33:24 / cg"
 !
 |index "{ Class: SmallInteger }"
 wasBlocked|
 index := anID.
 (anID notNil and:[index > 0]) ifTrue:[
-wasBlocked := OperatingSystem blockInterrupts.
+	wasBlocked := OperatingSystem blockInterrupts.
-(aBlockOrSemaphore notNil
+	(aBlockOrSemaphore notNil
-and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore
+	  and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore
-and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[
+	  and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[
-'Processor: trying to remove stale timeout id - ignored' errorPrintCR.
+	    'Processor: trying to remove stale timeout id - ignored' errorPrintCR.
-] ifFalse:[
+	] ifFalse:[
-timeoutArray at:index put:nil.
+	    timeoutArray at:index put:nil.
-timeoutActionArray at:index put:nil.
+	    timeoutActionArray at:index put:nil.
-timeoutSemaphoreArray at:index put:nil.
+	    timeoutSemaphoreArray at:index put:nil.
-timeoutProcessArray at:index put:nil.
+	    timeoutProcessArray at:index put:nil.
-].
+	].
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ]
 !
 timeoutHandlerProcess
 (timeoutHandlerProcess isNil or:[timeoutHandlerProcess isDead]) ifTrue:[
 "Modified: / 20-07-2006 / 09:52:27 / cg"
 !
 timeoutHandlerProcessLoop
 "The timeoutHandlerProcess does nothing but wait.
-It exists only, so that timeout blocks may be executed in its context."
+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 it's interrupt handler)."
 [
-	[
+[
-	    (Semaphore new name:'timeoutHandler') wait.
+(Semaphore new name:'timeoutHandler') wait.
-	] on:Exception do:[:ex|
+] on:Exception do:[:ex|
-	    "ignore errors, but tell the user"
+"ignore errors, but tell the user"
-	    InfoPrinting == true ifTrue:[
+InfoPrinting == true ifTrue:[
-		('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
+('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
-		thisContext fullPrintAll.
+thisContext fullPrintAll.
-	    ].
+].
-	].
+].
 ] loop.
 ! !
 !ProcessorScheduler methodsFor:'wait hooks'!
 wasBlocked := OperatingSystem unblockInterrupts.
 newProcessMaybeReady := false.
 readableResultFdArray size < readFdArray size ifTrue:[
-readableResultFdArray := Array new:(40 max:readFdArray size).
+	readableResultFdArray := Array new:(40 max:readFdArray size).
 ].
 writableResultFdArray size < writeFdArray size ifTrue:[
-writableResultFdArray := Array new:(40 max:writeFdArray size).
+	writableResultFdArray := Array new:(40 max:writeFdArray size).
 ].
 exceptArray := exceptFdArray.
 OperatingSystem isMSWINDOWSlike ifTrue:[
-"/
+	"/
-"/ win32 does a WaitForMultipleObjects in select...
+	"/ win32 does a WaitForMultipleObjects in select...
-"/ unix waits for SIGCHLD
+	"/ unix waits for SIGCHLD
-"/
+	"/
-|hasPids|
+	|hasPids|
-hasPids := false.
+	hasPids := false.
-osChildExitActions keysDo:[:eachPid|
+	osChildExitActions keysDo:[:eachPid|
-eachPid address = 0 ifTrue:[
+	    eachPid address = 0 ifTrue:[
-'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR.
+		'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR.
-osChildExitActions safeRemoveKey:eachPid.
+		osChildExitActions safeRemoveKey:eachPid.
-] ifFalse:[
+	    ] ifFalse:[
-hasPids := true.
+		hasPids := true.
-].
+	    ].
-].
+	].
-hasPids ifTrue:[
+	hasPids ifTrue:[
-exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
+	    exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
 "/'exceptArray: ' print. exceptArray printCR.
-].
+	].
 ].
 exceptResultFdArray size < exceptArray size ifTrue:[
-exceptResultFdArray := Array new:(40 max:exceptArray size).
+	exceptResultFdArray := Array new:(40 max:exceptArray size).
 ].
 nReady := OperatingSystem
-selectOnAnyReadable:readFdArray
+		selectOnAnyReadable:readFdArray
-writable:writeFdArray
+		writable:writeFdArray
-exception:exceptArray
+		exception:exceptArray
-readableInto:readableResultFdArray
+		readableInto:readableResultFdArray
-writableInto:writableResultFdArray
+		writableInto:writableResultFdArray
-exceptionInto:exceptResultFdArray
+		exceptionInto:exceptResultFdArray
-withTimeOut:millis.
+		withTimeOut:millis.
 wasBlocked ifTrue:[
-OperatingSystem blockInterrupts.
+	OperatingSystem blockInterrupts.
 ].
 nReady <= 0 ifTrue:[
-"/ either still nothing to do,
+	"/ either still nothing to do,
-"/ or error (which should not happen)
+	"/ or error (which should not happen)
-(nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[
+	(nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[
-err == #EBADF ifTrue:[
+	    err == #EBADF ifTrue:[
-"/ mhmh - one of the fd's given to me is corrupt.
+		"/ mhmh - one of the fd's given to me is corrupt.
-"/ find out which one .... and remove it
+		"/ find out which one .... and remove it
-self removeCorruptedFds
+		self removeCorruptedFds
-] ifFalse:[
+	    ] ifFalse:[
-err == #ENOENT ifTrue:[
+		err == #ENOENT ifTrue:[
-'Processor [warning]: ENOENT in select; rd=' infoPrint.
+		    'Processor [warning]: ENOENT in select; rd=' infoPrint.
-readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR.
+		    readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR.
-] ifFalse:[
+		] ifFalse:[
-'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
+		    'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
-]
+		]
-].
+	    ].
-]
+	]
 ] ifFalse:[
-readyIndex := 1.
+	readyIndex := 1.
-[nReady > 0
+	[nReady > 0
-and:[ readyIndex <= readableResultFdArray size
+	     and:[ readyIndex <= readableResultFdArray size
-and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]
+	     and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]
-] whileTrue:[
+	] whileTrue:[
-index := readFdArray identityIndexOf:fd.
+	    index := readFdArray identityIndexOf:fd.
-index ~~ 0 ifTrue:[
+	    index ~~ 0 ifTrue:[
-action := readCheckArray at:index.
+		action := readCheckArray at:index.
-sema := readSemaphoreArray at:index.
+		sema := readSemaphoreArray at:index.
-sema notNil ifTrue:[
+		sema notNil ifTrue:[
-sema signalOnce.
+		    sema signalOnce.
-newProcessMaybeReady := true.
+		    newProcessMaybeReady := true.
-action isNil ifTrue:[
+		    action isNil ifTrue:[
-"before May 2014 we disabled the sema in the caller after wakeup.
+			"before May 2014 we disabled the sema in the caller after wakeup.
-This caused ST/X to consume 100% cpu, when the caller didn't read
+			 This caused ST/X to consume 100% cpu, when the caller didn't read
-the data (e.g. because his process was stopped)."
+			 the data (e.g. because his process was stopped)."
-"disable possible write side and timeouts as well"
+			"disable possible write side and timeouts as well"
-self disableSemaphore:sema.
+			self disableSemaphore:sema.
-].
+		    ].
-].
+		].
-(action notNil and:[action value]) ifTrue:[
+		(action notNil and:[action value]) ifTrue:[
-newProcessMaybeReady := true.
+		    newProcessMaybeReady := true.
-].
+		].
-].
+	    ].
-nReady := nReady - 1.
+	    nReady := nReady - 1.
-readyIndex := readyIndex + 1.
+	    readyIndex := readyIndex + 1.
-].
+	].
-readyIndex := 1.
+	readyIndex := 1.
-[nReady > 0
+	[nReady > 0
-and:[ readyIndex <= writableResultFdArray size
+	     and:[ readyIndex <= writableResultFdArray size
-and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]
+	     and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]
-] whileTrue:[
+	] whileTrue:[
-index := writeFdArray identityIndexOf:fd.
+	    index := writeFdArray identityIndexOf:fd.
-index ~~ 0 ifTrue:[
+	    index ~~ 0 ifTrue:[
-action := writeCheckArray at:index.
+		action := writeCheckArray at:index.
-sema := writeSemaphoreArray at:index.
+		sema := writeSemaphoreArray at:index.
-sema notNil ifTrue:[
+		sema notNil ifTrue:[
-sema signalOnce.
+		    sema signalOnce.
-newProcessMaybeReady := true.
+		    newProcessMaybeReady := true.
-action isNil ifTrue:[
+		    action isNil ifTrue:[
-"now this is a one shot operation - see the input above"
+			"now this is a one shot operation - see the input above"
-"disable possible read side and timeouts as well"
+			"disable possible read side and timeouts as well"
-self disableSemaphore:sema.
+			self disableSemaphore:sema.
-].
+		    ].
-].
+		].
-(action notNil and:[action value]) ifTrue:[
+		(action notNil and:[action value]) ifTrue:[
-newProcessMaybeReady := true.
+		    newProcessMaybeReady := true.
-].
+		].
-].
+	    ].
-nReady := nReady - 1.
+	    nReady := nReady - 1.
-readyIndex := readyIndex + 1.
+	    readyIndex := readyIndex + 1.
-].
+	].
 "/'except result got: ' print. exceptArray printCR. exceptResultFdArray printCR.
-readyIndex := 1.
+	readyIndex := 1.
-[nReady > 0
+	[nReady > 0
-and:[ readyIndex <= exceptResultFdArray size
+	     and:[ readyIndex <= exceptResultFdArray size
-and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
+	     and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
-] whileTrue:[
+	] whileTrue:[
 "/'except got: ' print. fdOrPid printCR.
-index := exceptFdArray identityIndexOf:fdOrPid.
+	    index := exceptFdArray identityIndexOf:fdOrPid.
-index ~~ 0 ifTrue:[
+	    index ~~ 0 ifTrue:[
-sema := exceptSemaphoreArray at:index.
+		sema := exceptSemaphoreArray at:index.
-sema notNil ifTrue:[
+		sema notNil ifTrue:[
-sema signalOnce.
+		    sema signalOnce.
-newProcessMaybeReady := true.
+		    newProcessMaybeReady := true.
-"disable possible read/write side and timeouts as well"
+		    "disable possible read/write side and timeouts as well"
-self disableSemaphore:sema.
+		    self disableSemaphore:sema.
-].
+		].
-] ifFalse:[ "may be a PID?"
+	    ] ifFalse:[ "may be a PID?"
-|osProcessStatus actionBlock|
+		|osProcessStatus actionBlock|
-actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
+		actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
 "/'pid signaled: ' print. fdOrPid printCR.
-actionBlock notNil ifTrue:[
+		actionBlock notNil ifTrue:[
-osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
+		    osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
-(osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
+		    (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
-actionBlock value:osProcessStatus.
+			actionBlock value:osProcessStatus.
-newProcessMaybeReady := true.
+			newProcessMaybeReady := true.
-].
+		    ].
-].
+		].
-].
+	    ].
-nReady := nReady - 1.
+	    nReady := nReady - 1.
-readyIndex := readyIndex + 1.
+	    readyIndex := readyIndex + 1.
-].
+	].
 ].
 ^ newProcessMaybeReady
 "Modified: / 12-04-1996 / 09:31:22 / stefan"
 "Modified: / 07-12-2006 / 19:48:17 / cg"
 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:[
-	interruptedProcess := activeProcess.
+interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
-	self threadSwitch:scheduler
+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.
+	^ self anyUserProcessAtAll not.
 ].
 ^ false
 "/    |anySema|
 "/
 "/
 "/    anyTimeouts ifFalse:[
 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.
-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.
-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.
-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:[
-	interruptedProcess := activeProcess.
+interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
-	self threadSwitch:scheduler
+interruptedProcess := activeProcess.
+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:[
-	interruptedProcess := activeProcess.
+interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
-	self threadSwitch:scheduler
+interruptedProcess := activeProcess.
+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:[
+	self noMoreUserProcesses ifTrue:[
-dispatching := false.
+	    dispatching := false.
-^ self
+	    ^ 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"

changeset 19850	c30c21be7440
parent 19083	504ff3f2cfa0
child 19853	b5615ba2f049