2768 |
2768 |
2769 |sema now aTime block blocksToEvaluate |
2769 |sema now aTime block blocksToEvaluate |
2770 processes n "{ Class: SmallInteger }"| |
2770 processes n "{ Class: SmallInteger }"| |
2771 |
2771 |
2772 anyTimeouts ifFalse:[ ^ self]. |
2772 anyTimeouts ifFalse:[ ^ self]. |
|
2773 anyTimeouts := false. |
2773 |
2774 |
2774 "have to collect the blocks first, then evaluate them. This avoids |
2775 "have to collect the blocks first, then evaluate them. This avoids |
2775 problems due to newly inserted blocks." |
2776 problems due to newly inserted blocks." |
2776 |
2777 |
2777 now := OperatingSystem getMillisecondTime. |
2778 now := OperatingSystem getMillisecondTime. |
2778 blocksToEvaluate := nil. |
|
2779 n := timeoutArray size. |
2779 n := timeoutArray size. |
2780 anyTimeouts := false. |
|
2781 1 to:n do:[:index | |
2780 1 to:n do:[:index | |
2782 aTime := timeoutArray at:index. |
2781 aTime := timeoutArray at:index. |
2783 aTime notNil ifTrue:[ |
2782 aTime notNil ifTrue:[ |
2784 (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[ |
2783 (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[ |
2785 "this one should be triggered" |
2784 "this one should be triggered" |
2786 |
2785 |
2787 sema := timeoutSemaphoreArray at:index. |
2786 sema := timeoutSemaphoreArray at:index. |
2788 sema notNil ifTrue:[ |
2787 sema notNil ifTrue:[ |
2789 timeoutSemaphoreArray at:index put:nil. |
2788 timeoutSemaphoreArray at:index put:nil. |
2790 sema signalOnce. |
2789 sema signalOnce. |
2791 ] ifFalse:[ |
2790 ] ifFalse:[ |
2792 "to support pure-events" |
2791 "to support pure-events" |
2793 block := timeoutActionArray at:index. |
2792 block := timeoutActionArray at:index. |
2794 block notNil ifTrue:[ |
2793 block notNil ifTrue:[ |
2795 blocksToEvaluate isNil ifTrue:[ |
2794 blocksToEvaluate isNil ifTrue:[ |
2796 blocksToEvaluate := OrderedCollection new:10. |
2795 blocksToEvaluate := OrderedCollection new:10. |
2797 processes := OrderedCollection new:10. |
2796 processes := OrderedCollection new:10. |
2798 ]. |
2797 ]. |
2799 blocksToEvaluate add:block. |
2798 blocksToEvaluate add:block. |
2800 processes add:(timeoutProcessArray at:index). |
2799 processes add:(timeoutProcessArray at:index). |
2801 timeoutActionArray at:index put:nil. |
2800 timeoutActionArray at:index put:nil. |
2802 timeoutProcessArray at:index put:nil. |
2801 timeoutProcessArray at:index put:nil. |
2803 ] |
2802 ] |
2804 ]. |
2803 ]. |
2805 timeoutArray at:index put:nil. |
2804 timeoutArray at:index put:nil. |
2806 ] ifTrue:[ |
2805 ] ifFalse:[ |
2807 anyTimeouts := true |
2806 "there are still pending timeouts" |
2808 ] |
2807 anyTimeouts := true |
2809 ] |
2808 ] |
|
2809 ] |
2810 ]. |
2810 ]. |
2811 |
2811 |
2812 blocksToEvaluate notNil ifTrue:[ |
2812 blocksToEvaluate notNil ifTrue:[ |
2813 blocksToEvaluate keysAndValuesDo:[:index :block | |
2813 blocksToEvaluate keysAndValuesDo:[:index :block | |
2814 |p| |
2814 |p| |
2815 |
2815 |
2816 p := processes at:index. |
2816 p := processes at:index. |
2817 (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[ |
2817 (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[ |
2818 block value |
2818 block value |
2819 ] ifFalse:[ |
2819 ] ifFalse:[ |
2820 p isDead ifTrue:[ |
2820 p isDead ifTrue:[ |
2821 |
2821 |
2822 "/ a timedBlock for a process which has already terminated |
2822 "/ a timedBlock for a process which has already terminated |
2823 "/ issue a warning and do not execute it. |
2823 "/ issue a warning and do not execute it. |
2824 "/ (exeuting here may be dangerous, since it would run at scheduler priority here, |
2824 "/ (exeuting here may be dangerous, since it would run at scheduler priority here, |
2825 "/ and thereby could block the whole smalltalk system. |
2825 "/ and thereby could block the whole smalltalk system. |
2826 "/ For this reason is it IGNORED here.) |
2826 "/ For this reason is it IGNORED here.) |
2827 |
2827 |
2828 ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR. |
2828 ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR. |
2829 ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR. |
2829 ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR. |
2830 ] ifFalse:[ |
2830 ] ifFalse:[ |
2831 p interruptWith:block |
2831 p interruptWith:block |
2832 ] |
2832 ] |
2833 ] |
2833 ] |
2834 ] |
2834 ] |
2835 ] |
2835 ] |
2836 |
2836 |
2837 "Modified: / 9.11.1998 / 21:25:02 / cg" |
2837 "Modified: / 9.11.1998 / 21:25:02 / cg" |
2838 ! |
2838 ! |
2839 |
2839 |
3211 If there were many, the list should be kept sorted ... keeping deltas |
3211 If there were many, the list should be kept sorted ... keeping deltas |
3212 to next (as in Unix kernel)" |
3212 to next (as in Unix kernel)" |
3213 |
3213 |
3214 n := timeoutArray size. |
3214 n := timeoutArray size. |
3215 1 to:n do:[:index | |
3215 1 to:n do:[:index | |
3216 aTime := timeoutArray at:index. |
3216 aTime := timeoutArray at:index. |
3217 aTime notNil ifTrue:[ |
3217 aTime notNil ifTrue:[ |
3218 now isNil ifTrue:[ |
3218 now isNil ifTrue:[ |
3219 now := OperatingSystem getMillisecondTime. |
3219 now := OperatingSystem getMillisecondTime. |
3220 ]. |
3220 ]. |
3221 (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0]. |
3221 delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now. |
3222 delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now. |
3222 delta <= 0 ifTrue:[ |
3223 delta < 0 ifTrue:[ |
3223 ^ 0. |
3224 'Processor [warning]: negative time delta' errorPrintCR. |
3224 ]. |
3225 delta := 10. |
3225 minDelta isNil ifTrue:[ |
3226 ]. |
3226 minDelta := delta |
3227 minDelta isNil ifTrue:[ |
3227 ] ifFalse:[ |
3228 minDelta := delta |
3228 minDelta := minDelta min:delta |
3229 ] ifFalse:[ |
3229 ] |
3230 minDelta := minDelta min:delta |
3230 ] |
3231 ] |
|
3232 ] |
|
3233 ]. |
3231 ]. |
3234 |
3232 |
3235 ^ minDelta |
3233 ^ minDelta |
3236 ! |
3234 ! |
3237 |
3235 |