equal
deleted
inserted
replaced
15 zombie |
15 zombie |
16 activeProcess currentPriority |
16 activeProcess currentPriority |
17 readFds readSemaphores readChecks |
17 readFds readSemaphores readChecks |
18 writeFds writeSemaphores writeChecks |
18 writeFds writeSemaphores writeChecks |
19 timeouts timeoutActions timeoutSemaphores |
19 timeouts timeoutActions timeoutSemaphores |
20 idleActions nTimeouts dispatching' |
20 idleActions anyTimeouts dispatching' |
21 classVariableNames:'KnownProcesses KnownProcessIds |
21 classVariableNames:'KnownProcesses KnownProcessIds |
22 PureEventDriven |
22 PureEventDriven |
23 UserSchedulingPriority TimingPriority' |
23 UserSchedulingPriority TimingPriority' |
24 poolDictionaries:'' |
24 poolDictionaries:'' |
25 category:'Kernel-Processes' |
25 category:'Kernel-Processes' |
28 ProcessorScheduler comment:' |
28 ProcessorScheduler comment:' |
29 |
29 |
30 COPYRIGHT (c) 1993 by Claus Gittinger |
30 COPYRIGHT (c) 1993 by Claus Gittinger |
31 All Rights Reserved |
31 All Rights Reserved |
32 |
32 |
33 $Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.7 1993-12-19 23:40:17 claus Exp $ |
33 $Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.8 1993-12-20 17:32:24 claus Exp $ |
34 '! |
34 '! |
35 |
35 |
36 Smalltalk at:#Processor put:nil! |
36 Smalltalk at:#Processor put:nil! |
37 |
37 |
38 !ProcessorScheduler class methodsFor:'initialization'! |
38 !ProcessorScheduler class methodsFor:'initialization'! |
314 writeChecks := Array with:nil. |
314 writeChecks := Array with:nil. |
315 writeSemaphores := Array with:nil. |
315 writeSemaphores := Array with:nil. |
316 timeouts := Array with:nil. |
316 timeouts := Array with:nil. |
317 timeoutSemaphores := Array with:nil. |
317 timeoutSemaphores := Array with:nil. |
318 timeoutActions := Array with:nil. |
318 timeoutActions := Array with:nil. |
319 nTimeouts := 0. |
319 anyTimeouts := false. |
320 dispatching := false. |
320 dispatching := false. |
321 |
321 |
322 "handcraft the first (dispatcher-) process - this one will never |
322 "handcraft the first (dispatcher-) process - this one will never |
323 block, but go into a select if there is nothing to do. |
323 block, but go into a select if there is nothing to do. |
324 Also it has a prio of max+1" |
324 Also it has a prio of max+1" |
706 |
706 |
707 dispatch |
707 dispatch |
708 |any millis pri p nActions "{ Class: SmallInteger }" | |
708 |any millis pri p nActions "{ Class: SmallInteger }" | |
709 |
709 |
710 "handle all timeout actions" |
710 "handle all timeout actions" |
711 nTimeouts ~~ 0 ifTrue:[ |
711 anyTimeouts ifTrue:[ |
712 self evaluateTimeouts |
712 self evaluateTimeouts |
713 ]. |
713 ]. |
714 |
714 |
715 "first do a quick check using checkActions - this is needed for |
715 "first do a quick check using checkActions - this is needed for |
716 devices like X-connection, where some events might be in the event |
716 devices like X-connection, where some events might be in the event |
760 this will all change, when timeouts are removed and all is process driven |
760 this will all change, when timeouts are removed and all is process driven |
761 " |
761 " |
762 |
762 |
763 " |
763 " |
764 pri < TimingPriority ifTrue:[ |
764 pri < TimingPriority ifTrue:[ |
765 (nTimeouts ~~ 0) ifTrue:[ |
765 anyTimeouts ifTrue:[ |
766 millis := self timeToNextTimeout. |
766 millis := self timeToNextTimeout. |
767 millis == 0 ifTrue:[^ self]. |
767 millis == 0 ifTrue:[^ self]. |
768 ] |
768 ] |
769 ]. |
769 ]. |
770 " |
770 " |
771 pri < UserSchedulingPriority ifTrue:[ |
771 pri < UserSchedulingPriority ifTrue:[ |
772 |
772 |
773 "comment out this if above is uncommented" |
773 "comment out this if above is uncommented" |
774 (nTimeouts ~~ 0) ifTrue:[ |
774 anyTimeouts ifTrue:[ |
775 millis := self timeToNextTimeout. |
775 millis := self timeToNextTimeout. |
776 millis == 0 ifTrue:[^ self]. |
776 millis == 0 ifTrue:[^ self]. |
777 ]. |
777 ]. |
778 |
778 |
779 OperatingSystem supportsIOInterrupts ifTrue:[ |
779 OperatingSystem supportsIOInterrupts ifTrue:[ |
855 waitForEventOrTimeout |
855 waitForEventOrTimeout |
856 |millis limit doingGC| |
856 |millis limit doingGC| |
857 |
857 |
858 doingGC := true. |
858 doingGC := true. |
859 [doingGC] whileTrue:[ |
859 [doingGC] whileTrue:[ |
860 (nTimeouts ~~ 0) ifTrue:[ |
860 anyTimeouts ifTrue:[ |
861 millis := self timeToNextTimeout. |
861 millis := self timeToNextTimeout. |
862 (millis notNil and:[millis <= 0]) ifTrue:[ |
862 (millis notNil and:[millis <= 0]) ifTrue:[ |
863 ^ self "oops - hurry up checking" |
863 ^ self "oops - hurry up checking" |
864 ]. |
864 ]. |
865 ]. |
865 ]. |
930 evaluateTimeouts |
930 evaluateTimeouts |
931 "walk through timeouts and evaluate blocks or signal semas those that need to be .." |
931 "walk through timeouts and evaluate blocks or signal semas those that need to be .." |
932 |
932 |
933 |now aTime block blocksToEvaluate n "{ Class: SmallInteger }"| |
933 |now aTime block blocksToEvaluate n "{ Class: SmallInteger }"| |
934 |
934 |
935 nTimeouts == 0 ifTrue:[ ^ self]. |
935 anyTimeouts ifFalse:[ ^ self]. |
936 |
936 |
937 "have to collect the blocks first, then evaluate them. This avoids |
937 "have to collect the blocks first, then evaluate them. This avoids |
938 problems due to newly inserted blocks." |
938 problems due to newly inserted blocks." |
939 |
939 |
940 now := OperatingSystem getMillisecondTime. |
940 now := OperatingSystem getMillisecondTime. |
941 blocksToEvaluate := nil. |
941 blocksToEvaluate := nil. |
942 n := timeouts size. |
942 n := timeouts size. |
|
943 anyTimeouts := false. |
943 1 to:n do:[:index | |
944 1 to:n do:[:index | |
944 aTime := timeouts at:index. |
945 aTime := timeouts at:index. |
945 aTime notNil ifTrue:[ |
946 aTime notNil ifTrue:[ |
946 (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[ |
947 (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[ |
947 "this one should be triggered" |
948 "this one should be triggered" |
960 ]. |
961 ]. |
961 timeoutActions at:index put:nil |
962 timeoutActions at:index put:nil |
962 ] |
963 ] |
963 ]. |
964 ]. |
964 timeouts at:index put:nil. |
965 timeouts at:index put:nil. |
965 nTimeouts := nTimeouts - 1 |
966 ] ifTrue:[ |
966 ] |
967 anyTimeouts := true |
|
968 ] |
967 ] |
969 ] |
968 ]. |
970 ]. |
969 |
971 |
970 blocksToEvaluate notNil ifTrue:[ |
972 blocksToEvaluate notNil ifTrue:[ |
971 blocksToEvaluate do:[:aBlock | |
973 blocksToEvaluate do:[:aBlock | |
1012 idx := timeoutSemaphores identityIndexOf:aSemaphore. |
1014 idx := timeoutSemaphores identityIndexOf:aSemaphore. |
1013 idx ~~ 0 ifTrue:[ |
1015 idx ~~ 0 ifTrue:[ |
1014 timeouts at:idx put:nil. |
1016 timeouts at:idx put:nil. |
1015 timeoutSemaphores at:idx put:nil. |
1017 timeoutSemaphores at:idx put:nil. |
1016 timeoutActions at:idx put:nil. |
1018 timeoutActions at:idx put:nil. |
1017 nTimeouts := nTimeouts - 1. |
|
1018 ]. |
1019 ]. |
1019 OperatingSystem unblockInterrupts. |
1020 OperatingSystem unblockInterrupts. |
1020 ! |
1021 ! |
1021 |
1022 |
1022 enableSemaphore:aSemaphore afterSeconds:seconds |
1023 enableSemaphore:aSemaphore afterSeconds:seconds |
1042 ] ifFalse:[ |
1043 ] ifFalse:[ |
1043 timeoutSemaphores := timeoutSemaphores copyWith:aSemaphore. |
1044 timeoutSemaphores := timeoutSemaphores copyWith:aSemaphore. |
1044 timeouts := timeouts copyWith:then. |
1045 timeouts := timeouts copyWith:then. |
1045 timeoutActions := timeoutActions copyWith:nil. |
1046 timeoutActions := timeoutActions copyWith:nil. |
1046 ]. |
1047 ]. |
1047 nTimeouts := nTimeouts + 1. |
1048 ]. |
1048 ]. |
1049 anyTimeouts := true. |
1049 OperatingSystem unblockInterrupts. |
1050 OperatingSystem unblockInterrupts. |
1050 ! ! |
1051 ! ! |
1051 |
1052 |
1052 !ProcessorScheduler methodsFor:'pure event support'! |
1053 !ProcessorScheduler methodsFor:'pure event support'! |
1053 |
1054 |
1128 ] ifFalse:[ |
1129 ] ifFalse:[ |
1129 timeoutActions := timeoutActions copyWith:aBlock. |
1130 timeoutActions := timeoutActions copyWith:aBlock. |
1130 timeouts := timeouts copyWith:then. |
1131 timeouts := timeouts copyWith:then. |
1131 timeoutSemaphores := timeoutSemaphores copyWith:nil. |
1132 timeoutSemaphores := timeoutSemaphores copyWith:nil. |
1132 ]. |
1133 ]. |
1133 nTimeouts := nTimeouts + 1. |
1134 ]. |
1134 ]. |
1135 anyTimeouts := true. |
1135 OperatingSystem unblockInterrupts. |
1136 OperatingSystem unblockInterrupts. |
1136 ! |
1137 ! |
1137 |
1138 |
1138 removeTimedBlock:aBlock |
1139 removeTimedBlock:aBlock |
1139 "remove the argument, aBlock from the list of time-sceduled-blocks" |
1140 "remove the argument, aBlock from the list of time-sceduled-blocks" |
1144 index := timeoutActions identityIndexOf:aBlock. |
1145 index := timeoutActions identityIndexOf:aBlock. |
1145 (index ~~ 0) ifTrue:[ |
1146 (index ~~ 0) ifTrue:[ |
1146 timeoutActions at:index put:nil. |
1147 timeoutActions at:index put:nil. |
1147 timeouts at:index put:nil. |
1148 timeouts at:index put:nil. |
1148 timeoutSemaphores at:index put:nil. |
1149 timeoutSemaphores at:index put:nil. |
1149 nTimeouts := nTimeouts - 1. |
|
1150 ]. |
1150 ]. |
1151 OperatingSystem unblockInterrupts. |
1151 OperatingSystem unblockInterrupts. |
1152 ! ! |
1152 ! ! |