issue a warning if a timedBlock is to be evaluated for a dead thread
authorClaus Gittinger <cg@exept.de>
Thu, 29 Jan 1998 17:03:01 +0100
changeset 3245 863c0a09f5a2
parent 3244 9ba0abc1d217
child 3246 092deb605639
issue a warning if a timedBlock is to be evaluated for a dead thread
ProcSched.st
ProcessorScheduler.st
--- a/ProcSched.st	Thu Jan 29 14:28:19 1998 +0100
+++ b/ProcSched.st	Thu Jan 29 17:03:01 1998 +0100
@@ -10,8 +10,6 @@
  hereby transferred.
 "
 
-'From Smalltalk/X, Version:3.1.9 on 5-aug-1997 at 4:51:43 pm'                   !
-
 Object subclass:#ProcessorScheduler
 	instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
 		activeProcessId currentPriority readFdArray readSemaphoreArray
@@ -2230,48 +2228,55 @@
     n := timeoutArray size.
     anyTimeouts := false.
     1 to:n do:[:index |
-	aTime := timeoutArray at:index.
-	aTime notNil ifTrue:[
-	    (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
-		"this one should be triggered"
-
-		sema := timeoutSemaphoreArray at:index.
-		sema notNil ifTrue:[
-		    sema signalOnce.
-		    timeoutSemaphoreArray at:index put:nil
-		] ifFalse:[
-		    "to support pure-events"
-		    block := timeoutActionArray at:index.
-		    block notNil ifTrue:[
-			blocksToEvaluate isNil ifTrue:[
-			    blocksToEvaluate := OrderedCollection new:10.
-			    processes := OrderedCollection new:10.
-			].
-			blocksToEvaluate add:block.
-			processes add:(timeoutProcessArray at:index).
-			timeoutActionArray at:index put:nil.
-			timeoutProcessArray at:index put:nil.
-		    ]
-		].
-		timeoutArray at:index put:nil.
-	    ] ifTrue:[
-		anyTimeouts := true
-	    ]
-	]
+        aTime := timeoutArray at:index.
+        aTime notNil ifTrue:[
+            (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
+                "this one should be triggered"
+
+                sema := timeoutSemaphoreArray at:index.
+                sema notNil ifTrue:[
+                    sema signalOnce.
+                    timeoutSemaphoreArray at:index put:nil
+                ] ifFalse:[
+                    "to support pure-events"
+                    block := timeoutActionArray at:index.
+                    block notNil ifTrue:[
+                        blocksToEvaluate isNil ifTrue:[
+                            blocksToEvaluate := OrderedCollection new:10.
+                            processes := OrderedCollection new:10.
+                        ].
+                        blocksToEvaluate add:block.
+                        processes add:(timeoutProcessArray at:index).
+                        timeoutActionArray at:index put:nil.
+                        timeoutProcessArray at:index put:nil.
+                    ]
+                ].
+                timeoutArray at:index put:nil.
+            ] ifTrue:[
+                anyTimeouts := true
+            ]
+        ]
     ].
 
     blocksToEvaluate notNil ifTrue:[
-	blocksToEvaluate keysAndValuesDo:[:index :block |
-	    |p|
-
-	    p := processes at:index.
-	    (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
-		block value
-	    ] ifFalse:[
-		p interruptWith:block
-	    ]
-	]
+        blocksToEvaluate keysAndValuesDo:[:index :block |
+            |p|
+
+            p := processes at:index.
+            (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+                block value
+            ] ifFalse:[
+                p isDead ifTrue:[
+                    ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+                    ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+                ] ifFalse:[
+                    p interruptWith:block
+                ]
+            ]
+        ]
     ]
+
+    "Modified: / 29.1.1998 / 17:02:25 / cg"
 !
 
 removeTimedBlock:aBlock
@@ -2608,6 +2613,6 @@
 !ProcessorScheduler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.141 1997-11-20 18:29:40 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.142 1998-01-29 16:03:01 cg Exp $'
 ! !
 ProcessorScheduler initialize!
--- a/ProcessorScheduler.st	Thu Jan 29 14:28:19 1998 +0100
+++ b/ProcessorScheduler.st	Thu Jan 29 17:03:01 1998 +0100
@@ -10,8 +10,6 @@
  hereby transferred.
 "
 
-'From Smalltalk/X, Version:3.1.9 on 5-aug-1997 at 4:51:43 pm'                   !
-
 Object subclass:#ProcessorScheduler
 	instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
 		activeProcessId currentPriority readFdArray readSemaphoreArray
@@ -2230,48 +2228,55 @@
     n := timeoutArray size.
     anyTimeouts := false.
     1 to:n do:[:index |
-	aTime := timeoutArray at:index.
-	aTime notNil ifTrue:[
-	    (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
-		"this one should be triggered"
-
-		sema := timeoutSemaphoreArray at:index.
-		sema notNil ifTrue:[
-		    sema signalOnce.
-		    timeoutSemaphoreArray at:index put:nil
-		] ifFalse:[
-		    "to support pure-events"
-		    block := timeoutActionArray at:index.
-		    block notNil ifTrue:[
-			blocksToEvaluate isNil ifTrue:[
-			    blocksToEvaluate := OrderedCollection new:10.
-			    processes := OrderedCollection new:10.
-			].
-			blocksToEvaluate add:block.
-			processes add:(timeoutProcessArray at:index).
-			timeoutActionArray at:index put:nil.
-			timeoutProcessArray at:index put:nil.
-		    ]
-		].
-		timeoutArray at:index put:nil.
-	    ] ifTrue:[
-		anyTimeouts := true
-	    ]
-	]
+        aTime := timeoutArray at:index.
+        aTime notNil ifTrue:[
+            (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
+                "this one should be triggered"
+
+                sema := timeoutSemaphoreArray at:index.
+                sema notNil ifTrue:[
+                    sema signalOnce.
+                    timeoutSemaphoreArray at:index put:nil
+                ] ifFalse:[
+                    "to support pure-events"
+                    block := timeoutActionArray at:index.
+                    block notNil ifTrue:[
+                        blocksToEvaluate isNil ifTrue:[
+                            blocksToEvaluate := OrderedCollection new:10.
+                            processes := OrderedCollection new:10.
+                        ].
+                        blocksToEvaluate add:block.
+                        processes add:(timeoutProcessArray at:index).
+                        timeoutActionArray at:index put:nil.
+                        timeoutProcessArray at:index put:nil.
+                    ]
+                ].
+                timeoutArray at:index put:nil.
+            ] ifTrue:[
+                anyTimeouts := true
+            ]
+        ]
     ].
 
     blocksToEvaluate notNil ifTrue:[
-	blocksToEvaluate keysAndValuesDo:[:index :block |
-	    |p|
-
-	    p := processes at:index.
-	    (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
-		block value
-	    ] ifFalse:[
-		p interruptWith:block
-	    ]
-	]
+        blocksToEvaluate keysAndValuesDo:[:index :block |
+            |p|
+
+            p := processes at:index.
+            (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+                block value
+            ] ifFalse:[
+                p isDead ifTrue:[
+                    ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+                    ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+                ] ifFalse:[
+                    p interruptWith:block
+                ]
+            ]
+        ]
     ]
+
+    "Modified: / 29.1.1998 / 17:02:25 / cg"
 !
 
 removeTimedBlock:aBlock
@@ -2608,6 +2613,6 @@
 !ProcessorScheduler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.141 1997-11-20 18:29:40 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.142 1998-01-29 16:03:01 cg Exp $'
 ! !
 ProcessorScheduler initialize!