hg/stx-libbasic: comparison ProcessorScheduler.st

equal deleted inserted replaced

-:4960f76fcb24
+:9934d8542668
 "
 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.
 sockets and pipes (sigh)
 "
 any := false.
 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.
-	    ].
+].
-	    any := true.
+any := true.
-	]
+]
 ].
 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.
-	    ].
+].
-	    any := true.
+any := true.
-	]
+]
 ].
 "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 or timerInterrupt ... (running at max+1)
+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"
 "/ create the relevant blocks & signalSet outside of the
 "/ while-loop
 "/ (thanks to stefans objectAllocation monitor,
 "/  this safes a bit of memory allocation in the scheduler)
-dispatchAction := [self dispatch].
+dispatchAction := [ [dispatching] whileTrue:[ self dispatch ] ].
 handlerAction := [:ex |
 ('Processor [info]: ignored signal (', ex creator printString, ')') infoPrintCR.
 ex return
 ].
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 aFileDescriptor isNil ifTrue:[
-	(readCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
+(readCheckArray identityIndexOf:aSemaphore startingAt:1) == 0 ifTrue:[
-	    idx := readFdArray identityIndexOf:nil startingAt:1.
+idx := readFdArray identityIndexOf:nil startingAt:1.
-	    idx ~~ 0 ifTrue:[
+idx ~~ 0 ifTrue:[
-		readFdArray at:idx put:aFileDescriptor.
+readFdArray at:idx put:aFileDescriptor.
-		readSemaphoreArray at:idx put:aSemaphore.
+readSemaphoreArray at:idx put:aSemaphore.
-		readCheckArray at:idx put:aBlock
+readCheckArray at:idx put:aBlock
-	    ] ifFalse:[
+] ifFalse:[
-		readFdArray := readFdArray copyWith:nil.
+readFdArray := readFdArray copyWith:nil.
-		readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
-		readCheckArray := readCheckArray copyWith:aBlock.
+readCheckArray := readCheckArray copyWith:aBlock.
-	    ]
+]
-	]
+] ifFalse:[
+(readCheckArray at:idx) notNil ifTrue:[
+(readCheckArray at:idx) ~~ aBlock ifTrue:[
+'ouch - checkblock changed for read-check' infoPrintCR.
+readCheckArray at:idx put:aBlock.
+]
+].
+]
 ] ifFalse:[
-	(readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
+(readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
-	    idx := readFdArray identityIndexOf:nil startingAt:1.
+idx := readFdArray identityIndexOf:nil startingAt:1.
-	    idx ~~ 0 ifTrue:[
+idx ~~ 0 ifTrue:[
-		readFdArray at:idx put:aFileDescriptor.
+readFdArray at:idx put:aFileDescriptor.
-		readSemaphoreArray at:idx put:aSemaphore.
+readSemaphoreArray at:idx put:aSemaphore.
-		readCheckArray at:idx put:aBlock
+readCheckArray at:idx put:aBlock
-	    ] ifFalse:[
+] ifFalse:[
-		readFdArray := readFdArray copyWith:aFileDescriptor.
+readFdArray := readFdArray copyWith:aFileDescriptor.
-		readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
-		readCheckArray := readCheckArray copyWith:aBlock.
+readCheckArray := readCheckArray copyWith:aBlock.
-	    ].
+].
-	    useIOInterrupts ifTrue:[
+useIOInterrupts ifTrue:[
-		OperatingSystem enableIOInterruptsOn:aFileDescriptor
+OperatingSystem enableIOInterruptsOn:aFileDescriptor
-	    ].
+].
-	]
+] ifFalse:[
+(readSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[
+'ouch - sema changed for read-check' infoPrintCR.
+readSemaphoreArray at:idx put:aSemaphore.
+].
+(readCheckArray at:idx) ~~ aBlock ifTrue:[
+'ouch - checkblock changed for read-check' infoPrintCR.
+readCheckArray at:idx put:aBlock.
+].
+]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:20:45 / cg"
 !
 ! !
 !ProcessorScheduler class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.269 2013-06-17 21:18:07 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.270 2013-06-27 09:49:11 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.269 2013-06-17 21:18:07 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.270 2013-06-27 09:49:11 cg Exp $'
 ! !
 ProcessorScheduler initialize!

changeset 15438	9934d8542668
parent 15402	a40ba0a33cab
child 15473	4e282be80765
child 18070	d262e3aecaca