diff -r 58ac5885aa41 -r 901c91d6dd50 ProcessorScheduler.st --- a/ProcessorScheduler.st Tue Dec 14 19:44:10 1999 +0100 +++ b/ProcessorScheduler.st Tue Dec 14 19:46:28 1999 +0100 @@ -13,7 +13,7 @@ Object subclass:#ProcessorScheduler instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess activeProcessId currentPriority readFdArray readSemaphoreArray - readCheckArray writeFdArray writeSemaphoreArray timeoutArray + readCheckArray writeFdArray writeSemaphoreArray writeCheckArray timeoutArray timeoutActionArray timeoutProcessArray timeoutSemaphoreArray idleActions anyTimeouts dispatching interruptedProcess useIOInterrupts gotIOInterrupt osChildExitActions @@ -113,7 +113,7 @@ processes are only timesliced, if running at or below this priority. - EventPollingInterval for systems which do not support select on + EventPollingInterval for systems which do not support select on a fileDescriptor: the polling interval in millis. most interesting methods: @@ -176,16 +176,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. @@ -193,10 +193,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. @@ -307,17 +307,17 @@ This may raise an exception, if a VM process could not be created." MaxNumberOfProcesses notNil ifTrue:[ - KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[ - (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[ - " - the number of processes has reached the (soft) limit. - This limit prevents runaway programs from creating too many - processes. If you continue in the debugger, the process will be - created as usual. If you dont want this, abort or terminate. - " - self error:'too many processes'. - ] - ] + KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[ + (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[ + " + the number of processes has reached the (soft) limit. + This limit prevents runaway programs from creating too many + processes. If you continue in the debugger, the process will be + created as usual. If you dont want this, abort or terminate. + " + self error:'too many processes'. + ] + ] ]. %{ @@ -325,11 +325,11 @@ extern int __threadCreate(); tid = __threadCreate(aProcess, - 0 /* stackSize: no longer needed */, - __isSmallInteger(id) ? __intVal(id) /* assign id */ - : -1 /* let VM assign one */ ); + 0 /* stackSize: no longer needed */, + __isSmallInteger(id) ? __intVal(id) /* assign id */ + : -1 /* let VM assign one */ ); if (tid) { - RETURN ( __MKSMALLINT(tid)); + RETURN ( __MKSMALLINT(tid)); } %} . @@ -432,21 +432,28 @@ !ProcessorScheduler methodsFor:'I/O event actions'! disableFd:aFileDescriptor - "disable block events on aFileDescriptor. + "obsolete event support: disable block events on aFileDescriptor. This is a leftover support for pure-event systems and may vanish." |idx "{Class: SmallInteger }" wasBlocked| wasBlocked := OperatingSystem blockInterrupts. + useIOInterrupts ifTrue:[ + OperatingSystem disableIOInterruptsOn:aFileDescriptor + ]. + idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1. idx ~~ 0 ifTrue:[ - useIOInterrupts ifTrue:[ - OperatingSystem disableIOInterruptsOn:aFileDescriptor - ]. - readFdArray at:idx put:nil. - readCheckArray at:idx put:nil. - readSemaphoreArray at:idx put:nil + readFdArray at:idx put:nil. + readCheckArray at:idx put:nil. + readSemaphoreArray at:idx put:nil + ]. + idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1. + idx ~~ 0 ifTrue:[ + writeFdArray at:idx put:nil. + writeCheckArray at:idx put:nil. + writeSemaphoreArray at:idx put:nil ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -454,7 +461,7 @@ ! enableIOAction:aBlock onInput:aFileDescriptor - "half-obsolete event support: arrange for aBlock to be + "obsolete event support: arrange for aBlock to be evaluated when input on aFileDescriptor arrives. This is a leftover support for pure-event systems and may vanish." @@ -469,19 +476,19 @@ 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]. @@ -579,42 +586,55 @@ handle all timeout actions " anyTimeouts ifTrue:[ - self evaluateTimeouts + self evaluateTimeouts ]. "first do a quick check for semaphores using checkActions - this is needed for devices like the X-connection, where some events might be in the event queue but the sockets input queue is empty. - Without these checks, a select might block even though there is work to do + Without these checks, a select might block even though there is work to do. + Also, this is needed for poor MSDOS, where WaitForObject does not work with + sockets and pipes (sigh) " any := false. nActions := readCheckArray size. 1 to:nActions do:[:index | - checkBlock := readCheckArray at:index. - (checkBlock notNil and:[checkBlock value]) ifTrue:[ - sema := readSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - ]. - any := true. - ] + checkBlock := readCheckArray at:index. + (checkBlock notNil and:[checkBlock value]) ifTrue:[ + sema := readSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + ]. + any := true. + ] + ]. + nActions := writeCheckArray size. + 1 to:nActions do:[:index | + checkBlock := writeCheckArray at:index. + (checkBlock notNil and:[checkBlock value]) ifTrue:[ + sema := writeSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + ]. + any := true. + ] ]. "now, someone might be runnable ..." p := self highestPriorityRunnableProcess. p isNil ifTrue:[ - "/ no one runnable, hard wait for event or timeout - - self waitForEventOrTimeout. - - "/ check for OS process termination - gotChildSignalInterrupt ifTrue:[ - gotChildSignalInterrupt := false. - self handleChildSignalInterrupt - ]. + "/ no one runnable, hard wait for event or timeout + + self waitForEventOrTimeout. + + "/ check for OS process termination + gotChildSignalInterrupt ifTrue:[ + gotChildSignalInterrupt := false. + self handleChildSignalInterrupt + ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self + ^ self ]. pri := p priority. @@ -645,13 +665,13 @@ " pri < TimingPriority ifTrue:[ - anyTimeouts ifTrue:[ - millis := self timeToNextTimeout. - millis == 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + anyTimeouts ifTrue:[ + millis := self timeToNextTimeout. + millis == 0 ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ^ self ] - ] + ] ]. " @@ -664,37 +684,37 @@ pri < UserInterruptPriority ifTrue:[ "comment out this if above is uncommented" - anyTimeouts ifTrue:[ - millis := self timeToNextTimeout. - millis == 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + anyTimeouts ifTrue:[ + millis := self timeToNextTimeout. + millis == 0 ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ^ self ]. - ]. + ]. "---" - useIOInterrupts ifTrue:[ + useIOInterrupts ifTrue:[ "/ readFdArray do:[:fd | "/ (fd notNil and:[fd >= 0]) ifTrue:[ "/ OperatingSystem enableIOInterruptsOn:fd "/ ]. "/ ]. - ] ifFalse:[ - millis notNil ifTrue:[ - millis := millis min:EventPollingInterval - ] ifFalse:[ - millis := EventPollingInterval - ] - ] + ] ifFalse:[ + millis notNil ifTrue:[ + millis := millis min:EventPollingInterval + ] ifFalse:[ + millis := EventPollingInterval + ] + ] ]. millis notNil ifTrue:[ - "schedule a clock interrupt after millis milliseconds" - OperatingSystem enableTimer:millis rounded. + "schedule a clock interrupt after millis milliseconds" + OperatingSystem enableTimer:millis rounded. ]. scheduledProcesses notNil ifTrue:[ - scheduledProcesses add:p + scheduledProcesses add:p ]. " @@ -704,17 +724,17 @@ self threadSwitch:p. "... when we arrive here, we are back on stage. - Either by an ALARM or IO signal, or by a suspend of another process + Either by an ALARM or IO signal, or by a suspend of another process " millis notNil ifTrue:[ - OperatingSystem disableTimer. + OperatingSystem disableTimer. ]. "/ check for OS process termination gotChildSignalInterrupt ifTrue:[ - gotChildSignalInterrupt := false. - self handleChildSignalInterrupt + gotChildSignalInterrupt := false. + self handleChildSignalInterrupt ]. "/ check for new input @@ -722,8 +742,8 @@ OperatingSystem unblockInterrupts. (gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[ - gotIOInterrupt := false. - self checkForInputWithTimeout:0. + gotIOInterrupt := false. + self checkForInputWithTimeout:0. ]. wasBlocked ifTrue:[OperatingSystem blockInterrupts]. @@ -796,9 +816,9 @@ p l| KnownProcesses isNil ifTrue:[ - KnownProcesses := WeakArray new:30. - KnownProcesses addDependent:self class. - KnownProcessIds := OrderedCollection new. + KnownProcesses := WeakArray new:30. + KnownProcesses addDependent:self class. + KnownProcessIds := OrderedCollection new. ]. " @@ -811,6 +831,7 @@ readCheckArray := Array new:5. readSemaphoreArray := Array new:5. writeFdArray := Array new:3. + writeCheckArray := Array new:3. writeSemaphoreArray := Array new:3. timeoutArray := Array new:5. timeoutSemaphoreArray := Array new:5. @@ -820,7 +841,7 @@ anyTimeouts := false. dispatching := false. exitWhenNoMoreUserProcesses isNil ifTrue:[ - exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ? + exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ? ]. useIOInterrupts := OperatingSystem supportsIOInterrupts. gotIOInterrupt := false. @@ -877,16 +898,16 @@ " processesToRestart := OrderedCollection new. KnownProcesses do:[:p | - (p notNil and:[p ~~ 0]) 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 ~~ 0]) 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. @@ -897,7 +918,7 @@ self initialize. processesToRestart do:[:p | - p imageRestart + p imageRestart ] "Modified: / 7.6.1998 / 02:23:56 / cg" @@ -915,19 +936,19 @@ |id pri l s| OperatingSystem interruptsBlocked ifFalse:[ - MiniDebugger - enterWithMessage:'immediateInterrupt with no interruptsBlocked' - mayProceed:true. + MiniDebugger + enterWithMessage:'immediateInterrupt with no interruptsBlocked' + mayProceed:true. ]. (why == 2) ifTrue:[ - s := #wrapWait. + s := #wrapWait. ] ifFalse:[ - (why == 3) ifTrue:[ - s := #osWait. - ] ifFalse:[ - s := #stopped. - ]. + (why == 3) ifTrue:[ + s := #osWait. + ] ifFalse:[ + s := #stopped. + ]. ]. activeProcess setStateTo:s if:#active. @@ -938,9 +959,9 @@ the ifAbsent block, because [] is a shared cheap block, created at compile time " (l isNil or:[(l remove:activeProcess ifAbsent:nil) isNil]) ifTrue:[ - "/ 'Processor [warning]: bad immediateInterrupt: not on run list' errorPrintCR. - MiniDebugger enterWithMessage:'bad immediateInterrupt: not on run list' mayProceed:true. - ^ self + "/ 'Processor [warning]: bad immediateInterrupt: not on run list' errorPrintCR. + MiniDebugger enterWithMessage:'bad immediateInterrupt: not on run list' mayProceed:true. + ^ self ]. "/ id := scheduler id. @@ -967,40 +988,40 @@ |index pri aProcess l| OperatingSystem interruptsBlocked ifFalse:[ - MiniDebugger - enterWithMessage:'resumeImmediateInterrupt with no interruptsBlocked' - mayProceed:true. + MiniDebugger + enterWithMessage:'resumeImmediateInterrupt with no interruptsBlocked' + mayProceed:true. ]. index := KnownProcessIds identityIndexOf:id. index ~~ 0 ifTrue:[ - aProcess := KnownProcesses at:index. - "/ - "/ CG: the situation below 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. - "/ + aProcess := KnownProcesses at:index. + "/ + "/ CG: the situation below 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. + "/ "/ aProcess state ~~ #wrapWait ifTrue:[ "/ 'ProcSched [info]: oops - resumeImmIRQ for non wrapWait process' infoPrintCR. "/ ^ self "/ ]. - pri := aProcess priority. - l := quiescentProcessLists at:pri. - "if already running, ignore" - l notNil ifTrue:[ - (l identityIndexOf:aProcess) ~~ 0 ifTrue:[ - 'ProcSched [info]: oops - resumeImmIRQ for already running process' infoPrintCR. - ^ self - ] - ] ifFalse:[ - l := LinkedList new. - quiescentProcessLists at:pri put:l. - ]. - l addLast:aProcess. - aProcess state:#run. + pri := aProcess priority. + l := quiescentProcessLists at:pri. + "if already running, ignore" + l notNil ifTrue:[ + (l identityIndexOf:aProcess) ~~ 0 ifTrue:[ + 'ProcSched [info]: oops - resumeImmIRQ for already running process' infoPrintCR. + ^ self + ] + ] ifFalse:[ + l := LinkedList new. + quiescentProcessLists at:pri put:l. + ]. + l addLast:aProcess. + aProcess state:#run. ] ifFalse:[ - 'ProcSched [info]: oops - resumeImmIRQ for unknown process' infoPrintCR. + 'ProcSched [info]: oops - resumeImmIRQ for unknown process' infoPrintCR. ] "Modified: / 28.9.1998 / 11:36:53 / cg" @@ -1016,8 +1037,8 @@ gotChildSignalInterrupt := true. activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 12.4.1996 / 10:12:18 / stefan" @@ -1085,62 +1106,62 @@ |pid blocked osProcessStatus| OperatingSystem supportsChildInterrupts ifTrue:[ - "/ SIGCHLD is supported, - "/ aBlock will be evaluated, as soon as a SIGCHLD interrupt for pid has been received. - - OperatingSystem enableChildSignalInterrupts. - blocked := OperatingSystem blockInterrupts. - pid := aBlockReturningPid value. - pid notNil ifTrue:[ - osChildExitActions at:pid put:actionBlock. - ]. - blocked ifFalse:[ - OperatingSystem unblockInterrupts. - ]. + "/ SIGCHLD is supported, + "/ aBlock will be evaluated, as soon as a SIGCHLD interrupt for pid has been received. + + OperatingSystem enableChildSignalInterrupts. + blocked := OperatingSystem blockInterrupts. + pid := aBlockReturningPid value. + pid notNil ifTrue:[ + osChildExitActions at:pid put:actionBlock. + ]. + blocked ifFalse:[ + OperatingSystem unblockInterrupts. + ]. ] ifFalse:[ - "/ SIGCHLD is not supported, fork a high prio process - "/ to poll for for the exit of pid. - - blocked := OperatingSystem blockInterrupts. - pid := aBlockReturningPid value. - pid notNil ifTrue:[ - osChildExitActions at:pid put:actionBlock. - ]. - blocked ifFalse:[ - OperatingSystem unblockInterrupts. - ]. - - [ - [ - |polling myDelay t| - - polling := true. - myDelay := Delay forMilliseconds:(t := EventPollingInterval). - [polling] whileTrue:[ - t ~~ EventPollingInterval ifTrue:[ - "/ interval changed -> need a new delay - myDelay delay:(t := EventPollingInterval). - ]. - myDelay wait. - (osChildExitActions includesKey:pid) ifFalse:[ - polling := false. - ] ifTrue:[ - osProcessStatus := OperatingSystem childProcessWait:false pid:pid. - osProcessStatus notNil ifTrue:[ - (osProcessStatus pid = pid) ifTrue:[ - osChildExitActions removeKey:pid ifAbsent:nil. - actionBlock value:osProcessStatus. - polling := false. - ] ifFalse:[ - osProcessStatus stillAlive - ] - ] - ]. - ] - ] valueOnUnwindDo:[ - osChildExitActions removeKey:pid ifAbsent:nil - ] - ] forkAt:TimingPriority. + "/ SIGCHLD is not supported, fork a high prio process + "/ to poll for for the exit of pid. + + blocked := OperatingSystem blockInterrupts. + pid := aBlockReturningPid value. + pid notNil ifTrue:[ + osChildExitActions at:pid put:actionBlock. + ]. + blocked ifFalse:[ + OperatingSystem unblockInterrupts. + ]. + + [ + [ + |polling myDelay t| + + polling := true. + myDelay := Delay forMilliseconds:(t := EventPollingInterval). + [polling] whileTrue:[ + t ~~ EventPollingInterval ifTrue:[ + "/ interval changed -> need a new delay + myDelay delay:(t := EventPollingInterval). + ]. + myDelay wait. + (osChildExitActions includesKey:pid) ifFalse:[ + polling := false. + ] ifTrue:[ + osProcessStatus := OperatingSystem childProcessWait:false pid:pid. + osProcessStatus notNil ifTrue:[ + (osProcessStatus pid = pid) ifTrue:[ + osChildExitActions removeKey:pid ifAbsent:nil. + actionBlock value:osProcessStatus. + polling := false. + ] ifFalse:[ + osProcessStatus stillAlive + ] + ] + ]. + ] + ] valueOnUnwindDo:[ + osChildExitActions removeKey:pid ifAbsent:nil + ] + ] forkAt:TimingPriority. ]. ^ pid @@ -1168,15 +1189,15 @@ and, make the process runnable " aProcess state ~~ #stopped ifTrue:[ - aProcess state == #osWait ifTrue:[ - ('Processor [warning]: ignored scheduleForInterrupt:Process ',(aProcess id) printString,' state osWait') errorPrintCR. - "/ self halt. - ] ifFalse:[ - " - and, make the process runnable - " - self resume:aProcess - ] + aProcess state == #osWait ifTrue:[ + ('Processor [warning]: ignored scheduleForInterrupt:Process ',(aProcess id) printString,' state osWait') errorPrintCR. + "/ self halt. + ] ifFalse:[ + " + and, make the process runnable + " + self resume:aProcess + ] ] "Modified: / 24.8.1998 / 18:31:32 / cg" @@ -1228,9 +1249,9 @@ extern OBJ ___threadSwitch(); if (__isSmallInteger(id)) { - ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0); + ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0); } else { - ok = false; + ok = false; } %}. "time passes spent in some other process ... @@ -1242,40 +1263,40 @@ currentPriority := oldProcess priority. ok == true ifFalse:[ - " - switch failed for some reason - - destroy (hard-terminate) the bad process. - This happens when: - - the stack went above the absolute limit - (VM switches back to scheduler) - - a halted process cannot execute its interrupt - actions (win32 only) - " - (id := p id) ~~ 0 ifTrue:[ - id notNil ifTrue:[ - 'Processor [warning]: problem with process ' errorPrint. - id errorPrint. - (nm := p name) notNil ifTrue:[ - ' (' errorPrint. nm errorPrint. ')' errorPrint. - ]. + " + switch failed for some reason - + destroy (hard-terminate) the bad process. + This happens when: + - the stack went above the absolute limit + (VM switches back to scheduler) + - a halted process cannot execute its interrupt + actions (win32 only) + " + (id := p id) ~~ 0 ifTrue:[ + id notNil ifTrue:[ + 'Processor [warning]: problem with process ' errorPrint. + id errorPrint. + (nm := p name) notNil ifTrue:[ + ' (' errorPrint. nm errorPrint. ')' errorPrint. + ]. ok == #halted ifTrue:[ "/ that process was halted (win32 only) p state:#halted. - '; stopped it.' errorPrintCR. - self suspend:p. + '; stopped it.' errorPrintCR. + self suspend:p. ] ifFalse:[ - '; hard-terminate it.' errorPrintCR. - 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR. - p state:#cleanup. - self terminateNoSignal:p. + '; hard-terminate it.' errorPrintCR. + 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR. + p state:#cleanup. + self terminateNoSignal:p. ] - ] - ] + ] + ] ]. zombie notNil ifTrue:[ - self class threadDestroy:zombie. - zombie := nil + self class threadDestroy:zombie. + zombie := nil ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ! ! @@ -1593,44 +1614,44 @@ " newPrio := prio. newPrio < 1 ifTrue:[ - newPrio := 1. + newPrio := 1. ] ifFalse:[ - newPrio > HighestPriority ifTrue:[ - newPrio := HighestPriority - ] + newPrio > HighestPriority ifTrue:[ + newPrio := HighestPriority + ] ]. [ - wasBlocked := OperatingSystem blockInterrupts. - - aProcess setPriority:newPrio. - - oldList := quiescentProcessLists at:oldPrio. - oldList notNil ifTrue:[ - (oldList remove:aProcess ifAbsent:nil) notNil ifTrue:[ - newList := quiescentProcessLists at:newPrio. - newList isNil ifTrue:[ - quiescentProcessLists at:newPrio put:(newList := LinkedList new). - ]. - newList addLast:aProcess. - - "if its the current process lowering its prio - or another one raising, we have to reschedule" - - aProcess == activeProcess ifTrue:[ - currentPriority := newPrio. - newPrio < oldPrio ifTrue:[ - self threadSwitch:scheduler. - ] - ] ifFalse:[ - newPrio > currentPriority ifTrue:[ - self threadSwitch:aProcess. - ] - ]. - ] - ] + wasBlocked := OperatingSystem blockInterrupts. + + aProcess setPriority:newPrio. + + oldList := quiescentProcessLists at:oldPrio. + oldList notNil ifTrue:[ + (oldList remove:aProcess ifAbsent:nil) notNil ifTrue:[ + newList := quiescentProcessLists at:newPrio. + newList isNil ifTrue:[ + quiescentProcessLists at:newPrio put:(newList := LinkedList new). + ]. + newList addLast:aProcess. + + "if its the current process lowering its prio + or another one raising, we have to reschedule" + + aProcess == activeProcess ifTrue:[ + currentPriority := newPrio. + newPrio < oldPrio ifTrue:[ + self threadSwitch:scheduler. + ] + ] ifFalse:[ + newPrio > currentPriority ifTrue:[ + self threadSwitch:aProcess. + ] + ]. + ] + ] ] valueNowOrOnUnwindDo:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. ] "Modified: / 4.8.1998 / 00:08:54 / cg" @@ -1675,11 +1696,11 @@ aProcess == activeProcess ifTrue:[ - "special handling for waiting schedulers" - aProcess == scheduler ifTrue:[ - suspendScheduler := false. - ]. - ^ self + "special handling for waiting schedulers" + aProcess == scheduler ifTrue:[ + suspendScheduler := false. + ]. + ^ self ]. wasBlocked := OperatingSystem blockInterrupts. @@ -1689,13 +1710,13 @@ l := quiescentProcessLists at:pri. "if already running, ignore" l notNil ifTrue:[ - (l identityIndexOf:aProcess) ~~ 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self - ] + (l identityIndexOf:aProcess) ~~ 0 ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ self + ] ] ifFalse:[ - l := LinkedList new. - quiescentProcessLists at:pri put:l. + l := LinkedList new. + quiescentProcessLists at:pri put:l. ]. l addLast:aProcess. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -1735,21 +1756,21 @@ (aProcess isNil or:[aProcess id isNil]) ifTrue:[^ self]. (s := aProcess state) == #osWait ifTrue:[ - 'Processor [warning]: bad resume: #osWait' errorPrintCR. - "/ MiniDebugger enterWithMessage:'bad resume: state osWait'. - ^ self. + 'Processor [warning]: bad resume: #osWait' errorPrintCR. + "/ MiniDebugger enterWithMessage:'bad resume: state osWait'. + ^ self. ]. s == #stopped ifTrue:[ - 'Processor [warning]: bad resume: #stopped' errorPrintCR. - ^ self. + 'Processor [warning]: bad resume: #stopped' errorPrintCR. + ^ self. ]. aProcess == activeProcess ifTrue:[ - "special handling for waiting schedulers" - aProcess == scheduler ifTrue:[ - suspendScheduler := false. - ]. - ^ self + "special handling for waiting schedulers" + aProcess == scheduler ifTrue:[ + suspendScheduler := false. + ]. + ^ self ]. wasBlocked := OperatingSystem blockInterrupts. @@ -1759,27 +1780,27 @@ l := quiescentProcessLists at:pri. "if already running, ignore" l notNil ifTrue:[ - (l identityIndexOf:aProcess) ~~ 0 ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - ^ self - ] + (l identityIndexOf:aProcess) ~~ 0 ifTrue:[ + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + ^ self + ] ] ifFalse:[ - l := LinkedList new. - quiescentProcessLists at:pri put:l. + l := LinkedList new. + quiescentProcessLists at:pri put:l. ]. l addLast:aProcess. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. (pri > currentPriority) ifTrue:[ - " - its prio is higher; immediately transfer control to it - " - self threadSwitch:aProcess + " + its prio is higher; immediately transfer control to it + " + self threadSwitch:aProcess ] ifFalse:[ - " - its prio is lower; it will have to wait for a while ... - " - aProcess state:#run + " + its prio is lower; it will have to wait for a while ... + " + aProcess state:#run ] "Modified: / 24.8.1998 / 18:28:42 / cg" @@ -1801,8 +1822,8 @@ If the process is the current one, reschedule. Notice: - This method should only be called by Process>>suspend or - Process>>suspendWithState:" + This method should only be called by Process>>suspend or + Process>>suspendWithState:" |pri l p wasBlocked| @@ -1810,26 +1831,26 @@ some debugging stuff " aProcess isNil ifTrue:[ - InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: nil suspend'. - ^ self + InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: nil suspend'. + ^ self ]. aProcess id isNil ifTrue:[ - InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: bad suspend: already dead'. - self threadSwitch:scheduler. - ^ self + InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: bad suspend: already dead'. + self threadSwitch:scheduler. + ^ self ]. aProcess == scheduler ifTrue:[ - "only the scheduler may suspend itself" - activeProcess == scheduler ifTrue:[ - suspendScheduler := true. - [suspendScheduler] whileTrue:[ - self dispatch. - ]. - ^ self - ]. - - InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: scheduler should never be suspended'. - ^ self + "only the scheduler may suspend itself" + activeProcess == scheduler ifTrue:[ + suspendScheduler := true. + [suspendScheduler] whileTrue:[ + self dispatch. + ]. + ^ self + ]. + + InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: scheduler should never be suspended'. + ^ self ]. wasBlocked := OperatingSystem blockInterrupts. @@ -1841,23 +1862,23 @@ the ifAbsent block, because [] is a shared cheap block, created at compile time " (l isNil or:[(l remove:aProcess ifAbsent:nil) isNil]) ifTrue:[ - wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. - 'Processor [warning]: bad suspend: not on run list' errorPrintCR. - "/ MiniDebugger enterWithMessage:'bad suspend: not on run list'. - aProcess == activeProcess ifTrue:[ - self threadSwitch:scheduler. - ]. - ^ self + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. + 'Processor [warning]: bad suspend: not on run list' errorPrintCR. + "/ MiniDebugger enterWithMessage:'bad suspend: not on run list'. + aProcess == activeProcess ifTrue:[ + self threadSwitch:scheduler. + ]. + ^ self ]. (aProcess == activeProcess) ifTrue:[ - "we can immediately switch sometimes" - l isEmpty ifFalse:[ - p := l first - ] ifTrue:[ - p := scheduler - ]. - self threadSwitch:p + "we can immediately switch sometimes" + l isEmpty ifFalse:[ + p := l first + ] ifTrue:[ + p := scheduler + ]. + self threadSwitch:p ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2003,63 +2024,63 @@ |processesDecreased 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 prio| - - "/ decrease priority of processes that did run - (range := aProcess priorityRange) notNil ifTrue:[ - aProcess priority > range start ifTrue:[ - processesDecreased isNil ifTrue:[ - processesDecreased := IdentitySet new. - ]. - processesDecreased add:aProcess. - ] - ] - ]. - - processesDecreased notNil ifTrue:[ - processesDecreased 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 do:[:aProcess | - |range prio| - - (range := aProcess priorityRange) notNil ifTrue:[ - (processesDecreased isNil - or:[(processesDecreased includes:aProcess) not]) ifTrue:[ - aProcess priority < range stop ifTrue:[ - processesToIncrease isNil ifTrue:[ - processesToIncrease := IdentitySet 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 prio| + + "/ decrease priority of processes that did run + (range := aProcess priorityRange) notNil ifTrue:[ + aProcess priority > range start ifTrue:[ + processesDecreased isNil ifTrue:[ + processesDecreased := IdentitySet new. + ]. + processesDecreased add:aProcess. + ] + ] + ]. + + processesDecreased notNil ifTrue:[ + processesDecreased 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 do:[:aProcess | + |range prio| + + (range := aProcess priorityRange) notNil ifTrue:[ + (processesDecreased isNil + or:[(processesDecreased includes:aProcess) not]) ifTrue:[ + aProcess priority < range stop ifTrue:[ + processesToIncrease isNil ifTrue:[ + processesToIncrease := IdentitySet new. + ]. + processesToIncrease add:aProcess + ] + ] + ] + ] + ] + ]. + processesToIncrease notNil ifTrue:[ + processesToIncrease do:[:aProcess | + self changePriority:(aProcess priority + 1) for:aProcess. + ]. + ]. ]. "Modified: / 21.9.1998 / 09:07:54 / cg" @@ -2087,8 +2108,8 @@ i := TimeSlicingPriorityLimit. [(i > 0) and:[(list := quiescentProcessLists at:i) size <= 1]] whileTrue: [i := i - 1]. i ~~ 0 ifTrue: [ - "/ shuffle that list - list addLast:(list removeFirst). + "/ shuffle that list + list addLast:(list removeFirst). ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2101,37 +2122,37 @@ timeSliceProcess notNil ifTrue: [^ self]. timeSliceProcess := [ - [ - |myDelay t flipFlop| - - myDelay := Delay forMilliseconds:(t := TimeSliceInterval). - flipFlop := true. - - [true] whileTrue: [ - t ~~ TimeSliceInterval ifTrue:[ - "/ interval changed -> need a new delay - myDelay delay:(t := TimeSliceInterval). - ]. - myDelay wait. - self slice. - - "/ every other tick, recompute priorities. - flipFlop := flipFlop not. - flipFlop ifTrue:[ - scheduledProcesses isNil ifTrue:[ - scheduledProcesses := IdentitySet new. - ] ifFalse:[ - supportDynamicPriorities == true ifTrue:[ - self recomputeDynamicPriorities. - ]. - scheduledProcesses removeAll. - ]. - - ]. - ] - ] valueOnUnwindDo:[ - timeSliceProcess := nil - ] + [ + |myDelay t flipFlop| + + myDelay := Delay forMilliseconds:(t := TimeSliceInterval). + flipFlop := true. + + [true] whileTrue: [ + t ~~ TimeSliceInterval ifTrue:[ + "/ interval changed -> need a new delay + myDelay delay:(t := TimeSliceInterval). + ]. + myDelay wait. + self slice. + + "/ every other tick, recompute priorities. + flipFlop := flipFlop not. + flipFlop ifTrue:[ + scheduledProcesses isNil ifTrue:[ + scheduledProcesses := IdentitySet new. + ] ifFalse:[ + supportDynamicPriorities == true ifTrue:[ + self recomputeDynamicPriorities. + ]. + scheduledProcesses removeAll. + ]. + + ]. + ] + ] valueOnUnwindDo:[ + timeSliceProcess := nil + ] ] newProcess. timeSliceProcess priority:HighestPriority. timeSliceProcess name:'time slicer'. @@ -2152,9 +2173,9 @@ "stop preemptive scheduling (timeSlicing)" timeSliceProcess notNil ifTrue: [ - timeSliceProcess terminate. - timeSliceProcess := nil. - scheduledProcesses := nil + timeSliceProcess terminate. + timeSliceProcess := nil. + scheduledProcesses := nil ] " @@ -2198,36 +2219,37 @@ wasBlocked := OperatingSystem blockInterrupts. idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt: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. - idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + 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 := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt: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. - idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + 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 := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1. [idx ~~ 0] whileTrue:[ - timeoutArray at:idx put:nil. - timeoutSemaphoreArray at:idx put:nil. - timeoutActionArray at:idx put:nil. - timeoutProcessArray at:idx put:nil. - idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. + timeoutArray at:idx put:nil. + timeoutSemaphoreArray at:idx put:nil. + timeoutActionArray at:idx put:nil. + timeoutProcessArray at:idx put:nil. + idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1. ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2307,10 +2329,25 @@ self signal:aSemaphore onInput:aFileDescriptor orCheck:nil ! +signal:aSemaphore onInputStream:aStream + "arrange for a semaphore to be triggered when input on aStream arrives. + This will do a select, if the OS supports selecting on that filedescriptor, + otherwise, it will be polled every few milliseconds (MSDOS)." + + aStream canBeSelected ifTrue:[ + "/ can this stream be selected on ? + self signal:aSemaphore onInput:aStream aFileDescriptor orCheck:nil + ] ifFalse:[ + "/ nope - must poll ... + self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking] + ] +! + signal:aSemaphore onInput:aFileDescriptor orCheck:aBlock "arrange for a semaphore to be triggered when input on aFileDescriptor - arrives OR checkblock evaluates to true. The checkBlock will be evaluated - by the scheduler from time to time (i.e. every few milliseconds). + arrives OR checkblock evaluates to true. + The checkBlock will be evaluated by the scheduler from time to time + (i.e. every few milliseconds). (This is req'd for buffered input, where a select may not detect data which has already been read into a buffer - as in Xlib. Or on systems, where we cannot select on a displays eventQ, such as windows)" @@ -2323,27 +2360,33 @@ wasBlocked := OperatingSystem blockInterrupts. fd isNil ifTrue:[ - 'Processor [info]: no fd to select on - polling with checkBlock' infoPrintCR. (readCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[ - readFdArray := readFdArray copyWith:nil. - readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. - readCheckArray := readCheckArray copyWith:aBlock. + idx := readFdArray identityIndexOf:nil startingAt:1. + idx ~~ 0 ifTrue:[ + readFdArray at:idx put:aFileDescriptor. + readSemaphoreArray at:idx put:aSemaphore. + readCheckArray at:idx put:aBlock + ] ifFalse:[ + readFdArray := readFdArray copyWith:nil. + readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. + readCheckArray := readCheckArray copyWith:aBlock. + ] ] ] ifFalse:[ - (readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[ - idx := readFdArray identityIndexOf:nil startingAt:1. - idx ~~ 0 ifTrue:[ - readFdArray at:idx put:aFileDescriptor. - readSemaphoreArray at:idx put:aSemaphore. - readCheckArray at:idx put:aBlock - ] ifFalse:[ - readFdArray := readFdArray copyWith:aFileDescriptor. - readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. - readCheckArray := readCheckArray copyWith:aBlock. - ]. - useIOInterrupts ifTrue:[ - OperatingSystem enableIOInterruptsOn:aFileDescriptor - ]. + (readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[ + idx := readFdArray identityIndexOf:nil startingAt:1. + idx ~~ 0 ifTrue:[ + readFdArray at:idx put:aFileDescriptor. + readSemaphoreArray at:idx put:aSemaphore. + readCheckArray at:idx put:aBlock + ] ifFalse:[ + readFdArray := readFdArray copyWith:aFileDescriptor. + readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore. + readCheckArray := readCheckArray copyWith:aBlock. + ]. + useIOInterrupts ifTrue:[ + OperatingSystem enableIOInterruptsOn:aFileDescriptor + ]. ] ]. wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. @@ -2351,29 +2394,64 @@ "Modified: 4.8.1997 / 15:20:45 / cg" ! -signal:aSemaphore onOutput:aFileDescriptor +signal:aSemaphore onOutputStream:aStream + "arrange for a semaphore to be triggered when output on aStream is possible. + This will do a select, if the OS supports selecting on that filedescriptor, + otherwise, it will be polled every few milliseconds (MSDOS)." + + aStream canBeSelected ifTrue:[ + "/ can this stream be selected on ? + self signal:aSemaphore onOutput:aStream aFileDescriptor orCheck:nil + ] ifFalse:[ + "/ nope - must poll ... + self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking] + ] +! + +signal:aSemaphore onOutput:aFileDescriptor orCheck:aBlock "arrange for a semaphore to be triggered when output on aFileDescriptor - is possible. (i.e. can be written without blocking). - This will only happen, if the OS supports selecting on fileDescriptors." + is possible (i.e. can be written without blocking) or aBlock returns true. + The checkBlock will be evaluated by the scheduler from time to time + (i.e. every few milliseconds). + This checkBlock is required for poor windows, where a WaitForObject does + not know abóut sockets." |idx "{ Class: SmallInteger }" wasBlocked| wasBlocked := OperatingSystem blockInterrupts. - (writeFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[ - idx := writeFdArray identityIndexOf:nil startingAt:1. - idx ~~ 0 ifTrue:[ - writeFdArray at:idx put:aFileDescriptor. - writeSemaphoreArray at:idx put:aSemaphore. - ] ifFalse:[ - writeFdArray := writeFdArray copyWith:aFileDescriptor. - writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. - ]. - useIOInterrupts ifTrue:[ - OperatingSystem enableIOInterruptsOn:aFileDescriptor - ]. - + + aFileDescriptor isNil ifTrue:[ + (writeCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[ + idx := writeFdArray identityIndexOf:nil startingAt:1. + idx ~~ 0 ifTrue:[ + writeFdArray at:idx put:aFileDescriptor. + writeSemaphoreArray at:idx put:aSemaphore. + writeCheckArray at:idx put:aBlock + ] ifFalse:[ + writeFdArray := writeFdArray copyWith:nil. + writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. + writeCheckArray := writeCheckArray copyWith:aBlock. + ] + ] + ] ifFalse:[ + (writeFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[ + idx := writeFdArray identityIndexOf:nil startingAt:1. + idx ~~ 0 ifTrue:[ + writeFdArray at:idx put:aFileDescriptor. + writeSemaphoreArray at:idx put:aSemaphore. + writeCheckArray at:idx put:aBlock + ] ifFalse:[ + writeFdArray := writeFdArray copyWith:aFileDescriptor. + writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore. + writeCheckArray := writeCheckArray copyWith:aBlock. + ]. + useIOInterrupts ifTrue:[ + OperatingSystem enableIOInterruptsOn:aFileDescriptor + ]. + ] ]. + wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. "Modified: 4.8.1997 / 15:21:49 / cg" @@ -2390,18 +2468,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 - fefature 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 + fefature 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" @@ -2610,59 +2688,59 @@ n := timeoutArray size. anyTimeouts := false. 1 to:n do:[:index | - aTime := timeoutArray at:index. - aTime notNil ifTrue:[ - (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[ - "this one should be triggered" - - sema := timeoutSemaphoreArray at:index. - sema notNil ifTrue:[ - timeoutSemaphoreArray at:index put:nil. - sema signalOnce. - ] ifFalse:[ - "to support pure-events" - block := timeoutActionArray at:index. - block notNil ifTrue:[ - blocksToEvaluate isNil ifTrue:[ - blocksToEvaluate := OrderedCollection new:10. - processes := OrderedCollection new:10. - ]. - blocksToEvaluate add:block. - processes add:(timeoutProcessArray at:index). - timeoutActionArray at:index put:nil. - timeoutProcessArray at:index put:nil. - ] - ]. - timeoutArray at:index put:nil. - ] ifTrue:[ - anyTimeouts := true - ] - ] + aTime := timeoutArray at:index. + aTime notNil ifTrue:[ + (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[ + "this one should be triggered" + + sema := timeoutSemaphoreArray at:index. + sema notNil ifTrue:[ + timeoutSemaphoreArray at:index put:nil. + sema signalOnce. + ] ifFalse:[ + "to support pure-events" + block := timeoutActionArray at:index. + block notNil ifTrue:[ + blocksToEvaluate isNil ifTrue:[ + blocksToEvaluate := OrderedCollection new:10. + processes := OrderedCollection new:10. + ]. + blocksToEvaluate add:block. + processes add:(timeoutProcessArray at:index). + timeoutActionArray at:index put:nil. + timeoutProcessArray at:index put:nil. + ] + ]. + timeoutArray at:index put:nil. + ] ifTrue:[ + anyTimeouts := true + ] + ] ]. blocksToEvaluate notNil ifTrue:[ - blocksToEvaluate keysAndValuesDo:[:index :block | - |p| - - p := processes at:index. - (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[ - block value - ] ifFalse:[ - p isDead ifTrue:[ + blocksToEvaluate keysAndValuesDo:[:index :block | + |p| + + 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.) + "/ 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 - ] - ] - ] + ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR. + ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR. + ] ifFalse:[ + p interruptWith:block + ] + ] + ] ] "Modified: / 9.11.1998 / 21:25:02 / cg" @@ -2722,57 +2800,57 @@ "/ long wait (especially, to handle sigChild in the meantime) (wasBlocked := OperatingSystem interruptsBlocked) ifTrue:[ - OperatingSystem unblockInterrupts. + OperatingSystem unblockInterrupts. ]. fd := OperatingSystem - selectOnAnyReadable:readFdArray - writable:writeFdArray - exception:nil - withTimeOut:millis. + selectOnAnyReadable:readFdArray + writable:writeFdArray + exception:nil + withTimeOut:millis. wasBlocked ifTrue:[ - OperatingSystem blockInterrupts. + OperatingSystem blockInterrupts. ]. fd isNil ifTrue:[ - "/ either still nothing to do, - "/ or error (which should not happen) - - (err := OperatingSystem lastErrorSymbol) notNil ifTrue:[ - err == #EBADF ifTrue:[ - - "/ mhmh - one of the fd's given to me is corrupt. - "/ find out which one .... and remove it - - 'Processor [info]: obsolete FD in select - clearing' infoPrintCR. - OperatingSystem clearLastErrorNumber. - self removeCorruptedFds - ] ifFalse:[ - err == #ENOENT ifTrue:[ - 'Processor [warning]: ENOENT in select; rd=' infoPrint. - readFdArray infoPrint. - ' wr=' infoPrint. - writeFdArray infoPrintCR. - ] ifFalse:[ - 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR. - ] - ]. - ] + "/ either still nothing to do, + "/ or error (which should not happen) + + (err := OperatingSystem lastErrorSymbol) notNil ifTrue:[ + err == #EBADF ifTrue:[ + + "/ mhmh - one of the fd's given to me is corrupt. + "/ find out which one .... and remove it + + 'Processor [info]: obsolete FD in select - clearing' infoPrintCR. + OperatingSystem clearLastErrorNumber. + self removeCorruptedFds + ] ifFalse:[ + err == #ENOENT ifTrue:[ + 'Processor [warning]: ENOENT in select; rd=' infoPrint. + readFdArray infoPrint. + ' wr=' infoPrint. + writeFdArray infoPrintCR. + ] ifFalse:[ + 'Processor [warning]: error in select: ' infoPrint. err infoPrintCR. + ] + ]. + ] ] ifFalse:[ - index := readFdArray indexOf:fd. - index ~~ 0 ifTrue:[ - sema := readSemaphoreArray at:index. - sema notNil ifTrue:[ - sema signalOnce. - ^ true - ]. - action := readCheckArray at:index. - action notNil ifTrue:[ - action value. - ^ true - ] - ] + index := readFdArray indexOf:fd. + index ~~ 0 ifTrue:[ + sema := readSemaphoreArray at:index. + sema notNil ifTrue:[ + sema signalOnce. + ^ true + ]. + action := readCheckArray at:index. + action notNil ifTrue:[ + action value. + ^ true + ] + ] ]. ^ false @@ -2791,8 +2869,8 @@ gotIOInterrupt := true. activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 21.12.1995 / 16:17:40 / stefan" @@ -2814,19 +2892,20 @@ (fd notNil "and:[fd >= 0]") ifTrue:[ rslt := OperatingSystem - selectOnAnyReadable:(Array with:fd) - writable:nil - exception:nil - withTimeOut:0. + selectOnAnyReadable:(Array with:fd) + writable:nil + exception:nil + withTimeOut:0. (rslt isNil and:[OperatingSystem lastErrorSymbol == #EBADF]) ifTrue:[ - ('Processor [info]: removing invalid read-select fileDescriptor: ' , fd printString) errorPrintCR. - readFdArray at:idx put:nil. - OperatingSystem clearLastErrorNumber. - (sema := readSemaphoreArray at:idx) notNil ifTrue:[ + ('Processor [info]: removing invalid read-select fileDescriptor: ' , fd printString) errorPrintCR. + readFdArray at:idx put:nil. + readCheckArray at:idx put:nil. + OperatingSystem clearLastErrorNumber. + (sema := readSemaphoreArray at:idx) notNil ifTrue:[ readSemaphoreArray at:idx put:nil. sema signal. - ]. + ]. ] ]. ]. @@ -2834,20 +2913,23 @@ writeFdArray keysAndValuesDo:[:idx :fd | |rslt sema| - rslt := OperatingSystem - selectOnAnyReadable:nil - writable:(Array with:fd) - exception:nil - withTimeOut:0. - - (rslt isNil and:[OperatingSystem lastErrorSymbol == #EBADF]) ifTrue:[ - ('Processor [info]: removing invalid write-select fileDescriptor: ' , fd printString) errorPrintCR. - writeFdArray at:idx put:nil. - OperatingSystem clearLastErrorNumber. - (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ - writeSemaphoreArray at:idx put:nil. - sema signal. - ]. + (fd notNil) ifTrue:[ + rslt := OperatingSystem + selectOnAnyReadable:nil + writable:(Array with:fd) + exception:nil + withTimeOut:0. + + (rslt isNil and:[OperatingSystem lastErrorSymbol == #EBADF]) ifTrue:[ + ('Processor [info]: removing invalid write-select fileDescriptor: ' , fd printString) errorPrintCR. + writeFdArray at:idx put:nil. + writeCheckArray at:idx put:nil. + OperatingSystem clearLastErrorNumber. + (sema := writeSemaphoreArray at:idx) notNil ifTrue:[ + writeSemaphoreArray at:idx put:nil. + sema signal. + ]. + ] ] ]. @@ -2860,8 +2942,8 @@ what to do now." activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] ! @@ -2905,8 +2987,8 @@ of whichever process is currently running." activeProcess ~~ scheduler ifTrue:[ - interruptedProcess := activeProcess. - self threadSwitch:scheduler + interruptedProcess := activeProcess. + self threadSwitch:scheduler ] "Modified: 18.10.1996 / 20:35:54 / cg" @@ -2993,7 +3075,7 @@ OperatingSystem supportsIOInterrupts ifTrue:[ dT := 999999 ] ifFalse:[ - dT := EventPollingInterval + dT := EventPollingInterval ]. millis isNil ifTrue:[ @@ -3010,6 +3092,6 @@ !ProcessorScheduler class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.180 1999-10-08 09:03:21 ca Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.181 1999-12-14 18:46:28 cg Exp $' ! ! ProcessorScheduler initialize!