# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 1394014208 -3600
# Node ID 3f0d3162e40bfa10c613e805819ce095629ef691
# Parent  f2d1d7b2d6492c1b6d1b4132140fdf2d7c0fb31b
class: ProcessorScheduler
changed: #evaluateTimeouts
avoid allocation of temporary OC

diff -r f2d1d7b2d649 -r 3f0d3162e40b ProcessorScheduler.st
--- a/ProcessorScheduler.st	Wed Mar 05 11:02:58 2014 +0100
+++ b/ProcessorScheduler.st	Wed Mar 05 11:10:08 2014 +0100
@@ -2777,8 +2777,8 @@
 evaluateTimeouts
     "walk through timeouts and evaluate blocks or signal semas that need to be .."
 
-    |sema now aTime block blocksToEvaluate
-     processes n "{ Class: SmallInteger }"
+    |sema now aTime block blocksAndProcessesToEvaluate
+     firstBlockToEvaluate firstProcess n "{ Class: SmallInteger }"
      indexOfLastTimeout "{ Class: SmallInteger }"
      halfSize "{ Class: SmallInteger }"
      wasBlocked p|
@@ -2787,8 +2787,16 @@
     anyTimeouts ifFalse:[ ^ self].
     anyTimeouts := false.
 
-    "have to collect the blocks first, then evaluate them. This avoids
-     problems due to newly inserted blocks."
+    "have to collect the blocks first, then evaluate them. 
+     This avoids problems due to newly inserted blocks."
+
+    "/ notice: the code looks uglier than seems to be required;
+    "/ the observation is that in almost all cases, only a single block (or no block at all)
+    "/ is found in the loops below.
+    "/ To avoid idel memory allocation, we avoid the allocation of the OrderedCollection in this case,
+    "/ by remembering the first block+process in a variable untl another block is found.
+    "/ Thus firstBlockToEvaluate+firstProcess effectively cache the first slot of the lazy allocated collection.
+    "/ looks ugly, but as this is called very often, reduces idle allocation by a lot.
 
     now := OperatingSystem getMillisecondTime.
     n := timeoutArray size.
@@ -2806,12 +2814,18 @@
                     "to support pure-events"
                     block := timeoutActionArray at:index.
                     block notNil ifTrue:[
-                        blocksToEvaluate isNil ifTrue:[
-                            blocksToEvaluate := OrderedCollection new.
-                            processes := OrderedCollection new.
+                        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).
                         ].
-                        blocksToEvaluate add:block.
-                        processes add:(timeoutProcessArray at:index).
                         timeoutActionArray at:index put:nil.
                         timeoutProcessArray at:index put:nil.
                     ]
@@ -2839,28 +2853,50 @@
         ].
     ].
 
-    n := blocksToEvaluate size.
-    1 to:n do:[:index |
-        block := blocksToEvaluate at:index.
-        p := processes at:index.
-        (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.)
-
-                ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
-                ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+    blocksAndProcessesToEvaluate isNil ifTrue:[
+        firstBlockToEvaluate notNil ifTrue:[
+            (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
+                firstBlockToEvaluate value
             ] ifFalse:[
-                p interruptWith:block
+                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.)
+
+                    ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR.
+                    ('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
+                ] 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.)
+
+                    ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+                    ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+                ] ifFalse:[
+                    p interruptWith:block
+                ]
             ]
         ]
-    ]
+    ].
 
     "Modified: / 30-07-2013 / 19:33:24 / cg"
 !
@@ -3402,11 +3438,11 @@
 !ProcessorScheduler class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.278 2014-03-05 09:42:30 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.279 2014-03-05 10:10:08 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.278 2014-03-05 09:42:30 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.279 2014-03-05 10:10:08 cg Exp $'
 ! !