--- a/ProcessorScheduler.st Mon May 16 12:23:40 2016 +0200
+++ b/ProcessorScheduler.st Mon May 16 12:36:31 2016 +0200
@@ -25,7 +25,8 @@
supportDynamicPriorities timeSliceNeededSemaphore
scheduledProcesses preWaitActions timeoutHandlerProcess
readableResultFdArray writableResultFdArray exceptFdArray
- exceptResultFdArray exceptSemaphoreArray'
+ exceptResultFdArray exceptSemaphoreArray interruptCounter
+ timedActionCounter'
classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
UserSchedulingPriority UserInterruptPriority TimingPriority
HighestPriority SchedulingPriority MaxNumberOfProcesses
@@ -577,6 +578,16 @@
"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"
@@ -593,6 +604,16 @@
"return the scheduling process"
^ scheduler
+!
+
+timedActionCounter
+ "for statistics: counts the overall number of timer actions"
+
+ ^ timedActionCounter
+
+ "
+ Processor timedActionCounter
+ "
! !
!ProcessorScheduler methodsFor:'background processing'!
@@ -646,7 +667,7 @@
handle all timeout actions
"
anyTimeouts ifTrue:[
- self evaluateTimeouts
+ self evaluateTimeouts
].
"first do a quick check for semaphores using checkActions - this is needed for
@@ -658,40 +679,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.
@@ -722,13 +743,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
+ ]
+ ]
].
"
@@ -741,38 +762,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
].
"
@@ -784,17 +805,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
@@ -802,8 +823,8 @@
OperatingSystem unblockInterrupts.
(gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
- gotIOInterrupt := false.
- self checkForIOWithTimeout:0.
+ gotIOInterrupt := false.
+ self checkForIOWithTimeout:0.
].
wasBlocked ifTrue:[OperatingSystem blockInterrupts].
@@ -891,9 +912,9 @@
p l|
KnownProcesses isNil ifTrue:[
- KnownProcesses := WeakArray new:30.
- KnownProcesses addDependent:self class.
- KnownProcessIds := OrderedCollection new:30.
+ KnownProcesses := WeakArray new:30.
+ KnownProcesses addDependent:self class.
+ KnownProcessIds := OrderedCollection new:30.
].
"
@@ -922,10 +943,11 @@
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 ?
].
"
@@ -937,10 +959,10 @@
currentPriority := SchedulingPriority.
p := Process basicNew.
p
- setId:0 state:#run;
- setPriority:currentPriority;
- name:'scheduler';
- beSystemProcess.
+ setId:0 state:#run;
+ setPriority:currentPriority;
+ name:'scheduler';
+ beSystemProcess.
scheduler := activeProcess := p.
activeProcessId := 0.
@@ -953,8 +975,8 @@
"
useIOInterrupts ifTrue:[ObjectMemory ioInterruptHandler:self].
ObjectMemory
- timerInterruptHandler:self;
- childSignalInterruptHandler:self.
+ timerInterruptHandler:self;
+ childSignalInterruptHandler:self.
"Modified: / 7.1.1997 / 16:48:26 / stefan"
"Modified: / 4.2.1999 / 13:08:39 / cg"
@@ -1018,44 +1040,44 @@
|index pri aProcess l|
OperatingSystem interruptsBlocked ifFalse:[
- MiniDebugger
- enterWithMessage:'vmResumeInterrupt with no interruptsBlocked'
- mayProceed:true.
+ MiniDebugger
+ enterWithMessage:'vmResumeInterrupt with no interruptsBlocked'
+ mayProceed:true.
].
index := KnownProcessIds identityIndexOf:id.
index ~~ 0 ifTrue:[
- aProcess := KnownProcesses at:index.
- pri := aProcess priority.
- l := quiescentProcessLists at:pri.
- l notNil ifTrue:[
- (l includesIdentical:aProcess) ifTrue:[
- "/ aProcess is on a run queue.
- "/ CG: this situation may happen, if the wrapCall
- "/ finishes before the process was layed to sleep
- "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished).
- "/ In that case, simply resume it and everything is OK.
- "/ If the process is state running, ignore.
-
- |state|
-
- state := aProcess state.
- (state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[
- aProcess state:#run.
- ].
- 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint.
- aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR.
- ^ self
- ]
- ] ifFalse:[
- l := LinkedList new.
- quiescentProcessLists at:pri put:l.
- ].
- l addLast:aProcess.
- aProcess state:#run.
+ aProcess := KnownProcesses at:index.
+ pri := aProcess priority.
+ l := quiescentProcessLists at:pri.
+ l notNil ifTrue:[
+ (l includesIdentical:aProcess) ifTrue:[
+ "/ aProcess is on a run queue.
+ "/ CG: this situation may happen, if the wrapCall
+ "/ finishes before the process was layed to sleep
+ "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished).
+ "/ In that case, simply resume it and everything is OK.
+ "/ If the process is state running, ignore.
+
+ |state|
+
+ state := aProcess state.
+ (state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[
+ aProcess state:#run.
+ ].
+ 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint.
+ aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR.
+ ^ self
+ ]
+ ] ifFalse:[
+ l := LinkedList new.
+ quiescentProcessLists at:pri put:l.
+ ].
+ l addLast:aProcess.
+ aProcess state:#run.
] ifFalse:[
- 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint.
- id infoPrintCR.
+ 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint.
+ id infoPrintCR.
]
"Modified: / 28.9.1998 / 11:36:53 / cg"
@@ -1111,8 +1133,9 @@
gotChildSignalInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 12.4.1996 / 10:12:18 / stefan"
@@ -1542,41 +1565,41 @@
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:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ true.
+ ]
+ ]
+ ].
+ 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] ]]]
+ (readSemaphoreArray contains:[:sema |
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ true.
].
- (writeSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ (writeSemaphoreArray contains:[:sema |
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ true.
].
- (timeoutSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
+ (timeoutSemaphoreArray contains:[:sema |
+ sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess] ]]]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ true.
].
(timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ]
) ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ true.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2323,43 +2346,43 @@
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.
- readCheckArray at:idx put:nil.
- (sema := readSemaphoreArray at:idx) notNil ifTrue:[
- readSemaphoreArray at:idx put:nil.
- doSignal ifTrue:[
- sema signalForAll.
- ].
- ].
- idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ 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.
+ ].
+ ].
+ idx := readFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
].
idx := writeFdArray identityIndexOf: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.
- ].
- ].
- idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ 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.
+ ].
+ ].
+ idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
].
idx := exceptFdArray identityIndexOf: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.
- ].
- ].
- idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
+ exceptFdArray at:idx put:nil.
+ (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
+ exceptSemaphoreArray at:idx put:nil.
+ doSignal ifTrue:[
+ sema signalForAll.
+ ].
+ ].
+ idx := exceptFdArray identityIndexOf:aFileDescriptor startingAt:idx+1.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
@@ -2373,43 +2396,43 @@
wasBlocked := OperatingSystem blockInterrupts.
idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt: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.
- idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+ 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 := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
].
idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt: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.
- idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+ 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 := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
].
idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
[idx ~~ 0] whileTrue:[
- timeoutArray at:idx put:nil.
- timeoutSemaphoreArray at:idx put:nil.
- timeoutActionArray at:idx put:nil.
- timeoutProcessArray at:idx put:nil.
- idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+ timeoutArray at:idx put:nil.
+ timeoutSemaphoreArray at:idx put:nil.
+ timeoutActionArray at:idx put:nil.
+ timeoutProcessArray at:idx put:nil.
+ idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
].
idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
[idx ~~ 0] whileTrue:[
- exceptFdArray at:idx put:nil.
- exceptSemaphoreArray at:idx put:nil.
- idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+ exceptFdArray at:idx put:nil.
+ exceptSemaphoreArray at:idx put:nil.
+ idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2506,30 +2529,30 @@
aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil"
aFileDescriptor isNil ifTrue:[
- idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil.
- idx == 0 ifTrue:[
- "aSemaphore is not registered yet, have to create a new slot"
- exceptFdArray := exceptFdArray copyWith:nil.
- exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
- ] ifFalse:[
- slot := exceptSemaphoreArray at:idx.
- slot isNil ifTrue:[
- exceptSemaphoreArray at:idx put:aSemaphore.
- ]
- ]
+ idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil.
+ idx == 0 ifTrue:[
+ "aSemaphore is not registered yet, have to create a new slot"
+ exceptFdArray := exceptFdArray copyWith:nil.
+ exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
+ ] ifFalse:[
+ slot := exceptSemaphoreArray at:idx.
+ slot isNil ifTrue:[
+ exceptSemaphoreArray at:idx put:aSemaphore.
+ ]
+ ]
] ifFalse:[
- idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil.
- idx == 0 ifTrue:[
- "aFileDescriptor is not registered yet, have to create a new slot"
- exceptFdArray := exceptFdArray copyWith:aFileDescriptor.
- exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
- ] ifFalse:[
- slot := exceptFdArray at:idx.
- slot isNil ifTrue:[
- exceptFdArray at:idx put:aFileDescriptor.
- exceptSemaphoreArray at:idx put:aSemaphore.
- ].
- ].
+ idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil.
+ idx == 0 ifTrue:[
+ "aFileDescriptor is not registered yet, have to create a new slot"
+ exceptFdArray := exceptFdArray copyWith:aFileDescriptor.
+ exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
+ ] ifFalse:[
+ slot := exceptFdArray at:idx.
+ slot isNil ifTrue:[
+ exceptFdArray at:idx put:aFileDescriptor.
+ exceptSemaphoreArray at:idx put:aSemaphore.
+ ].
+ ].
"/ (useIOInterrupts and:[slot isNil]) ifTrue:[
"/ OperatingSystem enableIOInterruptsOn:aFileDescriptor
"/ ].
@@ -2995,7 +3018,6 @@
halfSize "{ Class: SmallInteger }"
wasBlocked p|
-
anyTimeouts ifFalse:[ ^ self].
anyTimeouts := false.
@@ -3013,110 +3035,109 @@
now := OperatingSystem getMillisecondTime.
n := timeoutArray size.
1 to:n do:[:index |
- aTime := timeoutArray at:index.
- aTime notNil ifTrue:[
- (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[
- "this one should be triggered"
-
- sema := timeoutSemaphoreArray at:index.
- sema notNil ifTrue:[
- timeoutSemaphoreArray at:index put:nil.
- sema signalOnce.
- ] ifFalse:[
- "to support pure-events"
- block := timeoutActionArray at:index.
- block notNil ifTrue:[
- firstBlockToEvaluate isNil ifTrue:[
- firstBlockToEvaluate := block.
- firstProcess := timeoutProcessArray at:index.
- ] ifFalse:[
- blocksAndProcessesToEvaluate isNil ifTrue:[
- blocksAndProcessesToEvaluate := OrderedCollection
- with:firstBlockToEvaluate
- with:firstProcess.
- ].
- blocksAndProcessesToEvaluate add:block.
- blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
- ].
- timeoutActionArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
- ]
- ].
- timeoutArray at:index put:nil.
- ] ifFalse:[
- "there are still pending timeouts"
- anyTimeouts := true.
- indexOfLastTimeout := index.
- ]
- ]
+ aTime := timeoutArray at:index.
+ aTime notNil ifTrue:[
+ (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[
+ "this one should be triggered"
+
+ sema := timeoutSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ timeoutSemaphoreArray at:index put:nil.
+ timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF).
+ sema signalOnce.
+ ] ifFalse:[
+ "to support pure-events"
+ block := timeoutActionArray at:index.
+ block notNil ifTrue:[
+ "/ usually (>99%), there is only one single timeout action to call;
+ "/ avoid creation of an OrderedCollection
+ firstBlockToEvaluate isNil ifTrue:[
+ firstBlockToEvaluate := block.
+ firstProcess := timeoutProcessArray at:index.
+ ] ifFalse:[
+ blocksAndProcessesToEvaluate isNil ifTrue:[
+ blocksAndProcessesToEvaluate := OrderedCollection
+ with:firstBlockToEvaluate
+ with:firstProcess.
+ ].
+ blocksAndProcessesToEvaluate add:block.
+ blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
+ ].
+ timeoutActionArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
+ ]
+ ].
+ timeoutArray at:index put:nil.
+ ] ifFalse:[
+ "there are still pending timeouts"
+ anyTimeouts := true.
+ indexOfLastTimeout := index.
+ ]
+ ]
].
"shrink the arrays, if they are 50% free"
n > 20 ifTrue:[
- halfSize := n // 2.
- indexOfLastTimeout < halfSize ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived
- timeoutArray := timeoutArray copyTo:halfSize.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
- timeoutActionArray := timeoutActionArray copyTo:halfSize.
- timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
- ].
- wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
- ].
+ halfSize := n // 2.
+ indexOfLastTimeout < halfSize ifTrue:[
+ wasBlocked := OperatingSystem blockInterrupts.
+ (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived
+ timeoutArray := timeoutArray copyTo:halfSize.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
+ timeoutActionArray := timeoutActionArray copyTo:halfSize.
+ timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
+ ].
+ 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:[
- (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
- firstBlockToEvaluate value
- ] ifFalse:[
- firstProcess isDead ifTrue:[
- "/ a timedBlock for a process which has already terminated
- "/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
- "/ and thereby could block the whole smalltalk system.
- "/ For this reason is it IGNORED here.)
+ firstBlockToEvaluate notNil ifTrue:[
+ timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF).
+ (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
+ firstBlockToEvaluate value
+ ] ifFalse:[
+ firstProcess isDead ifTrue:[
+ "/ a timedBlock for a process which has already terminated
+ "/ issue a warning and do not execute it.
+ "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+ "/ 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]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR.
+ ('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
"/ ].
- ] ifFalse:[
- firstProcess interruptWith:firstBlockToEvaluate
- ]
- ]
- ].
+ ] ifFalse:[
+ firstProcess interruptWith:firstBlockToEvaluate
+ ]
+ ]
+ ].
] ifFalse:[
- n := blocksAndProcessesToEvaluate size.
- 1 to:n by:2 do:[:index |
- block := blocksAndProcessesToEvaluate at:index.
- p := blocksAndProcessesToEvaluate at:index+1.
- (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
- block value
- ] ifFalse:[
- p isDead ifTrue:[
- "/ a timedBlock for a process which has already terminated
- "/ issue a warning and do not execute it.
- "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
- "/ 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: ''' , p name , '''') infoPrintCR.
- ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
-"/ ].
- ] ifFalse:[
- p interruptWith:block
- ]
- ]
- ]
+ n := blocksAndProcessesToEvaluate size.
+ 1 to:n by:2 do:[:index |
+ timedActionCounter := (timedActionCounter + 1 bitAnd:16r3FFFFFFF).
+ block := blocksAndProcessesToEvaluate at:index.
+ p := blocksAndProcessesToEvaluate at:index+1.
+ (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+ "/ 'irq*: ' infoPrint. block infoPrintCR.
+ block value
+ ] ifFalse:[
+ p isDead ifTrue:[
+ "/ see comment above
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+ ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+ ] ifFalse:[
+ p interruptWith:block.
+ "/ 'irq: ' infoPrint. block infoPrintCR.
+ ]
+ ]
+ ]
].
"Modified: / 30-07-2013 / 19:33:24 / cg"
@@ -3175,20 +3196,20 @@
index := anID.
(anID notNil and:[index > 0]) ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
-
- (aBlockOrSemaphore notNil
- and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore
- and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[
- 'Processor: trying to remove stale timeout id - ignored' errorPrintCR.
- ] ifFalse:[
- timeoutArray at:index put:nil.
- timeoutActionArray at:index put:nil.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
- ].
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ (aBlockOrSemaphore notNil
+ and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore
+ and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[
+ 'Processor: trying to remove stale timeout id - ignored' errorPrintCR.
+ ] ifFalse:[
+ timeoutArray at:index put:nil.
+ timeoutActionArray at:index put:nil.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
!
@@ -3216,18 +3237,20 @@
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.
- ] on:Exception do:[:ex|
- "ignore errors, but tell the user"
- InfoPrinting == true ifTrue:[
- ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
- thisContext fullPrintAll.
- ].
- ].
+ [
+ (Semaphore new name:'timeoutHandler') wait.
+ ] on:Exception do:[:ex|
+ "ignore errors, but tell the user"
+ InfoPrinting == true ifTrue:[
+ ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
+ thisContext fullPrintAll.
+ ].
+ ].
] loop.
! !
@@ -3279,158 +3302,158 @@
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...
- "/ unix waits for SIGCHLD
- "/
- |hasPids|
-
- hasPids := false.
- osChildExitActions keysDo:[:eachPid|
- eachPid address = 0 ifTrue:[
- 'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ] ifFalse:[
- hasPids := true.
- ].
- ].
- hasPids ifTrue:[
- exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ |hasPids|
+
+ hasPids := false.
+ osChildExitActions keysDo:[:eachPid|
+ eachPid address = 0 ifTrue:[
+ 'Processor: remove 0-handle pid: ' infoPrint. eachPid infoPrintCR.
+ osChildExitActions safeRemoveKey:eachPid.
+ ] ifFalse:[
+ hasPids := true.
+ ].
+ ].
+ hasPids ifTrue:[
+ 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
- writable:writeFdArray
- exception:exceptArray
- readableInto:readableResultFdArray
- writableInto:writableResultFdArray
- exceptionInto:exceptResultFdArray
- withTimeOut:millis.
+ selectOnAnyReadable:readFdArray
+ writable:writeFdArray
+ exception:exceptArray
+ readableInto:readableResultFdArray
+ writableInto:writableResultFdArray
+ exceptionInto:exceptResultFdArray
+ withTimeOut:millis.
wasBlocked ifTrue:[
- OperatingSystem blockInterrupts.
+ OperatingSystem blockInterrupts.
].
nReady <= 0 ifTrue:[
- "/ either still nothing to do,
- "/ or error (which should not happen)
-
- (nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[
- err == #EBADF ifTrue:[
- "/ mhmh - one of the fd's given to me is corrupt.
- "/ find out which one .... and remove it
- self removeCorruptedFds
- ] ifFalse:[
- err == #ENOENT ifTrue:[
- 'Processor [warning]: ENOENT in select; rd=' infoPrint.
- readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR.
- ] ifFalse:[
- 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
- ]
- ].
- ]
+ "/ either still nothing to do,
+ "/ or error (which should not happen)
+
+ (nReady < 0 and:[(err := OperatingSystem lastErrorSymbol) notNil]) ifTrue:[
+ err == #EBADF ifTrue:[
+ "/ mhmh - one of the fd's given to me is corrupt.
+ "/ find out which one .... and remove it
+ self removeCorruptedFds
+ ] ifFalse:[
+ err == #ENOENT ifTrue:[
+ 'Processor [warning]: ENOENT in select; rd=' infoPrint.
+ readFdArray infoPrint. ' wr=' infoPrint. writeFdArray infoPrintCR.
+ ] ifFalse:[
+ 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
+ ]
+ ].
+ ]
] ifFalse:[
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= readableResultFdArray size
- and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
- index := readFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- action := readCheckArray at:index.
- sema := readSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- action isNil ifTrue:[
- "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
- the data (e.g. because his process was stopped)."
- "disable possible write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- (action notNil and:[action value]) ifTrue:[
- newProcessMaybeReady := true.
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
-
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= writableResultFdArray size
- and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
- index := writeFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- action := writeCheckArray at:index.
- sema := writeSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- action isNil ifTrue:[
- "now this is a one shot operation - see the input above"
- "disable possible read side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- (action notNil and:[action value]) ifTrue:[
- newProcessMaybeReady := true.
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= readableResultFdArray size
+ and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
+ index := readFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ action := readCheckArray at:index.
+ sema := readSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ action isNil ifTrue:[
+ "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
+ the data (e.g. because his process was stopped)."
+ "disable possible write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ (action notNil and:[action value]) ifTrue:[
+ newProcessMaybeReady := true.
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
+
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= writableResultFdArray size
+ and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
+ index := writeFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ action := writeCheckArray at:index.
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ action isNil ifTrue:[
+ "now this is a one shot operation - see the input above"
+ "disable possible read side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ (action notNil and:[action value]) ifTrue:[
+ newProcessMaybeReady := true.
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
"/'except result got: ' print. exceptArray printCR. exceptResultFdArray printCR.
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= exceptResultFdArray size
- and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= exceptResultFdArray size
+ and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
"/'except got: ' print. fdOrPid printCR.
- index := exceptFdArray identityIndexOf:fdOrPid.
- index ~~ 0 ifTrue:[
- sema := exceptSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- "disable possible read/write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ] ifFalse:[ "may be a PID?"
- |osProcessStatus actionBlock|
-
- actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
+ index := exceptFdArray identityIndexOf:fdOrPid.
+ index ~~ 0 ifTrue:[
+ sema := exceptSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ "disable possible read/write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ] ifFalse:[ "may be a PID?"
+ |osProcessStatus actionBlock|
+
+ actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
"/'pid signaled: ' print. fdOrPid printCR.
- actionBlock notNil ifTrue:[
- osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
- (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
- actionBlock value:osProcessStatus.
- newProcessMaybeReady := true.
- ].
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
+ actionBlock notNil ifTrue:[
+ osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
+ (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
+ actionBlock value:osProcessStatus.
+ newProcessMaybeReady := true.
+ ].
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
].
^ newProcessMaybeReady
@@ -3449,15 +3472,16 @@
gotIOInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 21.12.1995 / 16:17:40 / stefan"
"Modified: 4.8.1997 / 14:23:08 / cg"
!
-noMoreUserProcesses
+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)
@@ -3465,8 +3489,8 @@
"/ and no writeSemaphores are present
anyTimeouts ifFalse:[
- ^ self anyUserProcessAtAll not.
- ].
+ ^ self anyUserProcessAtAll not.
+ ].
^ false
"/ |anySema|
"/
@@ -3500,88 +3524,88 @@
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.
- 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.
+ 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.
- 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.
+ 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.
- 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.
+ 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"
@@ -3593,8 +3617,9 @@
what to do now."
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
!
@@ -3644,8 +3669,9 @@
of whichever process is currently running."
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := (interruptCounter + 1 bitAnd:16r3FFFFFFF).
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 18.10.1996 / 20:35:54 / cg"
@@ -3662,80 +3688,80 @@
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
+
+ self noMoreUserProcesses ifTrue:[
+ dispatching := false.
+ ^ 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