--- a/ProcessorScheduler.st Tue Aug 01 15:36:09 2017 +0200
+++ b/ProcessorScheduler.st Tue Aug 01 17:41:04 2017 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -14,26 +16,26 @@
"{ NameSpace: Smalltalk }"
Object subclass:#ProcessorScheduler
- instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
- activeProcessId currentPriority readFdArray readSemaphoreArray
- readCheckArray writeFdArray writeSemaphoreArray writeCheckArray
- timeoutArray timeoutActionArray timeoutProcessArray
- timeoutSemaphoreArray idleActions anyTimeouts dispatching
- interruptedProcess useIOInterrupts gotIOInterrupt
- osChildExitActions gotChildSignalInterrupt
- exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
- supportDynamicPriorities timeSliceNeededSemaphore
- scheduledProcesses preWaitActions timeoutHandlerProcess
- readableResultFdArray writableResultFdArray exceptFdArray
- exceptResultFdArray exceptSemaphoreArray interruptCounter
- timedActionCounter'
- classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
- UserSchedulingPriority UserInterruptPriority TimingPriority
- HighestPriority SchedulingPriority MaxNumberOfProcesses
- InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
- EventPollingInterval MaxProcessId'
- poolDictionaries:''
- category:'Kernel-Processes'
+ instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
+ activeProcessId currentPriority readFdArray readSemaphoreArray
+ readCheckArray writeFdArray writeSemaphoreArray writeCheckArray
+ timeoutArray timeoutActionArray timeoutProcessArray
+ timeoutSemaphoreArray idleActions anyTimeouts dispatching
+ interruptedProcess useIOInterrupts gotIOInterrupt
+ osChildExitActions gotChildSignalInterrupt
+ exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
+ supportDynamicPriorities timeSliceNeededSemaphore
+ scheduledProcesses preWaitActions timeoutHandlerProcess
+ readableResultFdArray writableResultFdArray exceptFdArray
+ exceptResultFdArray exceptSemaphoreArray interruptCounter
+ timedActionCounter'
+ classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
+ UserSchedulingPriority UserInterruptPriority TimingPriority
+ HighestPriority SchedulingPriority MaxNumberOfProcesses
+ InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
+ EventPollingInterval MaxProcessId'
+ poolDictionaries:''
+ category:'Kernel-Processes'
!
!ProcessorScheduler class methodsFor:'documentation'!
@@ -1608,14 +1610,13 @@
A user process has a non-zero processGroup.
Should be called with interrupts blocked."
- |listArray l prio "{ Class: SmallInteger }"|
+ |listArray l prio "{ Class: SmallInteger }" checkSemaBlock checkProcessBlock|
prio := HighestPriority.
-
listArray := quiescentProcessLists.
- [prio >= 1] whileTrue:[
- l := listArray at:prio.
+ prio to:1 by:-1 do:[:pri|
+ l := listArray at:pri.
l notNil ifTrue:[
l linksDo:[:aProcess |
aProcess isUserProcess ifTrue:[
@@ -1624,37 +1625,40 @@
]
]
].
- prio := prio - 1
].
+ checkProcessBlock := [:p | p notNil and:[p isUserProcess and:[p isDead not]]].
+
(scheduledProcesses notNil
- and:[scheduledProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]) ifTrue:[
+ and:[scheduledProcesses contains:checkProcessBlock]) ifTrue:[
"/ 'anyUserProcess: found scheduled ' _errorPrint.
"/ (scheduledProcesses detect:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]) asString _errorPrintCR.
^ true.
- ].
+ ].
+
+ checkSemaBlock := [:sema |
+ sema notNil
+ and:[sema waitingProcesses contains:checkProcessBlock]
+ ].
"/ any user process waiting on a sema?
- (readSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
- ) ifTrue:[
+ (readSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on read sema' _errorPrintCR.
^ true.
].
- (writeSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
- ) ifTrue:[
+ (writeSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on write sema' _errorPrintCR.
^ true.
].
- (timeoutSemaphoreArray contains:[:sema |
- sema notNil and:[sema waitingProcesses contains:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]]]
- ) ifTrue:[
+ (timeoutSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on timeout sema' _errorPrintCR.
^ true.
].
- (timeoutProcessArray contains:[:p | p notNil and:[p isUserProcess] ]
- ) ifTrue:[
+ (exceptSemaphoreArray contains:checkSemaBlock) ifTrue:[
+ "/ 'anyUserProcess: found on except sema' _errorPrintCR.
+ ^ true.
+ ].
+ (timeoutProcessArray contains:checkProcessBlock) ifTrue:[
^ true.
].
@@ -1664,7 +1668,8 @@
Processor anyUserProcessAtAll
"
- "Modified: 29.7.1996 / 11:49:17 / cg"
+ "Modified: / 29-07-1996 / 11:49:17 / cg"
+ "Modified: / 01-08-2017 / 17:38:35 / stefan"
!
highestPriorityRunnableProcess
@@ -1677,8 +1682,8 @@
wasBlocked := OperatingSystem blockInterrupts.
listArray := quiescentProcessLists.
- [prio >= 1] whileTrue:[
- l := listArray at:prio.
+ prio to:1 by:-1 do:[:pri|
+ l := listArray at:pri.
l notNil ifTrue:[
l notEmpty ifTrue:[
p := l firstLink.
@@ -1694,12 +1699,12 @@
^ p
]
].
- prio := prio - 1
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ nil
- "Modified: 12.2.1997 / 12:41:49 / cg"
+ "Modified: / 12-02-1997 / 12:41:49 / cg"
+ "Modified: / 01-08-2017 / 14:20:11 / stefan"
!
isDispatching
@@ -2152,8 +2157,8 @@
self unRemember:aProcess.
zombie := id.
-
self checkForEndOfDispatch.
+
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
self threadSwitch:scheduler.
"not reached"
@@ -2166,9 +2171,9 @@
self checkForEndOfDispatch.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- "Modified: / 23-09-1996 / 13:50:24 / stefan"
"Modified: / 20-03-1997 / 16:03:39 / cg"
"Modified (comment): / 10-08-2011 / 19:57:08 / cg"
+ "Modified: / 01-08-2017 / 17:29:00 / stefan"
!
yield
@@ -3462,15 +3467,16 @@
'Processor [info]: end of dispatch' infoPrintCR.
].
dispatching := false.
- "/ false ifTrue:[
- "/ MiniInspector basicNew printInstVarsOf:self.
- "/ MiniDebugger enter:thisContext withMessage:'about to exit' mayProceed:true.
- "/ ].
+"/ MiniInspector basicNew printInstVarsOf:self.
+"/ quiescentProcessLists infoPrintCR.
+"/ MiniDebugger enter:thisContext withMessage:'about to exit' mayProceed:true.
].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
+
+ "Modified: / 01-08-2017 / 17:16:54 / stefan"
!
checkForIOWithTimeout:millis