class: ProcessorScheduler
changed: #evaluateTimeouts
avoid allocation of temporary OC
--- 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 $'
! !