--- 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!