diff -r 93705f0c6a54 -r d7d5b3f3cc88 ProcessorScheduler.st --- a/ProcessorScheduler.st Tue Jul 25 11:28:28 2017 +0200 +++ b/ProcessorScheduler.st Tue Jul 25 15:51:40 2017 +0200 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1993 by Claus Gittinger - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -14,26 +14,26 @@ "{ NameSpace: Smalltalk }" Object subclass:#ProcessorScheduler - instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess - activeProcessId currentPriority readFdArray readSemaphoreArray - readCheckArray writeFdArray writeSemaphoreArray writeCheckArray - timeoutArray timeoutActionArray timeoutProcessArray - timeoutSemaphoreArray idleActions anyTimeouts dispatching - interruptedProcess useIOInterrupts gotIOInterrupt - osChildExitActions gotChildSignalInterrupt - exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess - supportDynamicPriorities timeSliceNeededSemaphore - scheduledProcesses preWaitActions timeoutHandlerProcess - readableResultFdArray writableResultFdArray exceptFdArray - exceptResultFdArray exceptSemaphoreArray interruptCounter - timedActionCounter' - classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven - UserSchedulingPriority UserInterruptPriority TimingPriority - HighestPriority SchedulingPriority MaxNumberOfProcesses - InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval - EventPollingInterval MaxProcessId' - poolDictionaries:'' - category:'Kernel-Processes' + instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess + activeProcessId currentPriority readFdArray readSemaphoreArray + readCheckArray writeFdArray writeSemaphoreArray writeCheckArray + timeoutArray timeoutActionArray timeoutProcessArray + timeoutSemaphoreArray idleActions anyTimeouts dispatching + interruptedProcess useIOInterrupts gotIOInterrupt + osChildExitActions gotChildSignalInterrupt + exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess + supportDynamicPriorities timeSliceNeededSemaphore + scheduledProcesses preWaitActions timeoutHandlerProcess + readableResultFdArray writableResultFdArray exceptFdArray + exceptResultFdArray exceptSemaphoreArray interruptCounter + timedActionCounter' + classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven + UserSchedulingPriority UserInterruptPriority TimingPriority + HighestPriority SchedulingPriority MaxNumberOfProcesses + InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval + EventPollingInterval MaxProcessId' + poolDictionaries:'' + category:'Kernel-Processes' ! !ProcessorScheduler class methodsFor:'documentation'! @@ -41,7 +41,7 @@ copyright " COPYRIGHT (c) 1993 by Claus Gittinger - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -224,16 +224,16 @@ allows for critical processes to run unaffected to completion. WARNING: - timesliced priority scheduling is an experimental feature. There is no warranty, - (at the moment), that the system runs reliable in this mode. - The problem is, that shared collections may now be easily modified by other - processes, running at the same time. - The class library has being investigated for such possible trouble spots - (we have eliminated many weak spots, and added critical regions at many places, - but cannot guarantee that all of them have been found so far ...) - We found that many existing public domain programs are not prepared for - being interrupted by a same-prio process and therefore may corrupt their - data. If in doubt, disable this fefature. + timesliced priority scheduling is an experimental feature. There is no warranty, + (at the moment), that the system runs reliable in this mode. + The problem is, that shared collections may now be easily modified by other + processes, running at the same time. + The class library has being investigated for such possible trouble spots + (we have eliminated many weak spots, and added critical regions at many places, + but cannot guarantee that all of them have been found so far ...) + We found that many existing public domain programs are not prepared for + being interrupted by a same-prio process and therefore may corrupt their + data. If in doubt, disable this fefature. We think, that the timeSlicer is a useful add-on and that the system is fit enough for it to be evaluated, therefore, its included. @@ -241,10 +241,10 @@ To demonstrate the effect of timeSlicing, do the following: - - disable timeSlicing (in the launchers misc-settings menu) - - open a workSpace - - in the workspace, evaluate: - [true] whileTrue:[1000 factorial] + - disable timeSlicing (in the launchers misc-settings menu) + - open a workSpace + - in the workspace, evaluate: + [true] whileTrue:[1000 factorial] now, (since the workSpace runs at the same prio as other window-processes), other views do no longer react - all CPU is used up by the workSpace. @@ -274,15 +274,15 @@ SchedulingPriority := 31. InvalidProcessSignal isNil ifTrue:[ - InvalidProcessSignal := Error newSignalMayProceed:true. - InvalidProcessSignal nameClass:self message:#invalidProcessSignal. - InvalidProcessSignal notifierString:'invalid process'. + InvalidProcessSignal := Error newSignalMayProceed:true. + InvalidProcessSignal nameClass:self message:#invalidProcessSignal. + InvalidProcessSignal notifierString:'invalid process'. ]. Processor isNil ifTrue:[ - "create the one and only processor" - - Smalltalk at:#Processor put:(self basicNew initialize). + "create the one and only processor" + + Smalltalk at:#Processor put:(self basicNew initialize). ]. " @@ -291,7 +291,7 @@ " PureEventDriven := self threadsAvailable not. PureEventDriven ifTrue:[ - 'Processor [error]: no process support - running event driven' errorPrintCR + 'Processor [error]: no process support - running event driven' errorPrintCR ]. self initializeVMMaxProcessId @@ -346,22 +346,22 @@ |id sz "{ Class: SmallInteger }"| something == #ElementExpired ifTrue:[ - sz := KnownProcessIds size. - 1 to:sz do:[:index | - "/ (KnownProcesses at:index) isNil ifTrue:[ - (KnownProcesses at:index) class == SmallInteger ifTrue:[ - id := KnownProcessIds at:index. - id notNil ifTrue:[ - 'Processor [warning]: terminating thread ' errorPrint. - id errorPrint. - ' (no longer refd)' errorPrintCR. - - self threadDestroy:id. - KnownProcessIds at:index put:nil. - ]. - KnownProcesses at:index put:nil. - ] - ] + sz := KnownProcessIds size. + 1 to:sz do:[:index | + "/ (KnownProcesses at:index) isNil ifTrue:[ + (KnownProcesses at:index) class == SmallInteger ifTrue:[ + id := KnownProcessIds at:index. + id notNil ifTrue:[ + 'Processor [warning]: terminating thread ' errorPrint. + id errorPrint. + ' (no longer refd)' errorPrintCR. + + self threadDestroy:id. + KnownProcessIds at:index put:nil. + ]. + KnownProcesses at:index put:nil. + ] + ] ] "Created: 7.1.1997 / 16:45:42 / stefan" @@ -418,7 +418,7 @@ %{ /* NOCONTEXT */ if (__isSmallInteger(id)) { - __threadDestroy(__intVal(id)); + __threadDestroy(__intVal(id)); } %} ! @@ -432,7 +432,7 @@ %{ /* NOCONTEXT */ if (__isSmallInteger(id)) { - __threadInterrupt(__intVal(id)); + __threadInterrupt(__intVal(id)); } %} ! @@ -474,7 +474,7 @@ "evaluate aBlock for each (living) processes in the system" KnownProcesses do:[:p | - (p notNil and:[p class ~~ SmallInteger]) ifTrue:[aBlock value:p] + (p notNil and:[p class ~~ SmallInteger]) ifTrue:[aBlock value:p] ] "Created: / 26-10-2012 / 13:02:33 / cg" @@ -528,26 +528,26 @@ wasBlocked| aFileDescriptor < 0 ifTrue:[ - 'Processor [warning]: ignored invalid fd for IO action.' errorPrintCR. - thisContext fullPrintAll. - ^ self + 'Processor [warning]: ignored invalid fd for IO action.' errorPrintCR. + thisContext fullPrintAll. + ^ self ]. wasBlocked := OperatingSystem blockInterrupts. (readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[ - idx := readFdArray identityIndexOf:nil startingAt:1. - idx ~~ 0 ifTrue:[ - readFdArray at:idx put:aFileDescriptor. - readCheckArray at:idx put:aBlock. - readSemaphoreArray at:idx put:nil - ] ifFalse:[ - readFdArray := readFdArray copyWith:aFileDescriptor. - readCheckArray := readCheckArray copyWith:aBlock. - readSemaphoreArray := readSemaphoreArray copyWith:nil. - ]. - useIOInterrupts ifTrue:[ - OperatingSystem enableIOInterruptsOn:aFileDescriptor - ]. + idx := readFdArray identityIndexOf:nil startingAt:1. + idx ~~ 0 ifTrue:[ + readFdArray at:idx put:aFileDescriptor. + readCheckArray at:idx put:aBlock. + readSemaphoreArray at:idx put:nil + ] ifFalse:[ + readFdArray := readFdArray copyWith:aFileDescriptor. + readCheckArray := readCheckArray copyWith:aBlock. + readSemaphoreArray := readSemaphoreArray copyWith:nil. + ]. + useIOInterrupts ifTrue:[ + OperatingSystem enableIOInterruptsOn:aFileDescriptor + ]. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -652,7 +652,7 @@ wasBlocked := OperatingSystem blockInterrupts. idleActions isNil ifTrue:[ - idleActions := OrderedCollection new + idleActions := OrderedCollection new ]. idleActions add:aBlock. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -930,9 +930,9 @@ p l| KnownProcesses isNil ifTrue:[ - KnownProcesses := WeakArray new:30. - KnownProcesses addDependent:self class. - KnownProcessIds := OrderedCollection new:30. + KnownProcesses := WeakArray new:30. + KnownProcesses addDependent:self class. + KnownProcessIds := OrderedCollection new:30. ]. " @@ -965,7 +965,7 @@ supportDynamicPriorities := false. exitWhenNoMoreUserProcesses isNil ifTrue:[ - exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ? + exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ? ]. " @@ -977,10 +977,10 @@ currentPriority := SchedulingPriority. p := Process basicNew. p - setId:0 state:#run; - setPriority:currentPriority; - name:'scheduler'; - beSystemProcess. + setId:0 state:#run; + setPriority:currentPriority; + name:'scheduler'; + beSystemProcess. scheduler := activeProcess := p. activeProcessId := 0. @@ -993,8 +993,8 @@ " useIOInterrupts ifTrue:[ObjectMemory ioInterruptHandler:self]. ObjectMemory - timerInterruptHandler:self; - childSignalInterruptHandler:self. + timerInterruptHandler:self; + childSignalInterruptHandler:self. "Modified: / 7.1.1997 / 16:48:26 / stefan" "Modified: / 4.2.1999 / 13:08:39 / cg" @@ -1020,16 +1020,16 @@ " processesToRestart := OrderedCollection new. KnownProcesses do:[:p | - (p notNil and:[p class ~~ SmallInteger]) ifTrue:[ - "how, exactly should this be done ?" - - p isRestartable == true ifTrue:[ - p nextLink:nil. - processesToRestart add:p - ] ifFalse:[ - p setId:nil state:#dead - ] - ]. + (p notNil and:[p class ~~ SmallInteger]) ifTrue:[ + "how, exactly should this be done ?" + + p isRestartable == true ifTrue:[ + p nextLink:nil. + processesToRestart add:p + ] ifFalse:[ + p setId:nil state:#dead + ] + ]. ]. scheduler setId:nil state:#dead. @@ -1040,7 +1040,7 @@ self initialize. processesToRestart do:[:p | - p imageRestart + p imageRestart ] "Modified: / 7.6.1998 / 02:23:56 / cg" @@ -1058,44 +1058,44 @@ |index pri aProcess l| OperatingSystem interruptsBlocked ifFalse:[ - MiniDebugger - enterWithMessage:'vmResumeInterrupt with no interruptsBlocked' - mayProceed:true. + MiniDebugger + enterWithMessage:'vmResumeInterrupt with no interruptsBlocked' + mayProceed:true. ]. index := KnownProcessIds identityIndexOf:id. index ~~ 0 ifTrue:[ - aProcess := KnownProcesses at:index. - pri := aProcess priority. - l := quiescentProcessLists at:pri. - l notNil ifTrue:[ - (l includesIdentical:aProcess) ifTrue:[ - "/ aProcess is on a run queue. - "/ CG: this situation may happen, if the wrapCall - "/ finishes before the process was layed to sleep - "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished). - "/ In that case, simply resume it and everything is OK. - "/ If the process is state running, ignore. - - |state| - - state := aProcess state. - (state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[ - aProcess state:#run. - ]. - 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint. - aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR. - ^ self - ] - ] ifFalse:[ - l := LinkedList new. - quiescentProcessLists at:pri put:l. - ]. - l addLast:aProcess. - aProcess state:#run. + aProcess := KnownProcesses at:index. + pri := aProcess priority. + l := quiescentProcessLists at:pri. + l notNil ifTrue:[ + (l includesIdentical:aProcess) ifTrue:[ + "/ aProcess is on a run queue. + "/ CG: this situation may happen, if the wrapCall + "/ finishes before the process was layed to sleep + "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished). + "/ In that case, simply resume it and everything is OK. + "/ If the process is state running, ignore. + + |state| + + state := aProcess state. + (state == #wrapWait or:[(state == #osWait) or:[state == #stopped]]) ifTrue:[ + aProcess state:#run. + ]. + 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint. + aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR. + ^ self + ] + ] ifFalse:[ + l := LinkedList new. + quiescentProcessLists at:pri put:l. + ]. + l addLast:aProcess. + aProcess state:#run. ] ifFalse:[ - 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint. - id infoPrintCR. + 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint. + id infoPrintCR. ] "Modified: / 28.9.1998 / 11:36:53 / cg" @@ -1161,9 +1161,9 @@ gotChildSignalInterrupt := true. interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. activeProcess ~~ scheduler ifTrue:[ - interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 12.4.1996 / 10:12:18 / stefan" @@ -1180,37 +1180,37 @@ "/ no interrupt processing, to avoid races with monitorPid wasBlocked := OperatingSystem blockInterrupts. [ - [ - osProcessStatus := OperatingSystem childProcessWait:blocking pid:nil. - osProcessStatus notNil ifTrue:[ - |pid action| - - pid := osProcessStatus pid. - osProcessStatus stillAlive ifTrue:[ - action := osChildExitActions at:pid ifAbsent:nil. - ] ifFalse:[ - action := osChildExitActions removeKey:pid ifAbsent:nil. - ]. - action notNil ifTrue:[ - action value:osProcessStatus - ]. - ]. - - "/ if pollChildProcesses does block, poll only one status change. - "/ we will get another SIGCHLD for other status changes. - - osProcessStatus notNil and:[blocking not] - ] whileTrue. - - "/ if there are no more waiters, disable SIGCHILD handler. - "/ this helps us with synchronous waiters (e.g. pclose), - "/ But they should block SIGCHLD anyway. - - osChildExitActions isEmpty ifTrue:[ - OperatingSystem disableChildSignalInterrupts. - ]. + [ + osProcessStatus := OperatingSystem childProcessWait:blocking pid:nil. + osProcessStatus notNil ifTrue:[ + |pid action| + + pid := osProcessStatus pid. + osProcessStatus stillAlive ifTrue:[ + action := osChildExitActions at:pid ifAbsent:nil. + ] ifFalse:[ + action := osChildExitActions removeKey:pid ifAbsent:nil. + ]. + action notNil ifTrue:[ + action value:osProcessStatus + ]. + ]. + + "/ if pollChildProcesses does block, poll only one status change. + "/ we will get another SIGCHLD for other status changes. + + osProcessStatus notNil and:[blocking not] + ] whileTrue. + + "/ if there are no more waiters, disable SIGCHILD handler. + "/ this helps us with synchronous waiters (e.g. pclose), + "/ But they should block SIGCHLD anyway. + + osChildExitActions isEmpty ifTrue:[ + OperatingSystem disableChildSignalInterrupts. + ]. ] ensure:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ] "Modified: 5.1.1996 / 16:56:11 / stefan" @@ -1272,10 +1272,10 @@ self scheduleInterruptActionsOf:aProcess. aProcess state ~~ #stopped ifTrue:[ - " - make the process runnable - " - self resume:aProcess + " + make the process runnable + " + self resume:aProcess ] "Modified: / 24.8.1998 / 18:31:32 / cg" @@ -1490,17 +1490,17 @@ index := 1. sz := KnownProcessIds size. [index <= sz] whileTrue:[ - (KnownProcesses at:index) isNil ifTrue:[ - oldId := KnownProcessIds at:index. - oldId notNil ifTrue:[ - self class threadDestroy:oldId. - ]. - KnownProcesses at:index put:aProcess. - KnownProcessIds at:index put:aProcess id. - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self - ]. - index := index + 1 + (KnownProcesses at:index) isNil ifTrue:[ + oldId := KnownProcessIds at:index. + oldId notNil ifTrue:[ + self class threadDestroy:oldId. + ]. + KnownProcesses at:index put:aProcess. + KnownProcessIds at:index put:aProcess id. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ self + ]. + index := index + 1 ]. KnownProcessIds grow:index. @@ -1508,10 +1508,10 @@ oldSize := KnownProcesses size. (index > oldSize) ifTrue:[ - newShadow := WeakArray new:(oldSize * 2). - newShadow addDependent:self class. - newShadow replaceFrom:1 with:KnownProcesses. - KnownProcesses := newShadow + newShadow := WeakArray new:(oldSize * 2). + newShadow addDependent:self class. + newShadow replaceFrom:1 with:KnownProcesses. + KnownProcesses := newShadow ]. KnownProcesses at:index put:aProcess. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -1527,8 +1527,8 @@ wasBlocked := OperatingSystem blockInterrupts. index := KnownProcesses identityIndexOf:aProcess. index ~~ 0 ifTrue:[ - KnownProcessIds at:index put:nil. - KnownProcesses at:index put:nil. + KnownProcessIds at:index put:nil. + KnownProcesses at:index put:nil. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ! ! @@ -1553,12 +1553,12 @@ "private entry for Process restart - do not use in your program" idWant isNil ifTrue:[ - self newProcessFor:aProcess. - ^ true. + self newProcessFor:aProcess. + ^ true. ]. (self class threadCreate:aProcess withId:idWant) ~~ idWant ifTrue:[ - ^ false + ^ false ]. aProcess state:#light. "meaning: has no stack yet" @@ -1678,23 +1678,23 @@ listArray := quiescentProcessLists. [prio >= 1] whileTrue:[ - l := listArray at:prio. - l notNil ifTrue:[ - l notEmpty ifTrue:[ - p := l firstLink. - " - if it got corrupted somehow ... - " - p isDead ifTrue:[ - 'Processor [warning]: dead process removed' errorPrintCR. - l removeFirst. - p := nil. - ]. - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ p - ] - ]. - prio := prio - 1 + l := listArray at:prio. + l notNil ifTrue:[ + l notEmpty ifTrue:[ + p := l firstLink. + " + if it got corrupted somehow ... + " + p isDead ifTrue:[ + 'Processor [warning]: dead process removed' errorPrintCR. + l removeFirst. + p := nil. + ]. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ p + ] + ]. + prio := prio - 1 ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ^ nil @@ -1744,22 +1744,22 @@ slot := KnownProcessIds indexOf:anInteger. slot ~~ 0 ifTrue:[ - process := KnownProcesses at:slot ifAbsent:[]. + process := KnownProcesses at:slot ifAbsent:[]. ]. wasBlocked ifFalse:[ - OperatingSystem unblockInterrupts. + OperatingSystem unblockInterrupts. ]. "Take care, the process may already have been collected" process == 0 ifTrue:[ - ^ nil. + ^ nil. ]. ^ process. " - Processor processWithId:4 - Processor processWithId:4711 + Processor processWithId:4 + Processor processWithId:4711 " ! @@ -1869,13 +1869,13 @@ s := thisContext sender. s selector == #threadSwitchFrom:to:id:singleStep: ifTrue:[ - s := s sender. - s selector == #threadSwitch: ifTrue:[ - s := s sender. - s selector == #timerInterrupt ifTrue:[ - s := s sender - ] - ] + s := s sender. + s selector == #threadSwitch: ifTrue:[ + s := s sender. + s selector == #timerInterrupt ifTrue:[ + s := s sender + ] + ] ]. "/ the returned value here has a subtle effect: @@ -2181,16 +2181,16 @@ wasBlocked := OperatingSystem blockInterrupts. activeProcess == scheduler ifTrue:[ - 'Processor [warning]: scheduler tries to yield' errorPrintCR. - ^ self + 'Processor [warning]: scheduler tries to yield' errorPrintCR. + ^ self ]. " debugging consistency check - will be removed later " activeProcess priority ~~ currentPriority ifTrue:[ - 'Processor [warning]: process changed its priority' errorPrintCR. - currentPriority := activeProcess priority. + 'Processor [warning]: process changed its priority' errorPrintCR. + currentPriority := activeProcess priority. ]. l := quiescentProcessLists at:currentPriority. @@ -2200,25 +2200,25 @@ debugging consistency checks - will be removed later " sz == 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - 'Processor [warning]: empty runnable list' errorPrintCR. - ^ self + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + 'Processor [warning]: empty runnable list' errorPrintCR. + ^ self ]. " check if the running process is not the only one " sz ~~ 1 ifTrue:[ - " - bring running process to the end - " - l removeFirst. - l addLast:activeProcess. - - " - and switch to first in the list - " - self threadSwitch:(l firstLink). + " + bring running process to the end + " + l removeFirst. + l addLast:activeProcess. + + " + and switch to first in the list + " + self threadSwitch:(l firstLink). ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2233,63 +2233,63 @@ |processesToDecrease processesToIncrease| scheduledProcesses notNil ifTrue:[ - "/ this is written a bit cryptic - to avoid creation - "/ of garbage objects (Id'sets) if possible. - "/ since this runs 50 times a second and most of the - "/ time, no rescheduling is req'd - - scheduledProcesses do:[:aProcess | - |range| - - "/ decrease priority of processes that did run - (range := aProcess priorityRange) notNil ifTrue:[ - aProcess priority > range start ifTrue:[ - processesToDecrease isNil ifTrue:[ - processesToDecrease := IdentitySet new. - ]. - processesToDecrease add:aProcess. - ] - ] - ]. - - processesToDecrease notNil ifTrue:[ - processesToDecrease do:[:aProcess | - |newPri| - - "/ newPri := aProcess priority - 1. - newPri := aProcess priorityRange start. - self changePriority:newPri for:aProcess. - ]. - ]. - - "/ and increase all prios of those that did not run, but are runnable - - TimeSlicingPriorityLimit to:1 by:-1 do:[:i | - |list| - - (list := quiescentProcessLists at:i) size > 0 ifTrue:[ - list linksDo:[:aProcess | - |range prio| - - (range := aProcess priorityRange) notNil ifTrue:[ - (processesToDecrease isNil - or:[(processesToDecrease includes:aProcess) not]) ifTrue:[ - aProcess priority < range stop ifTrue:[ - processesToIncrease isNil ifTrue:[ - processesToIncrease := OrderedCollection new. - ]. - processesToIncrease add:aProcess - ] - ] - ] - ] - ] - ]. - processesToIncrease notNil ifTrue:[ - processesToIncrease do:[:aProcess | - self changePriority:(aProcess priority + 1) for:aProcess. - ]. - ]. + "/ this is written a bit cryptic - to avoid creation + "/ of garbage objects (Id'sets) if possible. + "/ since this runs 50 times a second and most of the + "/ time, no rescheduling is req'd + + scheduledProcesses do:[:aProcess | + |range| + + "/ decrease priority of processes that did run + (range := aProcess priorityRange) notNil ifTrue:[ + aProcess priority > range start ifTrue:[ + processesToDecrease isNil ifTrue:[ + processesToDecrease := IdentitySet new. + ]. + processesToDecrease add:aProcess. + ] + ] + ]. + + processesToDecrease notNil ifTrue:[ + processesToDecrease do:[:aProcess | + |newPri| + + "/ newPri := aProcess priority - 1. + newPri := aProcess priorityRange start. + self changePriority:newPri for:aProcess. + ]. + ]. + + "/ and increase all prios of those that did not run, but are runnable + + TimeSlicingPriorityLimit to:1 by:-1 do:[:i | + |list| + + (list := quiescentProcessLists at:i) size > 0 ifTrue:[ + list linksDo:[:aProcess | + |range prio| + + (range := aProcess priorityRange) notNil ifTrue:[ + (processesToDecrease isNil + or:[(processesToDecrease includes:aProcess) not]) ifTrue:[ + aProcess priority < range stop ifTrue:[ + processesToIncrease isNil ifTrue:[ + processesToIncrease := OrderedCollection new. + ]. + processesToIncrease add:aProcess + ] + ] + ] + ] + ] + ]. + processesToIncrease notNil ifTrue:[ + processesToIncrease do:[:aProcess | + self changePriority:(aProcess priority + 1) for:aProcess. + ]. + ]. ]. "Modified: / 30-07-2013 / 19:33:14 / cg" @@ -2340,19 +2340,19 @@ timeSliceNeededSemaphore := Semaphore new name:'timeSlice needed'. timeSliceProcess := [ - [ - self timeSlicingLoop. - ] ifCurtailed:[ - timeSliceProcess := nil. - 'Processor [info]: timeslicer finished' infoPrintCR. - ] + [ + self timeSlicingLoop. + ] ifCurtailed:[ + timeSliceProcess := nil. + 'Processor [info]: timeslicer finished' infoPrintCR. + ] ] newProcess. timeSliceProcess - priority:HighestPriority; - name:'time slicer'; - restartable:true; - beSystemProcess; - resume. + priority:HighestPriority; + name:'time slicer'; + restartable:true; + beSystemProcess; + resume. " Processor stopTimeSlicing. @@ -2367,10 +2367,10 @@ "stop preemptive scheduling (timeSlicing)" timeSliceProcess notNil ifTrue: [ - timeSliceProcess terminate. - timeSliceProcess := nil. - scheduledProcesses := nil. - timeSliceNeededSemaphore := nil. + timeSliceProcess terminate. + timeSliceProcess := nil. + scheduledProcesses := nil. + timeSliceNeededSemaphore := nil. ] " @@ -2445,51 +2445,51 @@ wasBlocked := OperatingSystem blockInterrupts. useIOInterrupts ifTrue:[ - OperatingSystem disableIOInterruptsOn:aFileDescriptor. + OperatingSystem disableIOInterruptsOn:aFileDescriptor. ]. idx := readFdArray indexOf:aFileDescriptor startingAt:1. [idx ~~ 0] whileTrue:[ - readFdArray at:idx put:nil. - readCheckArray at:idx put:nil. - (sema := readSemaphoreArray at:idx) notNil ifTrue:[ - readSemaphoreArray at:idx put:nil. - semaCollection isNil ifTrue:[semaCollection := Set new]. - semaCollection add:sema. - ]. - idx := readFdArray indexOf:aFileDescriptor startingAt:idx+1. + readFdArray at:idx put:nil. + readCheckArray at:idx put:nil. + (sema := readSemaphoreArray at:idx) notNil ifTrue:[ + readSemaphoreArray at:idx put:nil. + semaCollection isNil ifTrue:[semaCollection := Set new]. + semaCollection add:sema. + ]. + idx := readFdArray indexOf:aFileDescriptor startingAt:idx+1. ]. idx := writeFdArray indexOf:aFileDescriptor startingAt:1. [idx ~~ 0] whileTrue:[ - writeFdArray at:idx put:nil. - writeCheckArray at:idx put:nil. - (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ - writeSemaphoreArray at:idx put:nil. - semaCollection isNil ifTrue:[semaCollection := Set new]. - semaCollection add:sema. - ]. - idx := writeFdArray indexOf:aFileDescriptor startingAt:idx+1. + writeFdArray at:idx put:nil. + writeCheckArray at:idx put:nil. + (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ + writeSemaphoreArray at:idx put:nil. + semaCollection isNil ifTrue:[semaCollection := Set new]. + semaCollection add:sema. + ]. + idx := writeFdArray indexOf:aFileDescriptor startingAt:idx+1. ]. idx := exceptFdArray indexOf:aFileDescriptor startingAt:1. [idx ~~ 0] whileTrue:[ - exceptFdArray at:idx put:nil. - (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ - exceptSemaphoreArray at:idx put:nil. - semaCollection isNil ifTrue:[semaCollection := Set new]. - semaCollection add:sema. - ]. - idx := exceptFdArray indexOf:aFileDescriptor startingAt:idx+1. + exceptFdArray at:idx put:nil. + (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ + exceptSemaphoreArray at:idx put:nil. + semaCollection isNil ifTrue:[semaCollection := Set new]. + semaCollection add:sema. + ]. + idx := exceptFdArray indexOf:aFileDescriptor startingAt:idx+1. ]. semaCollection isNil ifTrue:[ - semaCollection := #(). + semaCollection := #(). ] ifFalse:[ - doSignal ifTrue:[ - semaCollection do:[:eachSema| - eachSema signalForAll. - semaCollection := #(). - ]. - ]. + doSignal ifTrue:[ + semaCollection do:[:eachSema| + eachSema signalForAll. + semaCollection := #(). + ]. + ]. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ^ semaCollection @@ -2505,34 +2505,34 @@ idx := 0. [idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. idx ~~ 0] whileTrue:[ - useIOInterrupts ifTrue:[ - fd := readFdArray at:idx. - fd notNil ifTrue:[ - OperatingSystem disableIOInterruptsOn:fd - ]. - ]. - readFdArray at:idx put:nil. - readSemaphoreArray at:idx put:nil. - readCheckArray at:idx put:nil. + useIOInterrupts ifTrue:[ + fd := readFdArray at:idx. + fd notNil ifTrue:[ + OperatingSystem disableIOInterruptsOn:fd + ]. + ]. + readFdArray at:idx put:nil. + readSemaphoreArray at:idx put:nil. + readCheckArray at:idx put:nil. ]. idx := 0. [idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. idx ~~ 0] whileTrue:[ - useIOInterrupts ifTrue:[ - fd := writeFdArray at:idx. - fd notNil ifTrue:[ - OperatingSystem disableIOInterruptsOn:fd - ]. - ]. - writeFdArray at:idx put:nil. - writeSemaphoreArray at:idx put:nil. - writeCheckArray at:idx put:nil. + useIOInterrupts ifTrue:[ + fd := writeFdArray at:idx. + fd notNil ifTrue:[ + OperatingSystem disableIOInterruptsOn:fd + ]. + ]. + writeFdArray at:idx put:nil. + writeSemaphoreArray at:idx put:nil. + writeCheckArray at:idx put:nil. ]. idx := 0. [idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. idx ~~ 0] whileTrue:[ - exceptFdArray at:idx put:nil. - exceptSemaphoreArray at:idx put:nil. + exceptFdArray at:idx put:nil. + exceptSemaphoreArray at:idx put:nil. ]. self removeTimeoutForSemaphore:aSemaphore. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2592,20 +2592,20 @@ wasBlocked := OperatingSystem blockInterrupts. index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1. index ~~ 0 ifTrue:[ - timeoutArray at:index put:aMillisecondTime + timeoutArray at:index put:aMillisecondTime ] ifFalse:[ - index := timeoutArray identityIndexOf:nil startingAt:1. - index ~~ 0 ifTrue:[ - timeoutSemaphoreArray at:index put:aSemaphore. - timeoutArray at:index put:aMillisecondTime. - timeoutActionArray at:index put:nil. - timeoutProcessArray at:index put:nil - ] ifFalse:[ - timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:aSemaphore. - timeoutArray := timeoutArray copyWith:aMillisecondTime. - timeoutActionArray := timeoutActionArray copyWith:nil. - timeoutProcessArray := timeoutProcessArray copyWith:nil - ]. + index := timeoutArray identityIndexOf:nil startingAt:1. + index ~~ 0 ifTrue:[ + timeoutSemaphoreArray at:index put:aSemaphore. + timeoutArray at:index put:aMillisecondTime. + timeoutActionArray at:index put:nil. + timeoutProcessArray at:index put:nil + ] ifFalse:[ + timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:aSemaphore. + timeoutArray := timeoutArray copyWith:aMillisecondTime. + timeoutActionArray := timeoutActionArray copyWith:nil. + timeoutProcessArray := timeoutProcessArray copyWith:nil + ]. ]. anyTimeouts := true. @@ -2630,30 +2630,30 @@ aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil" aFileDescriptor isNil ifTrue:[ - idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil. - idx == 0 ifTrue:[ - "aSemaphore is not registered yet, have to create a new slot" - exceptFdArray := exceptFdArray copyWith:nil. - exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. - ] ifFalse:[ - slot := exceptSemaphoreArray at:idx. - slot isNil ifTrue:[ - exceptSemaphoreArray at:idx put:aSemaphore. - ] - ] + idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil. + idx == 0 ifTrue:[ + "aSemaphore is not registered yet, have to create a new slot" + exceptFdArray := exceptFdArray copyWith:nil. + exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. + ] ifFalse:[ + slot := exceptSemaphoreArray at:idx. + slot isNil ifTrue:[ + exceptSemaphoreArray at:idx put:aSemaphore. + ] + ] ] ifFalse:[ - idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil. - idx == 0 ifTrue:[ - "aFileDescriptor is not registered yet, have to create a new slot" - exceptFdArray := exceptFdArray copyWith:aFileDescriptor. - exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. - ] ifFalse:[ - slot := exceptFdArray at:idx. - slot isNil ifTrue:[ - exceptFdArray at:idx put:aFileDescriptor. - exceptSemaphoreArray at:idx put:aSemaphore. - ]. - ]. + idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil. + idx == 0 ifTrue:[ + "aFileDescriptor is not registered yet, have to create a new slot" + exceptFdArray := exceptFdArray copyWith:aFileDescriptor. + exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore. + ] ifFalse:[ + slot := exceptFdArray at:idx. + slot isNil ifTrue:[ + exceptFdArray at:idx put:aFileDescriptor. + exceptSemaphoreArray at:idx put:aSemaphore. + ]. + ]. "/ (useIOInterrupts and:[slot isNil]) ifTrue:[ "/ OperatingSystem enableIOInterruptsOn:aFileDescriptor "/ ]. @@ -2690,57 +2690,57 @@ aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil" aFileDescriptor isNil ifTrue:[ - idx := readSemaphoreArray identityIndexOf:aSemaphore or:nil. - idx == 0 ifTrue:[ - "aSemaphore is not registered yet, have to create a new slot" - readFdArray := readFdArray copyWith:nil. - readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. - readCheckArray := readCheckArray copyWith:aBlock. - ] ifFalse:[ - slot := readSemaphoreArray at:idx. - slot isNil ifTrue:[ - readSemaphoreArray at:idx put:aSemaphore. - readCheckArray at:idx put:aBlock - ] ifFalse:[ - "/ someone has already registered aSemaphore. - "/ Check if it is the block changes... - (readCheckArray at:idx) notNil ifTrue:[ - (readCheckArray at:idx) ~~ aBlock ifTrue:[ - 'Processor [info]: checkblock changed for read-check' infoPrintCR. - readCheckArray at:idx put:aBlock. - ]. - ]. - ]. - ] + idx := readSemaphoreArray identityIndexOf:aSemaphore or:nil. + idx == 0 ifTrue:[ + "aSemaphore is not registered yet, have to create a new slot" + readFdArray := readFdArray copyWith:nil. + readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. + readCheckArray := readCheckArray copyWith:aBlock. + ] ifFalse:[ + slot := readSemaphoreArray at:idx. + slot isNil ifTrue:[ + readSemaphoreArray at:idx put:aSemaphore. + readCheckArray at:idx put:aBlock + ] ifFalse:[ + "/ someone has already registered aSemaphore. + "/ Check if it is the block changes... + (readCheckArray at:idx) notNil ifTrue:[ + (readCheckArray at:idx) ~~ aBlock ifTrue:[ + 'Processor [info]: checkblock changed for read-check' infoPrintCR. + readCheckArray at:idx put:aBlock. + ]. + ]. + ]. + ] ] ifFalse:[ - idx := readFdArray identityIndexOf:aFileDescriptor or:nil. - idx == 0 ifTrue:[ - "aFileDescriptor is not registered yet, have to create a new slot" - readFdArray := readFdArray copyWith:aFileDescriptor. - readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. - readCheckArray := readCheckArray copyWith:aBlock. - ] ifFalse:[ - slot := readFdArray at:idx. - slot isNil ifTrue:[ - readFdArray at:idx put:aFileDescriptor. - readSemaphoreArray at:idx put:aSemaphore. - readCheckArray at:idx put:aBlock - ] ifFalse:[ - "/ someone has already registered aFileDescriptor. - "/ Check if it is the semaphore or block changes... - (readSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[ - 'Processor [info]: sema changed for read-check' infoPrintCR. - readSemaphoreArray at:idx put:aSemaphore. - ]. - (readCheckArray at:idx) ~~ aBlock ifTrue:[ - 'Processor [info]: checkblock changed for read-check' infoPrintCR. - readCheckArray at:idx put:aBlock. - ]. - ]. - ]. - (useIOInterrupts and:[slot isNil]) ifTrue:[ - OperatingSystem enableIOInterruptsOn:aFileDescriptor - ]. + idx := readFdArray identityIndexOf:aFileDescriptor or:nil. + idx == 0 ifTrue:[ + "aFileDescriptor is not registered yet, have to create a new slot" + readFdArray := readFdArray copyWith:aFileDescriptor. + readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. + readCheckArray := readCheckArray copyWith:aBlock. + ] ifFalse:[ + slot := readFdArray at:idx. + slot isNil ifTrue:[ + readFdArray at:idx put:aFileDescriptor. + readSemaphoreArray at:idx put:aSemaphore. + readCheckArray at:idx put:aBlock + ] ifFalse:[ + "/ someone has already registered aFileDescriptor. + "/ Check if it is the semaphore or block changes... + (readSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[ + 'Processor [info]: sema changed for read-check' infoPrintCR. + readSemaphoreArray at:idx put:aSemaphore. + ]. + (readCheckArray at:idx) ~~ aBlock ifTrue:[ + 'Processor [info]: checkblock changed for read-check' infoPrintCR. + readCheckArray at:idx put:aBlock. + ]. + ]. + ]. + (useIOInterrupts and:[slot isNil]) ifTrue:[ + OperatingSystem enableIOInterruptsOn:aFileDescriptor + ]. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2791,57 +2791,57 @@ aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil" aFileDescriptor isNil ifTrue:[ - idx := writeSemaphoreArray identityIndexOf:aSemaphore or:nil. - idx == 0 ifTrue:[ - "aSemaphore is not registered yet, have to create a new slot" - writeFdArray := writeFdArray copyWith:nil. - writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. - writeCheckArray := writeCheckArray copyWith:aBlock. - ] ifFalse:[ - slot := writeSemaphoreArray at:idx. - slot isNil ifTrue:[ - writeSemaphoreArray at:idx put:aSemaphore. - writeCheckArray at:idx put:aBlock - ] ifFalse:[ - "/ someone has already registered aSemaphore. - "/ Check if it is the block changes... - (writeCheckArray at:idx) notNil ifTrue:[ - (writeCheckArray at:idx) ~~ aBlock ifTrue:[ - 'Processor [info]: checkblock changed for write-check' infoPrintCR. - writeCheckArray at:idx put:aBlock. - ]. - ]. - ]. - ] + idx := writeSemaphoreArray identityIndexOf:aSemaphore or:nil. + idx == 0 ifTrue:[ + "aSemaphore is not registered yet, have to create a new slot" + writeFdArray := writeFdArray copyWith:nil. + writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. + writeCheckArray := writeCheckArray copyWith:aBlock. + ] ifFalse:[ + slot := writeSemaphoreArray at:idx. + slot isNil ifTrue:[ + writeSemaphoreArray at:idx put:aSemaphore. + writeCheckArray at:idx put:aBlock + ] ifFalse:[ + "/ someone has already registered aSemaphore. + "/ Check if it is the block changes... + (writeCheckArray at:idx) notNil ifTrue:[ + (writeCheckArray at:idx) ~~ aBlock ifTrue:[ + 'Processor [info]: checkblock changed for write-check' infoPrintCR. + writeCheckArray at:idx put:aBlock. + ]. + ]. + ]. + ] ] ifFalse:[ - idx := writeFdArray identityIndexOf:aFileDescriptor or:nil. - idx == 0 ifTrue:[ - "aFileDescriptor is not registered yet, have to create a new slot" - writeFdArray := writeFdArray copyWith:aFileDescriptor. - writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. - writeCheckArray := writeCheckArray copyWith:aBlock. - ] ifFalse:[ - slot := writeFdArray at:idx. - slot isNil ifTrue:[ - writeFdArray at:idx put:aFileDescriptor. - writeSemaphoreArray at:idx put:aSemaphore. - writeCheckArray at:idx put:aBlock - ] ifFalse:[ - "/ someone has already registered aFileDescriptor. - "/ Check if it is the semaphore or block changes... - (writeSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[ - 'Processor [info]: sema changed for write-check' infoPrintCR. - writeSemaphoreArray at:idx put:aSemaphore. - ]. - (writeCheckArray at:idx) ~~ aBlock ifTrue:[ - 'Processor [info]: checkblock changed for write-check' infoPrintCR. - writeCheckArray at:idx put:aBlock. - ]. - ]. - ]. - (useIOInterrupts and:[slot isNil]) ifTrue:[ - OperatingSystem enableIOInterruptsOn:aFileDescriptor - ]. + idx := writeFdArray identityIndexOf:aFileDescriptor or:nil. + idx == 0 ifTrue:[ + "aFileDescriptor is not registered yet, have to create a new slot" + writeFdArray := writeFdArray copyWith:aFileDescriptor. + writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. + writeCheckArray := writeCheckArray copyWith:aBlock. + ] ifFalse:[ + slot := writeFdArray at:idx. + slot isNil ifTrue:[ + writeFdArray at:idx put:aFileDescriptor. + writeSemaphoreArray at:idx put:aSemaphore. + writeCheckArray at:idx put:aBlock + ] ifFalse:[ + "/ someone has already registered aFileDescriptor. + "/ Check if it is the semaphore or block changes... + (writeSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[ + 'Processor [info]: sema changed for write-check' infoPrintCR. + writeSemaphoreArray at:idx put:aSemaphore. + ]. + (writeCheckArray at:idx) ~~ aBlock ifTrue:[ + 'Processor [info]: checkblock changed for write-check' infoPrintCR. + writeCheckArray at:idx put:aBlock. + ]. + ]. + ]. + (useIOInterrupts and:[slot isNil]) ifTrue:[ + OperatingSystem enableIOInterruptsOn:aFileDescriptor + ]. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2875,18 +2875,18 @@ Using IO interrupts reduces the idle CPU usage of ST/X by some percent (typically 2-7%). Notice: - some systems do not support IO-interrupts (or have a broken stdio-lib), - and this feature is always disabled; + some systems do not support IO-interrupts (or have a broken stdio-lib), + and this feature is always disabled; Also notice: - we found that in some Xlib-implementations, interrupted reads are not - handled correctly (especially in multi-headed applications), and this - feature should be disabled to avoid a blocking XPending. + we found that in some Xlib-implementations, interrupted reads are not + handled correctly (especially in multi-headed applications), and this + feature should be disabled to avoid a blocking XPending. If this method is used to disable IO interrupts in multi-headed apps, it should be invoked BEFORE the display event dispatcher processes are started." OperatingSystem supportsIOInterrupts ifTrue:[ - useIOInterrupts := aBoolean + useIOInterrupts := aBoolean ]. "Created: / 15.7.1998 / 13:32:29 / cg" @@ -3122,10 +3122,11 @@ firstBlockToEvaluate firstProcess n "{ Class: SmallInteger }" indexOfLastTimeout "{ Class: SmallInteger }" - halfSize "{ Class: SmallInteger }" - wasBlocked p| - - anyTimeouts ifFalse:[ ^ self]. + halfSize "{ Class: SmallInteger }" process wasBlocked| + + anyTimeouts ifFalse:[ + ^ self + ]. anyTimeouts := false. indexOfLastTimeout := 0. @@ -3140,6 +3141,7 @@ "/ 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. + wasBlocked := OperatingSystem blockInterrupts. now := OperatingSystem getMillisecondTime. n := timeoutArray size. 1 to:n do:[:index | @@ -3151,7 +3153,7 @@ sema := timeoutSemaphoreArray at:index. sema notNil ifTrue:[ timeoutSemaphoreArray at:index put:nil. - timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal). + timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal. sema signalOnceWithoutReschedule. ] ifFalse:[ "to support pure-events" @@ -3172,10 +3174,14 @@ blocksAndProcessesToEvaluate isNil ifTrue:[ blocksAndProcessesToEvaluate := OrderedCollection with:firstBlockToEvaluate - with:firstProcess. + with:firstProcess + with:block + with:(timeoutProcessArray at:index). + ] ifFalse:[ + blocksAndProcessesToEvaluate + add:block; + add:(timeoutProcessArray at:index). ]. - blocksAndProcessesToEvaluate add:block. - blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index). ]. timeoutActionArray at:index put:nil. timeoutProcessArray at:index put:nil. @@ -3194,14 +3200,10 @@ n > 20 ifTrue:[ halfSize := n // 2. (indexOfLastTimeout ~~ 0 and:[indexOfLastTimeout < halfSize]) ifTrue:[ - wasBlocked := OperatingSystem blockInterrupts. - (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived - timeoutArray := timeoutArray copyTo:halfSize. - timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize. - timeoutActionArray := timeoutActionArray copyTo:halfSize. - timeoutProcessArray := timeoutProcessArray copyTo:halfSize. - ]. - wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ]. + timeoutArray := timeoutArray copyTo:halfSize. + timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize. + timeoutActionArray := timeoutActionArray copyTo:halfSize. + timeoutProcessArray := timeoutProcessArray copyTo:halfSize. ]. ]. @@ -3209,7 +3211,7 @@ "/ above code avoided the creation of an OrderedCollection blocksAndProcessesToEvaluate isNil ifTrue:[ firstBlockToEvaluate notNil ifTrue:[ - timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal). + timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal. (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[ firstBlockToEvaluate value ] ifFalse:[ @@ -3236,12 +3238,12 @@ 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:[ + process := blocksAndProcessesToEvaluate at:index+1. + (process isNil or:[process == scheduler or:[PureEventDriven]]) ifTrue:[ block value. - timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal). + timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal. ] ifFalse:[ - p isDead ifTrue:[ + process isDead ifTrue:[ "/ a timedBlock for a process which has already terminated "/ issue a warning and do not execute it. "/ (executing here may be dangerous, since it would run at scheduler priority here, @@ -3253,17 +3255,18 @@ "/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[ "/ timeoutHandlerProcess interruptWith:block. "/ ] ifFalse:[ - ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') errorPrintCR. + ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , process name , '''') errorPrintCR. "/ ]. ] ifFalse:[ - timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal). - p interruptWith:block + timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal. + process interruptWith:block ] ] ] ]. - - "Modified: / 24-07-2017 / 16:15:36 / stefan" + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + + "Modified: / 25-07-2017 / 14:49:46 / stefan" "Modified: / 25-07-2017 / 11:27:00 / cg" ! @@ -3278,10 +3281,10 @@ wasBlocked := OperatingSystem blockInterrupts. index := timeoutActionArray identityIndexOf:aBlock startingAt:1. (index ~~ 0) ifTrue:[ - timeoutArray at:index put:nil. - timeoutActionArray at:index put:nil. - timeoutSemaphoreArray at:index put:nil. - timeoutProcessArray at:index put:nil. + timeoutArray at:index put:nil. + timeoutActionArray at:index put:nil. + timeoutSemaphoreArray at:index put:nil. + timeoutProcessArray at:index put:nil. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ! @@ -3318,14 +3321,14 @@ index := anID. (index > 0) ifTrue:[ - wasBlocked := OperatingSystem blockInterrupts. - - timeoutArray at:index put:nil. - timeoutActionArray at:index put:nil. - timeoutSemaphoreArray at:index put:nil. - timeoutProcessArray at:index put:nil. - - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + wasBlocked := OperatingSystem blockInterrupts. + + timeoutArray at:index put:nil. + timeoutActionArray at:index put:nil. + timeoutSemaphoreArray at:index put:nil. + timeoutProcessArray at:index put:nil. + + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ] "Created: 23.9.1996 / 14:32:33 / cg" @@ -3343,39 +3346,39 @@ index := anID. (anID notNil and:[index > 0]) ifTrue:[ - wasBlocked := OperatingSystem blockInterrupts. - - (aBlockOrSemaphore notNil - and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore - and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[ - 'Processor: trying to remove stale timeout id - ignored' errorPrintCR. - ] ifFalse:[ - timeoutArray at:index put:nil. - timeoutActionArray at:index put:nil. - timeoutSemaphoreArray at:index put:nil. - timeoutProcessArray at:index put:nil. - ]. - - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + wasBlocked := OperatingSystem blockInterrupts. + + (aBlockOrSemaphore notNil + and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore + and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[ + 'Processor: trying to remove stale timeout id - ignored' errorPrintCR. + ] ifFalse:[ + timeoutArray at:index put:nil. + timeoutActionArray at:index put:nil. + timeoutSemaphoreArray at:index put:nil. + timeoutProcessArray at:index put:nil. + ]. + + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ] ! timeoutHandlerProcess (timeoutHandlerProcess isNil or:[timeoutHandlerProcess isDead]) ifTrue:[ - timeoutHandlerProcess := - [ - [ - self timeoutHandlerProcessLoop. - ] ensure:[ - timeoutHandlerProcess := nil - ]. - ] newProcess. - - timeoutHandlerProcess - priority:TimingPriority; - name:'timeout handler'; - beSystemProcess; - resume. + timeoutHandlerProcess := + [ + [ + self timeoutHandlerProcessLoop. + ] ensure:[ + timeoutHandlerProcess := nil + ]. + ] newProcess. + + timeoutHandlerProcess + priority:TimingPriority; + name:'timeout handler'; + beSystemProcess; + resume. ]. ^ timeoutHandlerProcess. @@ -3419,7 +3422,7 @@ wasBlocked := OperatingSystem blockInterrupts. preWaitActions isNil ifTrue:[ - preWaitActions := OrderedCollection new + preWaitActions := OrderedCollection new ]. preWaitActions add:aBlock. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -3655,9 +3658,9 @@ gotIOInterrupt := true. activeProcess ~~ scheduler ifTrue:[ - interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 21.12.1995 / 16:17:40 / stefan" @@ -3675,91 +3678,91 @@ readFdArray/writeFdArray in the debugger)" readFdArray keysAndValuesDo:[:idx :fd | - |result sema| - - fd notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:(Array with:fd) writable:nil exception:nil - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. - readFdArray at:idx put:nil. - readCheckArray at:idx put:nil. - (sema := readSemaphoreArray at:idx) notNil ifTrue:[ - readSemaphoreArray at:idx put:nil. - self removeTimeoutForSemaphore:sema. - sema signalForAll. - ]. - ] - ]. + |result sema| + + fd notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:(Array with:fd) writable:nil exception:nil + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. + readFdArray at:idx put:nil. + readCheckArray at:idx put:nil. + (sema := readSemaphoreArray at:idx) notNil ifTrue:[ + readSemaphoreArray at:idx put:nil. + self removeTimeoutForSemaphore:sema. + sema signalForAll. + ]. + ] + ]. ]. writeFdArray keysAndValuesDo:[:idx :fd | - |result sema| - - fd notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:nil writable:(Array with:fd) exception:nil - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. - writeFdArray at:idx put:nil. - writeCheckArray at:idx put:nil. - (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ - writeSemaphoreArray at:idx put:nil. - self removeTimeoutForSemaphore:sema. - sema signalForAll. - ]. - ] - ] + |result sema| + + fd notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:nil writable:(Array with:fd) exception:nil + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. + writeFdArray at:idx put:nil. + writeCheckArray at:idx put:nil. + (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ + writeSemaphoreArray at:idx put:nil. + self removeTimeoutForSemaphore:sema. + sema signalForAll. + ]. + ] + ] ]. exceptFdArray keysAndValuesDo:[:idx :fd | - |result sema| - - fd notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:nil writable:nil exception:(Array with:fd) - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. - exceptFdArray at:idx put:nil. - (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ - exceptSemaphoreArray at:idx put:nil. - self removeTimeoutForSemaphore:sema. - sema signalForAll. - ]. - ] - ] + |result sema| + + fd notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:nil writable:nil exception:(Array with:fd) + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR. + exceptFdArray at:idx put:nil. + (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[ + exceptSemaphoreArray at:idx put:nil. + self removeTimeoutForSemaphore:sema. + sema signalForAll. + ]. + ] + ] ]. OperatingSystem isMSWINDOWSlike ifTrue:[ - "/ - "/ win32 does a WaitForMultipleObjects in select... - "/ unix waits for SIGCHLD - "/ - osChildExitActions keysDo:[:eachPid | - |result sema| - - eachPid notNil ifTrue:[ - result := OperatingSystem - selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid) - readableInto:nil writableInto:nil exceptionInto:nil - withTimeOut:0. - - result < 0 ifTrue:[ - 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR. - osChildExitActions safeRemoveKey:eachPid. - ] - ] - ]. + "/ + "/ win32 does a WaitForMultipleObjects in select... + "/ unix waits for SIGCHLD + "/ + osChildExitActions keysDo:[:eachPid | + |result sema| + + eachPid notNil ifTrue:[ + result := OperatingSystem + selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid) + readableInto:nil writableInto:nil exceptionInto:nil + withTimeOut:0. + + result < 0 ifTrue:[ + 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR. + osChildExitActions safeRemoveKey:eachPid. + ] + ] + ]. ]. "Modified: 12.4.1996 / 09:32:58 / stefan" @@ -3771,9 +3774,9 @@ what to do now." activeProcess ~~ scheduler ifTrue:[ - interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] ! @@ -3789,25 +3792,25 @@ n := timeoutArray size. 1 to:n do:[:index | - aTime := timeoutArray at:index. - aTime notNil ifTrue:[ - now isNil ifTrue:[ - now := OperatingSystem getMillisecondTime. - ]. - delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now. - delta <= 0 ifTrue:[ - ^ 0. - ]. - minDelta isNil ifTrue:[ - minDelta := delta - ] ifFalse:[ - minDelta := minDelta min:delta - ] - ] + aTime := timeoutArray at:index. + aTime notNil ifTrue:[ + now isNil ifTrue:[ + now := OperatingSystem getMillisecondTime. + ]. + delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now. + delta <= 0 ifTrue:[ + ^ 0. + ]. + minDelta isNil ifTrue:[ + minDelta := delta + ] ifFalse:[ + minDelta := minDelta min:delta + ] + ] ]. minDelta isNil ifTrue:[ - "this is safe, since always called with interruptsBlocked" - anyTimeouts := false. + "this is safe, since always called with interruptsBlocked" + anyTimeouts := false. ]. ^ minDelta @@ -3823,9 +3826,9 @@ of whichever process is currently running." activeProcess ~~ scheduler ifTrue:[ - interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal. + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 18.10.1996 / 20:35:54 / cg"