--- a/ProcessorScheduler.st Mon Feb 04 11:34:56 2002 +0100
+++ b/ProcessorScheduler.st Mon Feb 04 15:31:14 2002 +0100
@@ -774,20 +774,20 @@
dispatchAction := [self dispatch].
handlerAction := [:ex |
- ('Processor [info]: ignored signal (', ex signal printString, ')') infoPrintCR.
- ex return
- ].
+ ('Processor [info]: ignored signal (', ex signal printString, ')') infoPrintCR.
+ ex return
+ ].
ignoredSignals := SignalSet
- with:TerminateProcessRequest
- with:AbortSignal.
+ with:TerminateProcessRequest
+ with:AbortSignal.
"/
"/ I made this an extra call to dispatch; this allows recompilation
"/ of the dispatch-handling code in the running system.
"/
[dispatching] whileTrue:[
- ignoredSignals handle:handlerAction do:dispatchAction
+ ignoredSignals handle:handlerAction do:dispatchAction
].
"/ we arrive here in standalone Apps,
@@ -819,9 +819,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.
].
"
@@ -844,7 +844,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.
@@ -991,41 +991,41 @@
|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 - resumeIRQ 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 - resumeIRQ 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 - resumeIRQ for unknown process: ' infoPrint.
- id infoPrintCR.
+ 'ProcSched [info]: oops - resumeIRQ for unknown process: ' infoPrint.
+ id infoPrintCR.
]
"Modified: / 28.9.1998 / 11:36:53 / cg"
@@ -1110,64 +1110,64 @@
|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.
- ].
-
- pid notNil ifTrue:[
- [
- [
- |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.
+ ].
+
+ pid notNil ifTrue:[
+ [
+ [
+ |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
@@ -1258,40 +1258,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.
- ].
-
- ok == #halted ifTrue:[
- "/ that process was halted (win32 only)
- p state:#halted.
- '; 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.
- ]
- ]
- ]
+ "
+ 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.
+ ] ifFalse:[
+ '; 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].
!
@@ -1311,9 +1311,9 @@
OBJ ok;
if (__isSmallInteger(id)) {
- ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0);
+ ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
} else {
- ok = false;
+ ok = false;
}
RETURN (ok)
%}
@@ -1702,7 +1702,6 @@
"/ the returned value here has a subtle effect:
"/ if false, the interrupt is assumed to be not taken,
"/ and will be redelivered.
-
^ activeProcess interruptedIn:s
"Modified: 20.10.1996 / 17:06:48 / cg"
@@ -1947,8 +1946,8 @@
aProcess isNil ifTrue:[^ self].
aProcess == scheduler ifTrue:[
- InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: I will not terminate scheduler'.
- ^ self
+ InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: I will not terminate scheduler'.
+ ^ self
].
id := aProcess id.
@@ -1963,25 +1962,25 @@
pri := aProcess priority.
l := quiescentProcessLists at:pri.
l notNil ifTrue:[
- (l remove:aProcess ifAbsent:nil) notNil ifTrue:[
- l isEmpty ifTrue:[
- quiescentProcessLists at:pri put:nil
- ]
- ].
+ (l remove:aProcess ifAbsent:nil) notNil ifTrue:[
+ l isEmpty ifTrue:[
+ quiescentProcessLists at:pri put:nil
+ ]
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
aProcess == activeProcess ifTrue:[
- "
- hard case - its the currently running process
- we must have the next active process destroy this one
- (we cannot destroy the chair we are sitting on ... :-)
- "
- zombie := id.
- self unRemember:aProcess.
- self threadSwitch:scheduler.
- "not reached"
- ^ self
+ "
+ hard case - its the currently running process
+ we must have the next active process destroy this one
+ (we cannot destroy the chair we are sitting on ... :-)
+ "
+ zombie := id.
+ self unRemember:aProcess.
+ self threadSwitch:scheduler.
+ "not reached"
+ ^ self
].
self class threadDestroy:id.
self unRemember:aProcess.
@@ -2410,11 +2409,11 @@
otherwise, it will be polled every few milliseconds (MSDOS)."
aStream canBeSelected ifTrue:[
- "/ can this stream be selected on ?
- self signal:aSemaphore onInput:aStream fileDescriptor orCheck:nil
+ "/ can this stream be selected on ?
+ self signal:aSemaphore onInput:aStream fileDescriptor orCheck:nil
] ifFalse:[
- "/ nope - must poll ...
- self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
+ "/ nope - must poll ...
+ self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
]
"Modified: / 14.12.1999 / 23:58:50 / cg"
@@ -2484,11 +2483,11 @@
otherwise, it will be polled every few milliseconds (MSDOS)."
aStream canBeSelected ifTrue:[
- "/ can this stream be selected on ?
- self signal:aSemaphore onOutput:aStream fileDescriptor orCheck:nil
+ "/ can this stream be selected on ?
+ self signal:aSemaphore onOutput:aStream fileDescriptor orCheck:nil
] ifFalse:[
- "/ nope - must poll ...
- self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
+ "/ nope - must poll ...
+ self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
]
"Modified: / 14.12.1999 / 23:59:19 / cg"
@@ -2505,18 +2504,18 @@
Using IO interrupts reduces the idle CPU usage of ST/X by some percent
(typically 2-7%).
Notice:
- some systems do not support IO-interrupts (or have a broken stdio-lib),
- and this feature is always disabled;
+ some systems do not support IO-interrupts (or have a broken stdio-lib),
+ and this feature is always disabled;
Also notice:
- we found that in some Xlib-implementations, interrupted reads are not
- handled correctly (especially in multi-headed applications), and this
- feature should be disabled to avoid a blocking XPending.
+ we found that in some Xlib-implementations, interrupted reads are not
+ handled correctly (especially in multi-headed applications), and this
+ feature should be disabled to avoid a blocking XPending.
If this method is used to disable IO interrupts in multi-headed apps,
it should be invoked BEFORE the display event dispatcher processes are started."
OperatingSystem supportsIOInterrupts ifTrue:[
- useIOInterrupts := aBoolean
+ useIOInterrupts := aBoolean
].
"Created: / 15.7.1998 / 13:32:29 / cg"
@@ -2837,70 +2836,70 @@
"/ 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 identityIndexOf: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 := writeFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- sema := writeSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- ^ true
- ].
- action := writeCheckArray at:index.
- action notNil ifTrue:[
- action value.
- ^ true
- ]
- ]
+ index := readFdArray identityIndexOf: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 := writeFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ^ true
+ ].
+ action := writeCheckArray at:index.
+ action notNil ifTrue:[
+ action value.
+ ^ true
+ ]
+ ]
].
^ false
@@ -3055,83 +3054,83 @@
doingGC := true.
[doingGC] whileTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- (millis notNil and:[millis <= 0]) ifTrue:[
- ^ self "oops - hurry up checking"
- ].
- ].
-
- "
- if its worth doing, collect a bit of garbage;
- but not, if a backgroundCollector is active
- "
- ObjectMemory backgroundCollectorRunning ifTrue:[
- doingGC := false
- ] ifFalse:[
- doingGC := ObjectMemory gcStepIfUseful.
- ].
-
- "then do idle actions"
- (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
- idleActions do:[:aBlock |
- aBlock value.
- ].
- ^ self "go back checking"
- ].
-
- doingGC ifTrue:[
- (self checkForInputWithTimeout:0) ifTrue:[
- ^ self "go back checking"
- ]
- ]
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ (millis notNil and:[millis <= 0]) ifTrue:[
+ ^ self "oops - hurry up checking"
+ ].
+ ].
+
+ "
+ if its worth doing, collect a bit of garbage;
+ but not, if a backgroundCollector is active
+ "
+ ObjectMemory backgroundCollectorRunning ifTrue:[
+ doingGC := false
+ ] ifFalse:[
+ doingGC := ObjectMemory gcStepIfUseful.
+ ].
+
+ "then do idle actions"
+ (idleActions notNil and:[idleActions size ~~ 0]) ifTrue:[
+ idleActions do:[:aBlock |
+ aBlock value.
+ ].
+ ^ self "go back checking"
+ ].
+
+ doingGC ifTrue:[
+ (self checkForInputWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ]
+ ]
].
exitWhenNoMoreUserProcesses ifTrue:[
- "/ check if there are any processes at all
- "/ stop dispatching if there is none
- "/ (and millis is nil, which means that no timeout blocks are present)
- "/ and no readSemaphores are present (which means that noone is waiting for input)
- "/ and no writeSemaphores are present
-
- anySema := false.
- anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
- anySema ifFalse:[
- anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
- ].
- anySema ifFalse:[
- self anyUserProcessAtAll ifFalse:[
- dispatching := false.
- ^ self
- ]
- ].
+ "/ check if there are any processes at all
+ "/ stop dispatching if there is none
+ "/ (and millis is nil, which means that no timeout blocks are present)
+ "/ and no readSemaphores are present (which means that noone is waiting for input)
+ "/ and no writeSemaphores are present
+
+ anySema := false.
+ anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
+ anySema ifFalse:[
+ anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
+ ].
+ anySema ifFalse:[
+ self anyUserProcessAtAll ifFalse:[
+ dispatching := false.
+ ^ self
+ ]
+ ].
].
"/
"/ absolutely nothing to do - simply wait
"/
OperatingSystem supportsSelect ifFalse:[
- "SCO instant ShitStation has a bug here,
- waiting always 1 sec in the select - therefore we delay a bit and
- return - effectively polling in 50ms cycles
- "
- (self checkForInputWithTimeout:0) ifTrue:[
- ^ self "go back checking"
- ].
- OperatingSystem millisecondDelay:EventPollingInterval.
- ^ self
+ "SCO instant ShitStation has a bug here,
+ waiting always 1 sec in the select - therefore we delay a bit and
+ return - effectively polling in 50ms cycles
+ "
+ (self checkForInputWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ].
+ OperatingSystem millisecondDelay:EventPollingInterval.
+ ^ self
].
useIOInterrupts ifTrue:[
- dT := 999999
+ dT := 999999
] ifFalse:[
- dT := EventPollingInterval
+ dT := EventPollingInterval
].
millis isNil ifTrue:[
- millis := dT.
+ millis := dT.
] ifFalse:[
- millis := millis rounded min:dT.
+ millis := millis rounded min:dT.
].
self checkForInputWithTimeout:millis
@@ -3142,6 +3141,6 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.195 2001-12-06 08:52:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.196 2002-02-04 14:31:14 cg Exp $'
! !
ProcessorScheduler initialize!