ProcessorScheduler.st
changeset 22146 0a52bd3e639a
parent 22095 d7d5b3f3cc88
child 22153 b12f00ae6f4b
--- 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