in standAloneMode: exit dispatch if last process dies and no more sema/timer waits are pending
authorClaus Gittinger <cg@exept.de>
Sun, 11 Feb 1996 13:51:27 +0100
changeset 964 6d87e84d86ac
parent 963 fef0f2ed2709
child 965 3aae2f730ed1
in standAloneMode: exit dispatch if last process dies and no more sema/timer waits are pending
ProcSched.st
ProcessorScheduler.st
--- a/ProcSched.st	Sun Feb 11 13:49:43 1996 +0100
+++ b/ProcSched.st	Sun Feb 11 13:51:27 1996 +0100
@@ -18,7 +18,7 @@
 		writeFdArray writeSemaphoreArray timeoutArray timeoutActionArray
 		timeoutProcessArray timeoutSemaphoreArray idleActions anyTimeouts
 		dispatching interruptedProcess useIOInterrupts gotIOInterrupt
-		osChildExitActions'
+		osChildExitActions exitWhenNoMoreUserProcesses'
 	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
 		UserSchedulingPriority UserInterruptPriority TimingPriority
 		HighestPriority SchedulingPriority MaxNumberOfProcesses'
@@ -528,7 +528,7 @@
 
     p := self highestPriorityRunnableProcess.
     p isNil ifTrue:[
-	"no one runnable, hard wait for event or timeout"
+	"/ no one runnable, hard wait for event or timeout
 
 	self waitForEventOrTimeout.
 	^ self
@@ -639,7 +639,13 @@
     dispatching == true ifTrue:[^ self].
     dispatching := true.
 
+    "/ 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].
+
     handlerAction := [:ex |
 			'PROCESSOR: ignored signal' infoPrintNL.
 			ex return
@@ -653,10 +659,21 @@
     "/ I made this an extra call to dispatch; this allows recompilation
     "/  of the dispatch-handling code in the running system.
     "/
-    [true] whileTrue:[
+    [dispatching] whileTrue:[
 	ignoredSignals handle:handlerAction do:dispatchAction
-    ]
+    ].
+
+    "/ we arrive here in standalone Apps,
+    "/ when the last process at or above UserSchedulingPriority process died.
+    "/ regular ST/X stays in above loop forever
+
+    'PROCESSOR: finish dispatch (no more processes)' infoPrintNL.
+
     "Modified: 22.12.1995 / 23:12:51 / cg"
+!
+
+exitWhenNoMoreUserProcesses:aBoolean
+    exitWhenNoMoreUserProcesses := aBoolean
 ! !
 
 !ProcessorScheduler methodsFor:'os process handling'!
@@ -916,6 +933,7 @@
     timeoutProcessArray := Array with:nil.
     anyTimeouts := false.
     dispatching := false.
+    exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
     useIOInterrupts := OperatingSystem supportsIOInterrupts.
     gotIOInterrupt := false.
     osChildExitActions := Dictionary new.
@@ -1038,6 +1056,29 @@
     "
 !
 
+anyUserProcessAtAll
+    "return true, if there is any process (except myself)
+     running at above normal priority.
+     This is used to determine if we should stop scheduling
+     in standAlone application.
+     We ignore background processes to not keep the system from exiting
+     solely due to some background GC activity.
+     This means:
+	You MUST have at least one process running at or above
+        UserSchedulingPriority in a standAlone app."
+
+    |listArray l p prio "{ Class: SmallInteger }" |
+
+    prio := HighestPriority.
+    listArray := quiescentProcessLists.
+    [prio >= UserSchedulingPriority] whileTrue:[
+	l := listArray at:prio.
+	l notEmpty ifTrue:[^ true].
+        prio := prio - 1
+    ].
+    ^ false
+!
+
 highestPriorityRunnableProcess
     "return the highest prio runnable process"
 
@@ -1842,7 +1883,25 @@
 	]
     ].
 
-    "absolutely nothing to do - simply wait"
+    "/
+    "/ absolutely nothing to do - simply wait
+    "/
+    exitWhenNoMoreUserProcesses ifTrue:[
+	"/ check if there are any processes at all
+	"/ stop dispatching if there is none
+	"/ (and millis is nil, 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
+
+	millis isNil ifTrue:[
+	    readSemaphoreArray do:[:sema | sema notNil ifTrue:[^ self]].
+	    writeSemaphoreArray do:[:sema | sema notNil ifTrue:[^ self]].
+	    self anyUserProcessAtAll ifFalse:[
+		dispatching := false.
+		^ self
+	    ]
+	]
+    ].
 
     OperatingSystem supportsSelect ifFalse:[
 	"SCO instant ShitStation has a bug here,
@@ -1869,6 +1928,6 @@
 !ProcessorScheduler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.65 1996-01-06 00:22:02 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.66 1996-02-11 12:51:27 cg Exp $'
 ! !
 ProcessorScheduler initialize!
--- a/ProcessorScheduler.st	Sun Feb 11 13:49:43 1996 +0100
+++ b/ProcessorScheduler.st	Sun Feb 11 13:51:27 1996 +0100
@@ -18,7 +18,7 @@
 		writeFdArray writeSemaphoreArray timeoutArray timeoutActionArray
 		timeoutProcessArray timeoutSemaphoreArray idleActions anyTimeouts
 		dispatching interruptedProcess useIOInterrupts gotIOInterrupt
-		osChildExitActions'
+		osChildExitActions exitWhenNoMoreUserProcesses'
 	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
 		UserSchedulingPriority UserInterruptPriority TimingPriority
 		HighestPriority SchedulingPriority MaxNumberOfProcesses'
@@ -528,7 +528,7 @@
 
     p := self highestPriorityRunnableProcess.
     p isNil ifTrue:[
-	"no one runnable, hard wait for event or timeout"
+	"/ no one runnable, hard wait for event or timeout
 
 	self waitForEventOrTimeout.
 	^ self
@@ -639,7 +639,13 @@
     dispatching == true ifTrue:[^ self].
     dispatching := true.
 
+    "/ 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].
+
     handlerAction := [:ex |
 			'PROCESSOR: ignored signal' infoPrintNL.
 			ex return
@@ -653,10 +659,21 @@
     "/ I made this an extra call to dispatch; this allows recompilation
     "/  of the dispatch-handling code in the running system.
     "/
-    [true] whileTrue:[
+    [dispatching] whileTrue:[
 	ignoredSignals handle:handlerAction do:dispatchAction
-    ]
+    ].
+
+    "/ we arrive here in standalone Apps,
+    "/ when the last process at or above UserSchedulingPriority process died.
+    "/ regular ST/X stays in above loop forever
+
+    'PROCESSOR: finish dispatch (no more processes)' infoPrintNL.
+
     "Modified: 22.12.1995 / 23:12:51 / cg"
+!
+
+exitWhenNoMoreUserProcesses:aBoolean
+    exitWhenNoMoreUserProcesses := aBoolean
 ! !
 
 !ProcessorScheduler methodsFor:'os process handling'!
@@ -916,6 +933,7 @@
     timeoutProcessArray := Array with:nil.
     anyTimeouts := false.
     dispatching := false.
+    exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
     useIOInterrupts := OperatingSystem supportsIOInterrupts.
     gotIOInterrupt := false.
     osChildExitActions := Dictionary new.
@@ -1038,6 +1056,29 @@
     "
 !
 
+anyUserProcessAtAll
+    "return true, if there is any process (except myself)
+     running at above normal priority.
+     This is used to determine if we should stop scheduling
+     in standAlone application.
+     We ignore background processes to not keep the system from exiting
+     solely due to some background GC activity.
+     This means:
+	You MUST have at least one process running at or above
+        UserSchedulingPriority in a standAlone app."
+
+    |listArray l p prio "{ Class: SmallInteger }" |
+
+    prio := HighestPriority.
+    listArray := quiescentProcessLists.
+    [prio >= UserSchedulingPriority] whileTrue:[
+	l := listArray at:prio.
+	l notEmpty ifTrue:[^ true].
+        prio := prio - 1
+    ].
+    ^ false
+!
+
 highestPriorityRunnableProcess
     "return the highest prio runnable process"
 
@@ -1842,7 +1883,25 @@
 	]
     ].
 
-    "absolutely nothing to do - simply wait"
+    "/
+    "/ absolutely nothing to do - simply wait
+    "/
+    exitWhenNoMoreUserProcesses ifTrue:[
+	"/ check if there are any processes at all
+	"/ stop dispatching if there is none
+	"/ (and millis is nil, 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
+
+	millis isNil ifTrue:[
+	    readSemaphoreArray do:[:sema | sema notNil ifTrue:[^ self]].
+	    writeSemaphoreArray do:[:sema | sema notNil ifTrue:[^ self]].
+	    self anyUserProcessAtAll ifFalse:[
+		dispatching := false.
+		^ self
+	    ]
+	]
+    ].
 
     OperatingSystem supportsSelect ifFalse:[
 	"SCO instant ShitStation has a bug here,
@@ -1869,6 +1928,6 @@
 !ProcessorScheduler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.65 1996-01-06 00:22:02 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.66 1996-02-11 12:51:27 cg Exp $'
 ! !
 ProcessorScheduler initialize!