--- a/ProcessorScheduler.st Mon Apr 27 19:04:19 2015 +0200
+++ b/ProcessorScheduler.st Mon Apr 27 19:04:46 2015 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -39,7 +39,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -79,102 +79,102 @@
(actually, it is no longer maintained, so dont run the system without Processes).
[instance variables:]
- quiescentProcessLists - list of waiting processes
- scheduler - the scheduler process itself
- zombie - internal temporary (recently died process)
- activeProcess - the current process
- activeProcessId - the current processes id
- currentPriority - the current processes priority
- readFdArray - fd-sema-checkBlock triple-association
- readSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- readCheckArray
- writeFdArray - fd-sema-checkBlock triple-association
- writeSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- writeCheckArray
- timeoutArray - time-action-process-sema quadruple-association
- timeoutActionArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
- timeoutProcessArray
- timeoutSemaphoreArray
- idleActions - actions to be executed when idle
- preWaitActions - actions to be executed BEFORE going into an OS-wait
- anyTimeouts - flag if any timeouts are pending
- dispatching - flag if dispatch process is running (i.e. NOT initializing)
- interruptedProcess - the currently interrupted process.
- useIOInterrupts - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)
- gotIOInterrupt - flag if I came out of a wait due to an I/O interrupt
- osChildExitActions - OS chid process actions
- gotChildSignalInterrupt - flag if I came out of a wait due to an OS child interrupt
- exitWhenNoMoreUserProcesses - flag which controls if ST/X should exit when the last process dies (for standalone apps)
- suspendScheduler - internal use
- timeSliceProcess - the timeSlicer process
- supportDynamicPriorities - flag if dynamic priorities should be supported by the timeSlicer
- scheduledProcesses - list of scheduled processes for the timeSlicers dynamic prio handling
+ quiescentProcessLists - list of waiting processes
+ scheduler - the scheduler process itself
+ zombie - internal temporary (recently died process)
+ activeProcess - the current process
+ activeProcessId - the current processes id
+ currentPriority - the current processes priority
+ readFdArray - fd-sema-checkBlock triple-association
+ readSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ readCheckArray
+ writeFdArray - fd-sema-checkBlock triple-association
+ writeSemaphoreArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ writeCheckArray
+ timeoutArray - time-action-process-sema quadruple-association
+ timeoutActionArray (stupid historic 3-separate arrays for hi-speed-optimization reasons)
+ timeoutProcessArray
+ timeoutSemaphoreArray
+ idleActions - actions to be executed when idle
+ preWaitActions - actions to be executed BEFORE going into an OS-wait
+ anyTimeouts - flag if any timeouts are pending
+ dispatching - flag if dispatch process is running (i.e. NOT initializing)
+ interruptedProcess - the currently interrupted process.
+ useIOInterrupts - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)
+ gotIOInterrupt - flag if I came out of a wait due to an I/O interrupt
+ osChildExitActions - OS chid process actions
+ gotChildSignalInterrupt - flag if I came out of a wait due to an OS child interrupt
+ exitWhenNoMoreUserProcesses - flag which controls if ST/X should exit when the last process dies (for standalone apps)
+ suspendScheduler - internal use
+ timeSliceProcess - the timeSlicer process
+ supportDynamicPriorities - flag if dynamic priorities should be supported by the timeSlicer
+ scheduledProcesses - list of scheduled processes for the timeSlicers dynamic prio handling
[class variables:]
- KnownProcesses <WeakArray> all known processes
- KnownProcessIds <Collection> and their IDs
-
- PureEventDriven <Boolean> true, if no process support
- is available
-
- UserSchedulingPriority <Integer> the priority at which normal
- user interfaces run
-
- UserInterruptPriority the priority at which user-
- interrupts (Cntl-C) processing
- takes place. Processes with
- a greater or equal priority are
- not interruptable.
-
- TimingPriority the priority used for timing.
- Processes with a greater or
- equal priority are not interrupted
- by timers.
-
- HighestPriority The highest allowed prio for processes
-
- SchedulingPriority The priority of the scheduler (must
- me higher than any other).
-
- MaxNumberOfProcesses if non-nil, no more than this
- number of processes are allowed
- (for debugging)
-
- TimeSliceInterval for preemptive priority scheduling only:
- the time interval in millis, at which processes
- are timesliced
-
- TimeSlicingPriorityLimit for preemptive priority scheduling only:
- processes are only timesliced, if running
- at or below this priority.
-
- EventPollingInterval for systems which do not support select on
- a fileDescriptor: the polling interval in millis.
+ KnownProcesses <WeakArray> all known processes
+ KnownProcessIds <Collection> and their IDs
+
+ PureEventDriven <Boolean> true, if no process support
+ is available
+
+ UserSchedulingPriority <Integer> the priority at which normal
+ user interfaces run
+
+ UserInterruptPriority the priority at which user-
+ interrupts (Cntl-C) processing
+ takes place. Processes with
+ a greater or equal priority are
+ not interruptable.
+
+ TimingPriority the priority used for timing.
+ Processes with a greater or
+ equal priority are not interrupted
+ by timers.
+
+ HighestPriority The highest allowed prio for processes
+
+ SchedulingPriority The priority of the scheduler (must
+ me higher than any other).
+
+ MaxNumberOfProcesses if non-nil, no more than this
+ number of processes are allowed
+ (for debugging)
+
+ TimeSliceInterval for preemptive priority scheduling only:
+ the time interval in millis, at which processes
+ are timesliced
+
+ TimeSlicingPriorityLimit for preemptive priority scheduling only:
+ processes are only timesliced, if running
+ at or below this priority.
+
+ EventPollingInterval for systems which do not support select on
+ a fileDescriptor: the polling interval in millis.
most interesting methods:
- Processor>>suspend: (see also Process>>suspend)
- Processor>>resume: (see also Process>>resume)
- Processor>>terminate: (see also Process>>terminate)
- Processor>>yield
- Processor>>changePriority:for: (see also Process>>priority:
-
- Processor>>signal:afterSeconds: (see also Delay>>forSeconds:)
- Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
- Processor>>signal:onInput: (see also ExternalStream>>readWait)
- Processor>>signal:onOutput: (see also ExternalStream>>writeWait)
- Processor>>disableSemaphore:
+ Processor>>suspend: (see also Process>>suspend)
+ Processor>>resume: (see also Process>>resume)
+ Processor>>terminate: (see also Process>>terminate)
+ Processor>>yield
+ Processor>>changePriority:for: (see also Process>>priority:
+
+ Processor>>signal:afterSeconds: (see also Delay>>forSeconds:)
+ Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
+ Processor>>signal:onInput: (see also ExternalStream>>readWait)
+ Processor>>signal:onOutput: (see also ExternalStream>>writeWait)
+ Processor>>disableSemaphore:
[see also:]
- Process
- Delay Semaphore SemaphoreSet SharedQueue
- WindowGroup
- (``Working with processes'': programming/processes.html)
+ Process
+ Delay Semaphore SemaphoreSet SharedQueue
+ WindowGroup
+ (``Working with processes'': programming/processes.html)
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -212,16 +212,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.
@@ -229,10 +229,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.
@@ -262,15 +262,15 @@
SchedulingPriority := 31.
InvalidProcessSignal isNil ifTrue:[
- InvalidProcessSignal := Error newSignalMayProceed:true.
- InvalidProcessSignal nameClass:self message:#invalidProcessSignal.
- InvalidProcessSignal notifierString:'invalid process'.
+ InvalidProcessSignal := Error newSignalMayProceed:true.
+ InvalidProcessSignal nameClass:self message:#invalidProcessSignal.
+ InvalidProcessSignal notifierString:'invalid process'.
].
Processor isNil ifTrue:[
- "create the one and only processor"
-
- Processor := self basicNew initialize.
+ "create the one and only processor"
+
+ Processor := self basicNew initialize.
].
"
@@ -279,19 +279,32 @@
"
PureEventDriven := self threadsAvailable not.
PureEventDriven ifTrue:[
- 'Processor [error]: no process support - running event driven' errorPrintCR
+ 'Processor [error]: no process support - running event driven' errorPrintCR
].
-
-%{
-#ifndef MAX_PROCESS_ID
-# define MAX_PROCESS_ID _MAX_INT
-#endif
- @global(ProcessorScheduler:MaxProcessId) = __MKSMALLINT(MAX_PROCESS_ID);
-%}
+ self initializeVMMaxProcessId
"Modified: / 23-09-1996 / 14:24:50 / stefan"
"Modified: / 10-01-1997 / 18:03:03 / cg"
"Modified: / 19-09-2014 / 12:47:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializeVMMaxProcessId
+
+ "/ for java locks, the VM may reserve some bits
+ "/ and reduce the maximum processID to be able to
+ "/ encode the id in an object's header field.
+%{
+#ifndef __SCHTEAM__
+
+# ifndef MAX_PROCESS_ID
+# define MAX_PROCESS_ID _MAX_INT
+# endif
+
+ @global(ProcessorScheduler:MaxProcessId) = __MKSMALLINT(MAX_PROCESS_ID);
+ RETURN (self);
+#endif /* not SCHTEAM */
+%}.
+ MaxProcessId := SmallInteger maxVal.
! !
!ProcessorScheduler class methodsFor:'instance creation'!
@@ -321,22 +334,22 @@
|id sz "{ Class: SmallInteger }"|
something == #ElementExpired ifTrue:[
- sz := KnownProcessIds size.
- 1 to:sz do:[:index |
- "/ (KnownProcesses at:index) isNil ifTrue:[
- (KnownProcesses at:index) == 0 ifTrue:[
- id := KnownProcessIds at:index.
- id notNil ifTrue:[
- 'Processor [warning]: terminating thread ' errorPrint.
- id errorPrint.
- ' (no longer refd)' errorPrintCR.
-
- self threadDestroy:id.
- KnownProcessIds at:index put:nil.
- ].
- KnownProcesses at:index put:nil.
- ]
- ]
+ sz := KnownProcessIds size.
+ 1 to:sz do:[:index |
+ "/ (KnownProcesses at:index) isNil ifTrue:[
+ (KnownProcesses at:index) == 0 ifTrue:[
+ id := KnownProcessIds at:index.
+ id notNil ifTrue:[
+ 'Processor [warning]: terminating thread ' errorPrint.
+ id errorPrint.
+ ' (no longer refd)' errorPrintCR.
+
+ self threadDestroy:id.
+ KnownProcessIds at:index put:nil.
+ ].
+ KnownProcesses at:index put:nil.
+ ]
+ ]
]
"Created: 7.1.1997 / 16:45:42 / stefan"
@@ -351,17 +364,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'.
+ ]
+ ]
].
%{
@@ -369,11 +382,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 ( __mkSmallInteger(tid));
+ RETURN ( __mkSmallInteger(tid));
}
%}
.
@@ -393,7 +406,7 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(id)) {
- __threadDestroy(__intVal(id));
+ __threadDestroy(__intVal(id));
}
%}
!
@@ -407,7 +420,7 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(id)) {
- __threadInterrupt(__intVal(id));
+ __threadInterrupt(__intVal(id));
}
%}
!
@@ -449,7 +462,7 @@
"evaluate aBlock for each (living) processes in the system"
KnownProcesses do:[:p |
- (p notNil and:[p ~~ 0]) ifTrue:[aBlock value:p]
+ (p notNil and:[p ~~ 0]) ifTrue:[aBlock value:p]
]
"Created: / 26-10-2012 / 13:02:33 / cg"
@@ -503,20 +516,20 @@
wasBlocked := OperatingSystem blockInterrupts.
useIOInterrupts ifTrue:[
- OperatingSystem disableIOInterruptsOn:aFileDescriptor
+ OperatingSystem disableIOInterruptsOn:aFileDescriptor
].
idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
idx ~~ 0 ifTrue:[
- 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
+ writeFdArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
+ writeSemaphoreArray at:idx put:nil
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -532,26 +545,26 @@
wasBlocked|
aFileDescriptor < 0 ifTrue:[
- 'Processor [warning]: ignored invalid fd for IO action.' errorPrintCR.
- thisContext fullPrintAll.
- ^ self
+ 'Processor [warning]: ignored invalid fd for IO action.' errorPrintCR.
+ thisContext fullPrintAll.
+ ^ self
].
wasBlocked := OperatingSystem blockInterrupts.
(readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
- idx := readFdArray identityIndexOf:nil startingAt:1.
- idx ~~ 0 ifTrue:[
- readFdArray at:idx put:aFileDescriptor.
- readCheckArray at:idx put:aBlock.
- readSemaphoreArray at:idx put:nil
- ] ifFalse:[
- readFdArray := readFdArray copyWith:aFileDescriptor.
- readCheckArray := readCheckArray copyWith:aBlock.
- readSemaphoreArray := readSemaphoreArray copyWith:nil.
- ].
- useIOInterrupts ifTrue:[
- OperatingSystem enableIOInterruptsOn:aFileDescriptor
- ].
+ idx := readFdArray identityIndexOf:nil startingAt:1.
+ idx ~~ 0 ifTrue:[
+ readFdArray at:idx put:aFileDescriptor.
+ readCheckArray at:idx put:aBlock.
+ readSemaphoreArray at:idx put:nil
+ ] ifFalse:[
+ readFdArray := readFdArray copyWith:aFileDescriptor.
+ readCheckArray := readCheckArray copyWith:aBlock.
+ readSemaphoreArray := readSemaphoreArray copyWith:nil.
+ ].
+ useIOInterrupts ifTrue:[
+ OperatingSystem enableIOInterruptsOn:aFileDescriptor
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -626,7 +639,7 @@
wasBlocked := OperatingSystem blockInterrupts.
idleActions isNil ifTrue:[
- idleActions := OrderedCollection new
+ idleActions := OrderedCollection new
].
idleActions add:aBlock.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -661,7 +674,7 @@
handle all timeout actions
"
anyTimeouts ifTrue:[
- self evaluateTimeouts
+ self evaluateTimeouts
].
"first do a quick check for semaphores using checkActions - this is needed for
@@ -674,42 +687,42 @@
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.
- ]
+ 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
- "/ Trace ifTrue:['w' printCR.].
- self waitForEventOrTimeout.
-
- "/ check for OS process termination
- gotChildSignalInterrupt ifTrue:[
- gotChildSignalInterrupt := false.
- self handleChildSignalInterrupt
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ "/ no one runnable, hard wait for event or timeout
+ "/ Trace ifTrue:['w' printCR.].
+ self waitForEventOrTimeout.
+
+ "/ check for OS process termination
+ gotChildSignalInterrupt ifTrue:[
+ gotChildSignalInterrupt := false.
+ self handleChildSignalInterrupt
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
pri := p priority.
@@ -740,13 +753,13 @@
"
pri < TimingPriority ifTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- millis == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ]
- ]
+ anyTimeouts ifTrue:[
+ millis := self timeToNextTimeout.
+ millis == 0 ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ]
+ ]
].
"
@@ -759,38 +772,38 @@
pri < UserInterruptPriority ifTrue:[
"comment out this if above is uncommented"
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- millis == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ].
- ].
+ 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:[
- "/ Trace ifTrue:['C' print. millis printCR.].
- "schedule a clock interrupt after millis milliseconds"
- OperatingSystem enableTimer:millis rounded.
+ "/ Trace ifTrue:['C' print. millis printCR.].
+ "schedule a clock interrupt after millis milliseconds"
+ OperatingSystem enableTimer:millis rounded.
].
scheduledProcesses notNil ifTrue:[
- scheduledProcesses add:p
+ scheduledProcesses add:p
].
"
@@ -802,17 +815,17 @@
"/ Trace ifTrue:['<-' printCR.].
"... 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
@@ -820,8 +833,8 @@
OperatingSystem unblockInterrupts.
(gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
- gotIOInterrupt := false.
- self checkForIOWithTimeout:0.
+ gotIOInterrupt := false.
+ self checkForIOWithTimeout:0.
].
wasBlocked ifTrue:[OperatingSystem blockInterrupts].
@@ -839,8 +852,8 @@
"avoid confusion if entered twice"
dispatching == true ifTrue:[
- 'Processor [info]: already in dispatch' infoPrintCR.
- ^ self
+ 'Processor [info]: already in dispatch' infoPrintCR.
+ ^ self
].
dispatching := true.
@@ -852,32 +865,32 @@
dispatchAction := [ [dispatching] whileTrue:[ self dispatch ] ].
handlerAction := [:ex |
- (HaltInterrupt accepts:ex creator) ifTrue:[
- "/ in a standalone application, we do not want those
- Smalltalk isStandAloneApp ifTrue:[
- Smalltalk isStandAloneDebug ifFalse:[
- ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
- ex proceed.
- ]
- ].
- ].
-
- ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
- ex return
- ].
+ (HaltInterrupt accepts:ex creator) ifTrue:[
+ "/ in a standalone application, we do not want those
+ Smalltalk isStandAloneApp ifTrue:[
+ Smalltalk isStandAloneDebug ifFalse:[
+ ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
+ ex proceed.
+ ]
+ ].
+ ].
+
+ ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
+ ex return
+ ].
ignoredSignals := SignalSet
- with:HaltInterrupt
- with:TerminateProcessRequest
- with:RecursionError
- with:AbortAllOperationRequest.
+ with:HaltInterrupt
+ with:TerminateProcessRequest
+ with:RecursionError
+ with:AbortAllOperationRequest.
"/
"/ 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,
@@ -909,9 +922,9 @@
p l|
KnownProcesses isNil ifTrue:[
- KnownProcesses := WeakArray new:30.
- KnownProcesses addDependent:self class.
- KnownProcessIds := OrderedCollection new:30.
+ KnownProcesses := WeakArray new:30.
+ KnownProcesses addDependent:self class.
+ KnownProcessIds := OrderedCollection new:30.
].
"
@@ -940,7 +953,7 @@
supportDynamicPriorities := false.
exitWhenNoMoreUserProcesses isNil ifTrue:[
- exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
+ exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
].
"
@@ -951,11 +964,11 @@
"
currentPriority := SchedulingPriority.
p := Process basicNew.
- p
- setId:0 state:#run;
- setPriority:currentPriority;
- name:'scheduler';
- beSystemProcess.
+ p
+ setId:0 state:#run;
+ setPriority:currentPriority;
+ name:'scheduler';
+ beSystemProcess.
scheduler := activeProcess := p.
activeProcessId := 0.
@@ -967,9 +980,9 @@
let me handle IO and timer interrupts
"
useIOInterrupts ifTrue:[ObjectMemory ioInterruptHandler:self].
- ObjectMemory
- timerInterruptHandler:self;
- childSignalInterruptHandler:self.
+ ObjectMemory
+ timerInterruptHandler:self;
+ childSignalInterruptHandler:self.
"Modified: / 7.1.1997 / 16:48:26 / stefan"
"Modified: / 4.2.1999 / 13:08:39 / cg"
@@ -995,16 +1008,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.
@@ -1015,7 +1028,7 @@
self initialize.
processesToRestart do:[:p |
- p imageRestart
+ p imageRestart
]
"Modified: / 7.6.1998 / 02:23:56 / cg"
@@ -1033,44 +1046,44 @@
|index pri aProcess l|
OperatingSystem interruptsBlocked ifFalse:[
- MiniDebugger
- enterWithMessage:'vmResumeInterrupt with no interruptsBlocked'
- mayProceed:true.
+ MiniDebugger
+ enterWithMessage:'vmResumeInterrupt with no interruptsBlocked'
+ mayProceed:true.
].
index := KnownProcessIds identityIndexOf:id.
index ~~ 0 ifTrue:[
- aProcess := KnownProcesses at:index.
- pri := aProcess priority.
- l := quiescentProcessLists at:pri.
- l notNil ifTrue:[
- (l includesIdentical:aProcess) ifTrue:[
- "/ aProcess is on a run queue.
- "/ CG: this situation may happen, if the wrapCall
- "/ finishes before the process was layed to sleep
- "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished).
- "/ In that case, simply resume it and everything is OK.
- "/ If the process is state running, ignore.
-
- |state|
-
- state := aProcess state.
- (state == #wrapWait or:[state == #osWait] or:[state == #stopped]) ifTrue:[
- aProcess state:#run.
- ].
- 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint.
- aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR.
- ^ self
- ]
- ] ifFalse:[
- l := LinkedList new.
- quiescentProcessLists at:pri put:l.
- ].
- l addLast:aProcess.
- aProcess state:#run.
+ aProcess := KnownProcesses at:index.
+ pri := aProcess priority.
+ l := quiescentProcessLists at:pri.
+ l notNil ifTrue:[
+ (l includesIdentical:aProcess) ifTrue:[
+ "/ aProcess is on a run queue.
+ "/ CG: this situation may happen, if the wrapCall
+ "/ finishes before the process was layed to sleep
+ "/ (i.e. schedulerIRQ arrives before the threadSwitch was finished).
+ "/ In that case, simply resume it and everything is OK.
+ "/ If the process is state running, ignore.
+
+ |state|
+
+ state := aProcess state.
+ (state == #wrapWait or:[state == #osWait] or:[state == #stopped]) ifTrue:[
+ aProcess state:#run.
+ ].
+ 'ProcSched [info]: resumeIRQ ignored for process: ' infoPrint.
+ aProcess id infoPrint. ' in state: ' infoPrint. state infoPrintCR.
+ ^ self
+ ]
+ ] ifFalse:[
+ l := LinkedList new.
+ quiescentProcessLists at:pri put:l.
+ ].
+ l addLast:aProcess.
+ aProcess state:#run.
] ifFalse:[
- 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint.
- id infoPrintCR.
+ 'ProcSched [info]: resumeIRQ for unknown process: ' infoPrint.
+ id infoPrintCR.
]
"Modified: / 28.9.1998 / 11:36:53 / cg"
@@ -1087,19 +1100,19 @@
|pri l newState|
OperatingSystem interruptsBlocked ifFalse:[
- MiniDebugger
- enterWithMessage:'immediateInterrupt with no interruptsBlocked'
- mayProceed:true.
+ MiniDebugger
+ enterWithMessage:'immediateInterrupt with no interruptsBlocked'
+ mayProceed:true.
].
(whyCode == 2) ifTrue:[
- newState := #wrapWait.
+ newState := #wrapWait.
] ifFalse:[
- (whyCode == 3) ifTrue:[
- newState := #osWait.
- ] ifFalse:[
- newState := #stopped.
- ].
+ (whyCode == 3) ifTrue:[
+ newState := #osWait.
+ ] ifFalse:[
+ newState := #stopped.
+ ].
].
activeProcess setStateTo:newState if:#active.
@@ -1110,9 +1123,9 @@
the ifAbsent block, because [] is a shared cheap block, created at compile time
"
(l isNil or:[(l removeIdentical:activeProcess ifAbsent:nil) isNil]) ifTrue:[
- "/ 'Processor [warning]: bad vmSuspendInterrupt: not on run list' errorPrintCR.
- MiniDebugger enterWithMessage:'bad vmSuspendInterrupt: not on run list' mayProceed:true.
- ^ self
+ "/ 'Processor [warning]: bad vmSuspendInterrupt: not on run list' errorPrintCR.
+ MiniDebugger enterWithMessage:'bad vmSuspendInterrupt: not on run list' mayProceed:true.
+ ^ self
].
! !
@@ -1126,8 +1139,8 @@
gotChildSignalInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 12.4.1996 / 10:12:18 / stefan"
@@ -1144,37 +1157,37 @@
"/ no interrupt processing, to avoid races with monitorPid
wasBlocked := OperatingSystem blockInterrupts.
[
- [
- osProcessStatus := OperatingSystem childProcessWait:blocking pid:nil.
- osProcessStatus notNil ifTrue:[
- |pid action|
-
- pid := osProcessStatus pid.
- osProcessStatus stillAlive ifTrue:[
- action := osChildExitActions at:pid ifAbsent:nil.
- ] ifFalse:[
- action := osChildExitActions removeKey:pid ifAbsent:nil.
- ].
- action notNil ifTrue:[
- action value:osProcessStatus
- ].
- ].
-
- "/ if pollChildProcesses does block, poll only one status change.
- "/ we will get another SIGCHLD for other status changes.
-
- osProcessStatus notNil and:[blocking not]
- ] whileTrue.
-
- "/ if there are no more waiters, disable SIGCHILD handler.
- "/ this helps us with synchronous waiters (e.g. pclose),
- "/ But they should block SIGCHLD anyway.
-
- osChildExitActions isEmpty ifTrue:[
- OperatingSystem disableChildSignalInterrupts.
- ].
+ [
+ osProcessStatus := OperatingSystem childProcessWait:blocking pid:nil.
+ osProcessStatus notNil ifTrue:[
+ |pid action|
+
+ pid := osProcessStatus pid.
+ osProcessStatus stillAlive ifTrue:[
+ action := osChildExitActions at:pid ifAbsent:nil.
+ ] ifFalse:[
+ action := osChildExitActions removeKey:pid ifAbsent:nil.
+ ].
+ action notNil ifTrue:[
+ action value:osProcessStatus
+ ].
+ ].
+
+ "/ if pollChildProcesses does block, poll only one status change.
+ "/ we will get another SIGCHLD for other status changes.
+
+ osProcessStatus notNil and:[blocking not]
+ ] whileTrue.
+
+ "/ if there are no more waiters, disable SIGCHILD handler.
+ "/ this helps us with synchronous waiters (e.g. pclose),
+ "/ But they should block SIGCHLD anyway.
+
+ osChildExitActions isEmpty ifTrue:[
+ OperatingSystem disableChildSignalInterrupts.
+ ].
] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
"Modified: 5.1.1996 / 16:56:11 / stefan"
@@ -1203,7 +1216,7 @@
"/ start the OS-Process
pid := aBlockReturningPid value.
pid notNil ifTrue:[
- osChildExitActions at:pid put:actionBlock.
+ osChildExitActions at:pid put:actionBlock.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ pid
@@ -1229,10 +1242,10 @@
self scheduleInterruptActionsOf:aProcess.
aProcess state ~~ #stopped ifTrue:[
- "
- make the process runnable
- "
- self resume:aProcess
+ "
+ make the process runnable
+ "
+ self resume:aProcess
]
"Modified: / 24.8.1998 / 18:31:32 / cg"
@@ -1286,9 +1299,9 @@
extern OBJ ___threadSwitch();
if (__isSmallInteger(id)) {
- ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
+ ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
} else {
- ok = false;
+ ok = false;
}
%}.
@@ -1301,40 +1314,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].
@@ -1448,17 +1461,17 @@
index := 1.
sz := KnownProcessIds size.
[index <= sz] whileTrue:[
- (KnownProcesses at:index) isNil ifTrue:[
- oldId := KnownProcessIds at:index.
- oldId notNil ifTrue:[
- self class threadDestroy:oldId.
- ].
- KnownProcesses at:index put:aProcess.
- KnownProcessIds at:index put:aProcess id.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ].
- index := index + 1
+ (KnownProcesses at:index) isNil ifTrue:[
+ oldId := KnownProcessIds at:index.
+ oldId notNil ifTrue:[
+ self class threadDestroy:oldId.
+ ].
+ KnownProcesses at:index put:aProcess.
+ KnownProcessIds at:index put:aProcess id.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ].
+ index := index + 1
].
KnownProcessIds grow:index.
@@ -1466,10 +1479,10 @@
oldSize := KnownProcesses size.
(index > oldSize) ifTrue:[
- newShadow := WeakArray new:(oldSize * 2).
- newShadow addDependent:self class.
- newShadow replaceFrom:1 with:KnownProcesses.
- KnownProcesses := newShadow
+ newShadow := WeakArray new:(oldSize * 2).
+ newShadow addDependent:self class.
+ newShadow replaceFrom:1 with:KnownProcesses.
+ KnownProcesses := newShadow
].
KnownProcesses at:index put:aProcess.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -1485,8 +1498,8 @@
wasBlocked := OperatingSystem blockInterrupts.
index := KnownProcesses identityIndexOf:aProcess.
index ~~ 0 ifTrue:[
- KnownProcessIds at:index put:nil.
- KnownProcesses at:index put:nil.
+ KnownProcessIds at:index put:nil.
+ KnownProcesses at:index put:nil.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
! !
@@ -1511,12 +1524,12 @@
"private entry for Process restart - do not use in your program"
idWant isNil ifTrue:[
- self newProcessFor:aProcess.
- ^ true.
+ self newProcessFor:aProcess.
+ ^ true.
].
(self class threadCreate:aProcess withId:idWant) ~~ idWant ifTrue:[
- ^ false
+ ^ false
].
aProcess state:#light. "meaning: has no stack yet"
@@ -1557,16 +1570,16 @@
listArray := quiescentProcessLists.
[prio >= 1] whileTrue:[
- l := listArray at:prio.
- l notNil ifTrue:[
- l linksDo:[:aProcess |
- aProcess isUserProcess ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
- ]
- ]
- ].
- prio := prio - 1
+ l := listArray at:prio.
+ l notNil ifTrue:[
+ l linksDo:[:aProcess |
+ aProcess isUserProcess ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ true.
+ ]
+ ]
+ ].
+ prio := prio - 1
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ false
@@ -1589,23 +1602,23 @@
listArray := quiescentProcessLists.
[prio >= 1] whileTrue:[
- l := listArray at:prio.
- l notNil ifTrue:[
- l notEmpty ifTrue:[
- p := l firstLink.
- "
- if it got corrupted somehow ...
- "
- p isDead ifTrue:[
- 'Processor [warning]: dead process removed' errorPrintCR.
- l removeFirst.
- p := nil.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ p
- ]
- ].
- prio := prio - 1
+ l := listArray at:prio.
+ l notNil ifTrue:[
+ l notEmpty ifTrue:[
+ p := l firstLink.
+ "
+ if it got corrupted somehow ...
+ "
+ p isDead ifTrue:[
+ 'Processor [warning]: dead process removed' errorPrintCR.
+ l removeFirst.
+ p := nil.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ p
+ ]
+ ].
+ prio := prio - 1
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ nil
@@ -1655,22 +1668,22 @@
slot := KnownProcessIds indexOf:anInteger.
slot ~~ 0 ifTrue:[
- process := KnownProcesses at:slot ifAbsent:[].
+ process := KnownProcesses at:slot ifAbsent:[].
].
wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
"Take care, the process may already have been collected"
process == 0 ifTrue:[
- ^ nil.
+ ^ nil.
].
^ process.
"
- Processor processWithId:4
- Processor processWithId:4711
+ Processor processWithId:4
+ Processor processWithId:4711
"
! !
@@ -1690,48 +1703,48 @@
"
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 removeIdentical: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.
- ]
- ].
- timeSliceNeededSemaphore notNil ifTrue:[
- "/ tell timeslicer, that some work might be needed...
- timeSliceNeededSemaphore signalIf.
- ]
- ]
- ]
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ aProcess setPriority:newPrio.
+
+ oldList := quiescentProcessLists at:oldPrio.
+ oldList notNil ifTrue:[
+ (oldList removeIdentical: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.
+ ]
+ ].
+ timeSliceNeededSemaphore notNil ifTrue:[
+ "/ tell timeslicer, that some work might be needed...
+ timeSliceNeededSemaphore signalIf.
+ ]
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
"Modified: / 4.8.1998 / 00:08:54 / cg"
@@ -1753,13 +1766,13 @@
s := thisContext sender.
s selector == #threadSwitchFrom:to:id:singleStep: ifTrue:[
- s := s sender.
- s selector == #threadSwitch: ifTrue:[
- s := s sender.
- s selector == #timerInterrupt ifTrue:[
- s := s sender
- ]
- ]
+ s := s sender.
+ s selector == #threadSwitch: ifTrue:[
+ s := s sender.
+ s selector == #timerInterrupt ifTrue:[
+ s := s sender
+ ]
+ ]
].
"/ the returned value here has a subtle effect:
@@ -1781,21 +1794,21 @@
s := aProcess state.
s == #osWait ifTrue:[
- 'Processor [warning]: bad resume: #osWait' errorPrintCR.
- "/ MiniDebugger enterWithMessage:'bad resume: state osWait'.
- ^ false.
+ 'Processor [warning]: bad resume: #osWait' errorPrintCR.
+ "/ MiniDebugger enterWithMessage:'bad resume: state osWait'.
+ ^ false.
].
s == #stopped ifTrue:[
- "by definition, stopped processes cannot be resumed"
- ^ false.
+ "by definition, stopped processes cannot be resumed"
+ ^ false.
].
aProcess == activeProcess ifTrue:[
- "special handling for waiting schedulers"
- aProcess == scheduler ifTrue:[
- suspendScheduler := false.
- ].
- ^ false
+ "special handling for waiting schedulers"
+ aProcess == scheduler ifTrue:[
+ suspendScheduler := false.
+ ].
+ ^ false
].
wasBlocked := OperatingSystem blockInterrupts.
@@ -1805,26 +1818,26 @@
l := quiescentProcessLists at:pri.
"if already running, ignore"
l notNil ifTrue:[
- (l identityIndexOf:aProcess) ~~ 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ false
- ]
+ (l identityIndexOf:aProcess) ~~ 0 ifTrue:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ false
+ ]
] ifFalse:[
- l := LinkedList new.
- quiescentProcessLists at:pri put:l.
+ l := LinkedList new.
+ quiescentProcessLists at:pri put:l.
].
l addLast:aProcess.
aProcess state:#run.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
pri > currentPriority ifTrue:[
- "must reschedule"
- ^ true.
+ "must reschedule"
+ ^ true.
].
timeSliceNeededSemaphore notNil ifTrue:[
- "/ tell timeslicer, that some work might be needed...
- timeSliceNeededSemaphore signalIf.
+ "/ tell timeslicer, that some work might be needed...
+ timeSliceNeededSemaphore signalIf.
].
^ false.
@@ -1856,8 +1869,8 @@
if its prio is higher than the currently running prio, switch to it."
(self makeRunnable:aProcess) ifTrue:[
- "aProcess prio is higher; immediately transfer control to it"
- self threadSwitch:aProcess.
+ "aProcess prio is higher; immediately transfer control to it"
+ self threadSwitch:aProcess.
].
!
@@ -1877,8 +1890,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|
@@ -1886,30 +1899,30 @@
some debugging stuff
"
aProcess isNil ifTrue:[
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
- ^ self
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'nil suspend'.
+ ^ self
].
aProcess isDead ifTrue:[
- InvalidProcessSignal raiseRequestWith:aProcess errorString:'bad suspend: already dead'.
- self threadSwitch:scheduler.
- ^ self
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'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 raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
- ^ self
+ "only the scheduler may suspend itself"
+ activeProcess == scheduler ifTrue:[
+ suspendScheduler := true.
+ [suspendScheduler] whileTrue:[
+ self dispatch.
+ ].
+ ^ self
+ ].
+
+ InvalidProcessSignal raiseRequestWith:aProcess errorString:'attempt to suspend scheduler'.
+ ^ self
].
aProcess hasInterruptActions ifTrue:[
- aProcess interrupt.
+ aProcess interrupt.
].
wasBlocked := OperatingSystem blockInterrupts.
@@ -1921,23 +1934,23 @@
the ifAbsent block, because [] is a shared cheap block, created at compile time
"
(l isNil or:[(l removeIdentical:aProcess ifAbsent:nil) isNil]) ifTrue:[
- "/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
- "/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
- aProcess == activeProcess ifTrue:[
- self threadSwitch:scheduler.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ "/ 'Processor [warning]: bad suspend: process is not running' errorPrintCR.
+ "/ MiniDebugger enterWithMessage:'bad suspend: process is not running'.
+ aProcess == activeProcess ifTrue:[
+ self threadSwitch:scheduler.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
(aProcess == activeProcess) ifTrue:[
- "we can immediately switch sometimes"
- l isEmpty ifTrue:[
- p := scheduler
- ] ifFalse:[
- p := l firstLink
- ].
- self threadSwitch:p
+ "we can immediately switch sometimes"
+ l isEmpty ifTrue:[
+ p := scheduler
+ ] ifFalse:[
+ p := l firstLink
+ ].
+ self threadSwitch:p
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -1984,16 +1997,16 @@
aProcess isNil ifTrue:[^ self].
aProcess == scheduler ifTrue:[
- InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
- ^ self
+ InvalidProcessSignal raiseWith:aProcess errorString:'attempt to terminate scheduler'.
+ ^ self
].
wasBlocked := OperatingSystem blockInterrupts.
id := aProcess id.
id isNil ifTrue:[ "already dead"
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
aProcess setId:nil state:#dead.
@@ -2003,31 +2016,31 @@
pri := aProcess priority.
l := quiescentProcessLists at:pri.
l notNil ifTrue:[
- (l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
- l isEmpty ifTrue:[
- quiescentProcessLists at:pri put:nil
- ]
- ]."
+ (l removeIdentical:aProcess ifAbsent:nil) "notNil ifTrue:[
+ l isEmpty ifTrue:[
+ quiescentProcessLists at:pri put:nil
+ ]
+ ]."
].
aProcess == activeProcess ifTrue:[
- "
- hard case - it's the currently running process
- we must have the next active process destroy this one
- (we cannot destroy the chair we are sitting on ... :-)
- "
- zombie notNil ifTrue:[
- self error:'active process is zombie' mayProceed:true.
- self class threadDestroy:zombie.
- ].
-
- self unRemember:aProcess.
- zombie := id.
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self threadSwitch:scheduler.
- "not reached"
- ^ self
+ "
+ hard case - it's the currently running process
+ we must have the next active process destroy this one
+ (we cannot destroy the chair we are sitting on ... :-)
+ "
+ zombie notNil ifTrue:[
+ self error:'active process is zombie' mayProceed:true.
+ self class threadDestroy:zombie.
+ ].
+
+ self unRemember:aProcess.
+ zombie := id.
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self threadSwitch:scheduler.
+ "not reached"
+ ^ self
].
self unRemember:aProcess.
@@ -2050,16 +2063,16 @@
wasBlocked := OperatingSystem blockInterrupts.
activeProcess == scheduler ifTrue:[
- 'Processor [warning]: scheduler tries to yield' errorPrintCR.
- ^ self
+ 'Processor [warning]: scheduler tries to yield' errorPrintCR.
+ ^ self
].
"
debugging consistency check - will be removed later
"
activeProcess priority ~~ currentPriority ifTrue:[
- 'Processor [warning]: process changed its priority' errorPrintCR.
- currentPriority := activeProcess priority.
+ 'Processor [warning]: process changed its priority' errorPrintCR.
+ currentPriority := activeProcess priority.
].
l := quiescentProcessLists at:currentPriority.
@@ -2069,25 +2082,25 @@
debugging consistency checks - will be removed later
"
sz == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- 'Processor [warning]: empty runnable list' errorPrintCR.
- ^ self
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ 'Processor [warning]: empty runnable list' errorPrintCR.
+ ^ self
].
"
check if the running process is not the only one
"
sz ~~ 1 ifTrue:[
- "
- bring running process to the end
- "
- l removeFirst.
- l addLast:activeProcess.
-
- "
- and switch to first in the list
- "
- self threadSwitch:(l firstLink).
+ "
+ bring running process to the end
+ "
+ l removeFirst.
+ l addLast:activeProcess.
+
+ "
+ and switch to first in the list
+ "
+ self threadSwitch:(l firstLink).
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2102,63 +2115,63 @@
|processesToDecrease processesToIncrease|
scheduledProcesses notNil ifTrue:[
- "/ this is written a bit cryptic - to avoid creation
- "/ of garbage objects (Id'sets) if possible.
- "/ since this runs 50 times a second and most of the
- "/ time, no rescheduling is req'd
-
- scheduledProcesses do:[:aProcess |
- |range|
-
- "/ decrease priority of processes that did run
- (range := aProcess priorityRange) notNil ifTrue:[
- aProcess priority > range start ifTrue:[
- processesToDecrease isNil ifTrue:[
- processesToDecrease := IdentitySet new.
- ].
- processesToDecrease add:aProcess.
- ]
- ]
- ].
-
- processesToDecrease notNil ifTrue:[
- processesToDecrease do:[:aProcess |
- |newPri|
-
- "/ newPri := aProcess priority - 1.
- newPri := aProcess priorityRange start.
- self changePriority:newPri for:aProcess.
- ].
- ].
-
- "/ and increase all prios of those that did not run, but are runnable
-
- TimeSlicingPriorityLimit to:1 by:-1 do:[:i |
- |list|
-
- (list := quiescentProcessLists at:i) size > 0 ifTrue:[
- list linksDo:[:aProcess |
- |range prio|
-
- (range := aProcess priorityRange) notNil ifTrue:[
- (processesToDecrease isNil
- or:[(processesToDecrease includes:aProcess) not]) ifTrue:[
- aProcess priority < range stop ifTrue:[
- processesToIncrease isNil ifTrue:[
- processesToIncrease := OrderedCollection new.
- ].
- processesToIncrease add:aProcess
- ]
- ]
- ]
- ]
- ]
- ].
- processesToIncrease notNil ifTrue:[
- processesToIncrease do:[:aProcess |
- self changePriority:(aProcess priority + 1) for:aProcess.
- ].
- ].
+ "/ this is written a bit cryptic - to avoid creation
+ "/ of garbage objects (Id'sets) if possible.
+ "/ since this runs 50 times a second and most of the
+ "/ time, no rescheduling is req'd
+
+ scheduledProcesses do:[:aProcess |
+ |range|
+
+ "/ decrease priority of processes that did run
+ (range := aProcess priorityRange) notNil ifTrue:[
+ aProcess priority > range start ifTrue:[
+ processesToDecrease isNil ifTrue:[
+ processesToDecrease := IdentitySet new.
+ ].
+ processesToDecrease add:aProcess.
+ ]
+ ]
+ ].
+
+ processesToDecrease notNil ifTrue:[
+ processesToDecrease do:[:aProcess |
+ |newPri|
+
+ "/ newPri := aProcess priority - 1.
+ newPri := aProcess priorityRange start.
+ self changePriority:newPri for:aProcess.
+ ].
+ ].
+
+ "/ and increase all prios of those that did not run, but are runnable
+
+ TimeSlicingPriorityLimit to:1 by:-1 do:[:i |
+ |list|
+
+ (list := quiescentProcessLists at:i) size > 0 ifTrue:[
+ list linksDo:[:aProcess |
+ |range prio|
+
+ (range := aProcess priorityRange) notNil ifTrue:[
+ (processesToDecrease isNil
+ or:[(processesToDecrease includes:aProcess) not]) ifTrue:[
+ aProcess priority < range stop ifTrue:[
+ processesToIncrease isNil ifTrue:[
+ processesToIncrease := OrderedCollection new.
+ ].
+ processesToIncrease add:aProcess
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ processesToIncrease notNil ifTrue:[
+ processesToIncrease do:[:aProcess |
+ self changePriority:(aProcess priority + 1) for:aProcess.
+ ].
+ ].
].
"Modified: / 30-07-2013 / 19:33:14 / cg"
@@ -2187,14 +2200,14 @@
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).
- anyShuffle := true.
+ "/ shuffle that list
+ list addLast:(list removeFirst).
+ anyShuffle := true.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
anyShuffle ifFalse:[
- "/ wait for the scheduler to make some process runnable...
- timeSliceNeededSemaphore wait.
+ "/ wait for the scheduler to make some process runnable...
+ timeSliceNeededSemaphore wait.
].
"Modified: / 4.8.1998 / 00:13:32 / cg"
@@ -2208,19 +2221,19 @@
timeSliceNeededSemaphore := Semaphore new name:'timeSlice needed'.
timeSliceProcess := [
- [
- self timeSlicingLoop.
- ] ifCurtailed:[
- timeSliceProcess := nil.
- 'Processor [info]: timeslicer finished' infoPrintCR.
- ]
+ [
+ self timeSlicingLoop.
+ ] ifCurtailed:[
+ timeSliceProcess := nil.
+ 'Processor [info]: timeslicer finished' infoPrintCR.
+ ]
] newProcess.
- timeSliceProcess
- priority:HighestPriority;
- name:'time slicer';
- restartable:true;
- beSystemProcess;
- resume.
+ timeSliceProcess
+ priority:HighestPriority;
+ name:'time slicer';
+ restartable:true;
+ beSystemProcess;
+ resume.
"
Processor stopTimeSlicing.
@@ -2235,10 +2248,10 @@
"stop preemptive scheduling (timeSlicing)"
timeSliceProcess notNil ifTrue: [
- timeSliceProcess terminate.
- timeSliceProcess := nil.
- scheduledProcesses := nil.
- timeSliceNeededSemaphore := nil.
+ timeSliceProcess terminate.
+ timeSliceProcess := nil.
+ scheduledProcesses := nil.
+ timeSliceNeededSemaphore := nil.
]
"
@@ -2279,25 +2292,25 @@
'Processor [info]: timeslicer started' infoPrintCR.
[
- 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 notNil ifTrue:[
- supportDynamicPriorities ifTrue:[
- self recomputeDynamicPriorities.
- ].
- scheduledProcesses clearContents.
- ] ifFalse:[
- scheduledProcesses := IdentitySet new.
- ].
- ].
+ 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 notNil ifTrue:[
+ supportDynamicPriorities ifTrue:[
+ self recomputeDynamicPriorities.
+ ].
+ scheduledProcesses clearContents.
+ ] ifFalse:[
+ scheduledProcesses := IdentitySet new.
+ ].
+ ].
] loop.
! !
@@ -2312,37 +2325,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.
- writeCheckArray 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].
@@ -2401,20 +2414,20 @@
wasBlocked := OperatingSystem blockInterrupts.
index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime
+ timeoutArray at:index put:aMillisecondTime
] ifFalse:[
- index := timeoutArray identityIndexOf:nil startingAt:1.
- index ~~ 0 ifTrue:[
- timeoutSemaphoreArray at:index put:aSemaphore.
- timeoutArray at:index put:aMillisecondTime.
- timeoutActionArray at:index put:nil.
- timeoutProcessArray at:index put:nil
- ] ifFalse:[
- timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:aSemaphore.
- timeoutArray := timeoutArray copyWith:aMillisecondTime.
- timeoutActionArray := timeoutActionArray copyWith:nil.
- timeoutProcessArray := timeoutProcessArray copyWith:nil
- ].
+ index := timeoutArray identityIndexOf:nil startingAt:1.
+ index ~~ 0 ifTrue:[
+ timeoutSemaphoreArray at:index put:aSemaphore.
+ timeoutArray at:index put:aMillisecondTime.
+ timeoutActionArray at:index put:nil.
+ timeoutProcessArray at:index put:nil
+ ] ifFalse:[
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:aSemaphore.
+ timeoutArray := timeoutArray copyWith:aMillisecondTime.
+ timeoutActionArray := timeoutActionArray copyWith:nil.
+ timeoutProcessArray := timeoutProcessArray copyWith:nil
+ ].
].
anyTimeouts := true.
@@ -2448,57 +2461,57 @@
aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil"
aFileDescriptor isNil ifTrue:[
- idx := readSemaphoreArray identityIndexOf:aSemaphore or:nil.
- idx == 0 ifTrue:[
- "aSemaphore is not registered yet, have to create a new slot"
- readFdArray := readFdArray copyWith:nil.
- readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
- readCheckArray := readCheckArray copyWith:aBlock.
- ] ifFalse:[
- slot := readSemaphoreArray at:idx.
- slot isNil ifTrue:[
- readSemaphoreArray at:idx put:aSemaphore.
- readCheckArray at:idx put:aBlock
- ] ifFalse:[
- "/ someone has already registered aSemaphore.
- "/ Check if it is the block changes...
- (readCheckArray at:idx) notNil ifTrue:[
- (readCheckArray at:idx) ~~ aBlock ifTrue:[
- 'Processor [info]: checkblock changed for read-check' infoPrintCR.
- readCheckArray at:idx put:aBlock.
- ].
- ].
- ].
- ]
+ idx := readSemaphoreArray identityIndexOf:aSemaphore or:nil.
+ idx == 0 ifTrue:[
+ "aSemaphore is not registered yet, have to create a new slot"
+ readFdArray := readFdArray copyWith:nil.
+ readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+ readCheckArray := readCheckArray copyWith:aBlock.
+ ] ifFalse:[
+ slot := readSemaphoreArray at:idx.
+ slot isNil ifTrue:[
+ readSemaphoreArray at:idx put:aSemaphore.
+ readCheckArray at:idx put:aBlock
+ ] ifFalse:[
+ "/ someone has already registered aSemaphore.
+ "/ Check if it is the block changes...
+ (readCheckArray at:idx) notNil ifTrue:[
+ (readCheckArray at:idx) ~~ aBlock ifTrue:[
+ 'Processor [info]: checkblock changed for read-check' infoPrintCR.
+ readCheckArray at:idx put:aBlock.
+ ].
+ ].
+ ].
+ ]
] ifFalse:[
- idx := readFdArray identityIndexOf:aFileDescriptor or:nil.
- idx == 0 ifTrue:[
- "aFileDescriptor is not registered yet, have to create a new slot"
- readFdArray := readFdArray copyWith:aFileDescriptor.
- readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
- readCheckArray := readCheckArray copyWith:aBlock.
- ] ifFalse:[
- slot := readFdArray at:idx.
- slot isNil ifTrue:[
- readFdArray at:idx put:aFileDescriptor.
- readSemaphoreArray at:idx put:aSemaphore.
- readCheckArray at:idx put:aBlock
- ] ifFalse:[
- "/ someone has already registered aFileDescriptor.
- "/ Check if it is the semaphore or block changes...
- (readSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[
- 'Processor [info]: sema changed for read-check' infoPrintCR.
- readSemaphoreArray at:idx put:aSemaphore.
- ].
- (readCheckArray at:idx) ~~ aBlock ifTrue:[
- 'Processor [info]: checkblock changed for read-check' infoPrintCR.
- readCheckArray at:idx put:aBlock.
- ].
- ].
- ].
- (useIOInterrupts and:[slot isNil]) ifTrue:[
- OperatingSystem enableIOInterruptsOn:aFileDescriptor
- ].
+ idx := readFdArray identityIndexOf:aFileDescriptor or:nil.
+ idx == 0 ifTrue:[
+ "aFileDescriptor is not registered yet, have to create a new slot"
+ readFdArray := readFdArray copyWith:aFileDescriptor.
+ readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+ readCheckArray := readCheckArray copyWith:aBlock.
+ ] ifFalse:[
+ slot := readFdArray at:idx.
+ slot isNil ifTrue:[
+ readFdArray at:idx put:aFileDescriptor.
+ readSemaphoreArray at:idx put:aSemaphore.
+ readCheckArray at:idx put:aBlock
+ ] ifFalse:[
+ "/ someone has already registered aFileDescriptor.
+ "/ Check if it is the semaphore or block changes...
+ (readSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[
+ 'Processor [info]: sema changed for read-check' infoPrintCR.
+ readSemaphoreArray at:idx put:aSemaphore.
+ ].
+ (readCheckArray at:idx) ~~ aBlock ifTrue:[
+ 'Processor [info]: checkblock changed for read-check' infoPrintCR.
+ readCheckArray at:idx put:aBlock.
+ ].
+ ].
+ ].
+ (useIOInterrupts and:[slot isNil]) ifTrue:[
+ OperatingSystem enableIOInterruptsOn:aFileDescriptor
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2511,11 +2524,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"
@@ -2549,57 +2562,57 @@
aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil"
aFileDescriptor isNil ifTrue:[
- idx := writeSemaphoreArray identityIndexOf:aSemaphore or:nil.
- idx == 0 ifTrue:[
- "aSemaphore is not registered yet, have to create a new slot"
- writeFdArray := writeFdArray copyWith:nil.
- writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
- writeCheckArray := writeCheckArray copyWith:aBlock.
- ] ifFalse:[
- slot := writeSemaphoreArray at:idx.
- slot isNil ifTrue:[
- writeSemaphoreArray at:idx put:aSemaphore.
- writeCheckArray at:idx put:aBlock
- ] ifFalse:[
- "/ someone has already registered aSemaphore.
- "/ Check if it is the block changes...
- (writeCheckArray at:idx) notNil ifTrue:[
- (writeCheckArray at:idx) ~~ aBlock ifTrue:[
- 'Processor [info]: checkblock changed for write-check' infoPrintCR.
- writeCheckArray at:idx put:aBlock.
- ].
- ].
- ].
- ]
+ idx := writeSemaphoreArray identityIndexOf:aSemaphore or:nil.
+ idx == 0 ifTrue:[
+ "aSemaphore is not registered yet, have to create a new slot"
+ writeFdArray := writeFdArray copyWith:nil.
+ writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+ writeCheckArray := writeCheckArray copyWith:aBlock.
+ ] ifFalse:[
+ slot := writeSemaphoreArray at:idx.
+ slot isNil ifTrue:[
+ writeSemaphoreArray at:idx put:aSemaphore.
+ writeCheckArray at:idx put:aBlock
+ ] ifFalse:[
+ "/ someone has already registered aSemaphore.
+ "/ Check if it is the block changes...
+ (writeCheckArray at:idx) notNil ifTrue:[
+ (writeCheckArray at:idx) ~~ aBlock ifTrue:[
+ 'Processor [info]: checkblock changed for write-check' infoPrintCR.
+ writeCheckArray at:idx put:aBlock.
+ ].
+ ].
+ ].
+ ]
] ifFalse:[
- idx := writeFdArray identityIndexOf:aFileDescriptor or:nil.
- idx == 0 ifTrue:[
- "aFileDescriptor is not registered yet, have to create a new slot"
- writeFdArray := writeFdArray copyWith:aFileDescriptor.
- writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
- writeCheckArray := writeCheckArray copyWith:aBlock.
- ] ifFalse:[
- slot := writeFdArray at:idx.
- slot isNil ifTrue:[
- writeFdArray at:idx put:aFileDescriptor.
- writeSemaphoreArray at:idx put:aSemaphore.
- writeCheckArray at:idx put:aBlock
- ] ifFalse:[
- "/ someone has already registered aFileDescriptor.
- "/ Check if it is the semaphore or block changes...
- (writeSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[
- 'Processor [info]: sema changed for write-check' infoPrintCR.
- writeSemaphoreArray at:idx put:aSemaphore.
- ].
- (writeCheckArray at:idx) ~~ aBlock ifTrue:[
- 'Processor [info]: checkblock changed for write-check' infoPrintCR.
- writeCheckArray at:idx put:aBlock.
- ].
- ].
- ].
- (useIOInterrupts and:[slot isNil]) ifTrue:[
- OperatingSystem enableIOInterruptsOn:aFileDescriptor
- ].
+ idx := writeFdArray identityIndexOf:aFileDescriptor or:nil.
+ idx == 0 ifTrue:[
+ "aFileDescriptor is not registered yet, have to create a new slot"
+ writeFdArray := writeFdArray copyWith:aFileDescriptor.
+ writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+ writeCheckArray := writeCheckArray copyWith:aBlock.
+ ] ifFalse:[
+ slot := writeFdArray at:idx.
+ slot isNil ifTrue:[
+ writeFdArray at:idx put:aFileDescriptor.
+ writeSemaphoreArray at:idx put:aSemaphore.
+ writeCheckArray at:idx put:aBlock
+ ] ifFalse:[
+ "/ someone has already registered aFileDescriptor.
+ "/ Check if it is the semaphore or block changes...
+ (writeSemaphoreArray at:idx) ~~ aSemaphore ifTrue:[
+ 'Processor [info]: sema changed for write-check' infoPrintCR.
+ writeSemaphoreArray at:idx put:aSemaphore.
+ ].
+ (writeCheckArray at:idx) ~~ aBlock ifTrue:[
+ 'Processor [info]: checkblock changed for write-check' infoPrintCR.
+ writeCheckArray at:idx put:aBlock.
+ ].
+ ].
+ ].
+ (useIOInterrupts and:[slot isNil]) ifTrue:[
+ OperatingSystem enableIOInterruptsOn:aFileDescriptor
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2612,11 +2625,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"
@@ -2633,18 +2646,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"
@@ -2792,21 +2805,21 @@
wasBlocked := OperatingSystem blockInterrupts.
index := timeoutActionArray identityIndexOf:aBlock startingAt:1.
index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime
+ timeoutArray at:index put:aMillisecondTime
] ifFalse:[
- index := timeoutArray indexOf:nil.
- index ~~ 0 ifTrue:[
- timeoutArray at:index put:aMillisecondTime.
- timeoutActionArray at:index put:aBlock.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:aProcess
- ] ifFalse:[
- timeoutArray := timeoutArray copyWith:aMillisecondTime.
- timeoutActionArray := timeoutActionArray copyWith:aBlock.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
- timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
- index := timeoutArray size.
- ].
+ index := timeoutArray indexOf:nil.
+ index ~~ 0 ifTrue:[
+ timeoutArray at:index put:aMillisecondTime.
+ timeoutActionArray at:index put:aBlock.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:aProcess
+ ] ifFalse:[
+ timeoutArray := timeoutArray copyWith:aMillisecondTime.
+ timeoutActionArray := timeoutActionArray copyWith:aBlock.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
+ timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
+ index := timeoutArray size.
+ ].
].
anyTimeouts := true.
@@ -2833,10 +2846,10 @@
then := OperatingSystem millisecondTimeAdd:now and:delta.
id := self
- addTimeoutFunctionCall:anExternalFunction
- for:aProcess
- atMilliseconds:then
- with:argument.
+ addTimeoutFunctionCall:anExternalFunction
+ for:aProcess
+ atMilliseconds:then
+ with:argument.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ id
@@ -2859,9 +2872,9 @@
action := [anExternalFunction callWith:argument].
^ self
- addTimedBlock:action
- for:aProcess
- atMilliseconds:milliTime.
+ addTimedBlock:action
+ for:aProcess
+ atMilliseconds:milliTime.
"Created: 23.9.1996 / 14:29:30 / cg"
"Modified: 23.9.1996 / 14:34:57 / cg"
@@ -2871,7 +2884,7 @@
"walk through timeouts and evaluate blocks or signal semas that need to be .."
|sema now aTime block blocksAndProcessesToEvaluate
- firstBlockToEvaluate firstProcess
+ firstBlockToEvaluate firstProcess
n "{ Class: SmallInteger }"
indexOfLastTimeout "{ Class: SmallInteger }"
halfSize "{ Class: SmallInteger }"
@@ -2881,7 +2894,7 @@
anyTimeouts ifFalse:[ ^ self].
anyTimeouts := false.
- "have to collect the blocks first, then evaluate them.
+ "have to collect the blocks first, then evaluate them.
This avoids problems due to newly inserted blocks."
"/ notice: the code looks uglier than seems to be required;
@@ -2895,110 +2908,110 @@
now := OperatingSystem getMillisecondTime.
n := timeoutArray size.
1 to:n do:[:index |
- aTime := timeoutArray at:index.
- aTime notNil ifTrue:[
- (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[
- "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:[
- firstBlockToEvaluate isNil ifTrue:[
- firstBlockToEvaluate := block.
- firstProcess := timeoutProcessArray at:index.
- ] ifFalse:[
- blocksAndProcessesToEvaluate isNil ifTrue:[
- blocksAndProcessesToEvaluate := OrderedCollection
- with:firstBlockToEvaluate
- with:firstProcess.
- ].
- blocksAndProcessesToEvaluate add:block.
- blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
- ].
- timeoutActionArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
- ]
- ].
- timeoutArray at:index put:nil.
- ] ifFalse:[
- "there are still pending timeouts"
- anyTimeouts := true.
- indexOfLastTimeout := index.
- ]
- ]
+ aTime := timeoutArray at:index.
+ aTime notNil ifTrue:[
+ (OperatingSystem millisecondTime:now isAfter:aTime) ifTrue:[
+ "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:[
+ firstBlockToEvaluate isNil ifTrue:[
+ firstBlockToEvaluate := block.
+ firstProcess := timeoutProcessArray at:index.
+ ] ifFalse:[
+ blocksAndProcessesToEvaluate isNil ifTrue:[
+ blocksAndProcessesToEvaluate := OrderedCollection
+ with:firstBlockToEvaluate
+ with:firstProcess.
+ ].
+ blocksAndProcessesToEvaluate add:block.
+ blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
+ ].
+ timeoutActionArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
+ ]
+ ].
+ timeoutArray at:index put:nil.
+ ] ifFalse:[
+ "there are still pending timeouts"
+ anyTimeouts := true.
+ indexOfLastTimeout := index.
+ ]
+ ]
].
"shrink the arrays, if they are 50% free"
n > 20 ifTrue:[
- halfSize := n // 2.
- indexOfLastTimeout < halfSize ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived
- timeoutArray := timeoutArray copyTo:halfSize.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
- timeoutActionArray := timeoutActionArray copyTo:halfSize.
- timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
- ].
- wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
- ].
+ halfSize := n // 2.
+ indexOfLastTimeout < halfSize ifTrue:[
+ wasBlocked := OperatingSystem blockInterrupts.
+ (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived
+ timeoutArray := timeoutArray copyTo:halfSize.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
+ timeoutActionArray := timeoutActionArray copyTo:halfSize.
+ timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+ ].
].
blocksAndProcessesToEvaluate isNil ifTrue:[
- firstBlockToEvaluate notNil ifTrue:[
- (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
- firstBlockToEvaluate value
- ] ifFalse:[
- firstProcess 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.)
+ firstBlockToEvaluate notNil ifTrue:[
+ (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
+ firstBlockToEvaluate value
+ ] ifFalse:[
+ firstProcess 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.)
"/ Could handle it in timeoutProcess, but we don't,
"/ because otherwise timeouts might be reissued forever...
"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
"/ timeoutHandlerProcess interruptWith:block.
"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR.
- ('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , firstProcess name , '''') infoPrintCR.
+ ('ProcessorScheduler [warning]: the timedBlock is: ' , firstBlockToEvaluate displayString) infoPrintCR.
"/ ].
- ] ifFalse:[
- firstProcess interruptWith:firstBlockToEvaluate
- ]
- ]
- ].
+ ] ifFalse:[
+ firstProcess interruptWith:firstBlockToEvaluate
+ ]
+ ]
+ ].
] ifFalse:[
- n := blocksAndProcessesToEvaluate size.
- 1 to:n by:2 do:[:index |
- block := blocksAndProcessesToEvaluate at:index.
- p := blocksAndProcessesToEvaluate at:index+1.
- (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
- 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.)
+ n := blocksAndProcessesToEvaluate size.
+ 1 to:n by:2 do:[:index |
+ block := blocksAndProcessesToEvaluate at:index.
+ p := blocksAndProcessesToEvaluate at:index+1.
+ (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+ 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.)
"/ Could handle it in timeoutProcess, but we don't,
"/ because otherwise timeouts might be reissued forever...
"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
"/ timeoutHandlerProcess interruptWith:block.
"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
- ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+ ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
"/ ].
- ] ifFalse:[
- p interruptWith:block
- ]
- ]
- ]
+ ] ifFalse:[
+ p interruptWith:block
+ ]
+ ]
+ ]
].
"Modified: / 30-07-2013 / 19:33:24 / cg"
@@ -3015,10 +3028,10 @@
wasBlocked := OperatingSystem blockInterrupts.
index := timeoutActionArray identityIndexOf:aBlock startingAt:1.
(index ~~ 0) ifTrue:[
- timeoutArray at:index put:nil.
- timeoutActionArray at:index put:nil.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
+ timeoutArray at:index put:nil.
+ timeoutActionArray at:index put:nil.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
@@ -3032,14 +3045,14 @@
index := anID.
(index > 0) ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
-
- timeoutArray at:index put:nil.
- timeoutActionArray at:index put:nil.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ timeoutArray at:index put:nil.
+ timeoutActionArray at:index put:nil.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
"Created: 23.9.1996 / 14:32:33 / cg"
@@ -3048,20 +3061,20 @@
timeoutHandlerProcess
(timeoutHandlerProcess isNil or:[timeoutHandlerProcess isDead]) ifTrue:[
- timeoutHandlerProcess :=
- [
- [
- self timeoutHandlerProcessLoop.
- ] ensure:[
- timeoutHandlerProcess := nil
- ].
- ] newProcess.
-
- timeoutHandlerProcess
- priority:TimingPriority;
- name:'timeout handler';
- beSystemProcess;
- resume.
+ timeoutHandlerProcess :=
+ [
+ [
+ self timeoutHandlerProcessLoop.
+ ] ensure:[
+ timeoutHandlerProcess := nil
+ ].
+ ] newProcess.
+
+ timeoutHandlerProcess
+ priority:TimingPriority;
+ name:'timeout handler';
+ beSystemProcess;
+ resume.
].
^ timeoutHandlerProcess.
@@ -3073,15 +3086,15 @@
It exists only, so that timeout blocks may be executed in its context."
[
- [
- (Semaphore new name:'timeoutHandler') wait.
- ] on:Exception do:[:ex|
- "ignore errors, but tell the user"
- InfoPrinting == true ifTrue:[
- ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
- thisContext fullPrintAll.
- ].
- ].
+ [
+ (Semaphore new name:'timeoutHandler') wait.
+ ] on:Exception do:[:ex|
+ "ignore errors, but tell the user"
+ InfoPrinting == true ifTrue:[
+ ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
+ thisContext fullPrintAll.
+ ].
+ ].
] loop.
! !
@@ -3098,7 +3111,7 @@
wasBlocked := OperatingSystem blockInterrupts.
preWaitActions isNil ifTrue:[
- preWaitActions := OrderedCollection new
+ preWaitActions := OrderedCollection new
].
preWaitActions add:aBlock.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -3133,153 +3146,153 @@
newProcessMaybeReady := false.
readableResultFdArray size < readFdArray size ifTrue:[
- readableResultFdArray := Array new:(40 max:readFdArray size).
+ readableResultFdArray := Array new:(40 max:readFdArray size).
].
writableResultFdArray size < writeFdArray size ifTrue:[
- writableResultFdArray := Array new:(40 max:writeFdArray size).
+ writableResultFdArray := Array new:(40 max:writeFdArray size).
].
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- osChildExitActions keysDo:[:eachPid|
- eachPid address = 0 ifTrue:[
- 'Processor: remove 0 handle pid: ' infoPrint. eachPid infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ] ifFalse:[
- pidsFinished isNil ifTrue:[
- exceptArray := osChildExitActions keyArray.
- pidsFinished := Array new:osChildExitActions size.
- ].
- ].
- ].
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ osChildExitActions keysDo:[:eachPid|
+ eachPid address = 0 ifTrue:[
+ 'Processor: remove 0 handle pid: ' infoPrint. eachPid infoPrintCR.
+ osChildExitActions safeRemoveKey:eachPid.
+ ] ifFalse:[
+ pidsFinished isNil ifTrue:[
+ exceptArray := osChildExitActions keyArray.
+ pidsFinished := Array new:osChildExitActions size.
+ ].
+ ].
+ ].
].
nReady := OperatingSystem
- selectOnAnyReadable:readFdArray
- writable:writeFdArray
- exception:exceptArray
- readableInto:readableResultFdArray
- writableInto:writableResultFdArray
- exceptionInto:pidsFinished
- withTimeOut:millis.
+ selectOnAnyReadable:readFdArray
+ writable:writeFdArray
+ exception:exceptArray
+ readableInto:readableResultFdArray
+ writableInto:writableResultFdArray
+ exceptionInto:pidsFinished
+ withTimeOut:millis.
wasBlocked ifTrue:[
- OperatingSystem blockInterrupts.
+ OperatingSystem blockInterrupts.
].
nReady <= 0 ifTrue:[
- "/ either still nothing to do,
- "/ or error (which should not happen)
-
- (nReady < 0 and:[(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
- 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)
+
+ (nReady < 0 and:[(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
+ 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:[
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= readableResultFdArray size
- and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]]
- whileTrue:[
- index := readFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- action := readCheckArray at:index.
- sema := readSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- action isNil ifTrue:[
- "before May 2014 we disabled the sema in the caller after wakeup.
- This caused ST/X to consume 100% cpu, when the caller didn't read
- the data (e.g. because his process was stopped)."
- useIOInterrupts ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- readFdArray at:index put:nil.
- readSemaphoreArray at:index put:nil.
- "disable possible write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- action notNil ifTrue:[
- action value.
- newProcessMaybeReady := true
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
-
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= writableResultFdArray size
- and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]]
- whileTrue:[
- index := writeFdArray identityIndexOf:fd.
- index ~~ 0 ifTrue:[
- action := writeCheckArray at:index.
- sema := writeSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- action isNil ifTrue:[
- "now this is a one shot operation - see the input above"
- useIOInterrupts ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- writeFdArray at:index put:nil.
- writeSemaphoreArray at:index put:nil.
- "disable possible read side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- action notNil ifTrue:[
- action value.
- newProcessMaybeReady := true
- ]
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
-
- exceptArray notNil ifTrue:[
- "/ only for win32
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= pidsFinished size
- and:[ (pid := pidsFinished at:readyIndex) notNil ]]]
- whileTrue:[
- |osProcessStatus actionBlock|
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= readableResultFdArray size
+ and:[ (fd := readableResultFdArray at:readyIndex) notNil ]]]
+ whileTrue:[
+ index := readFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ action := readCheckArray at:index.
+ sema := readSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ action isNil ifTrue:[
+ "before May 2014 we disabled the sema in the caller after wakeup.
+ This caused ST/X to consume 100% cpu, when the caller didn't read
+ the data (e.g. because his process was stopped)."
+ useIOInterrupts ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ readFdArray at:index put:nil.
+ readSemaphoreArray at:index put:nil.
+ "disable possible write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ action notNil ifTrue:[
+ action value.
+ newProcessMaybeReady := true
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
+
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= writableResultFdArray size
+ and:[ (fd := writableResultFdArray at:readyIndex) notNil ]]]
+ whileTrue:[
+ index := writeFdArray identityIndexOf:fd.
+ index ~~ 0 ifTrue:[
+ action := writeCheckArray at:index.
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ action isNil ifTrue:[
+ "now this is a one shot operation - see the input above"
+ useIOInterrupts ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ writeFdArray at:index put:nil.
+ writeSemaphoreArray at:index put:nil.
+ "disable possible read side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ action notNil ifTrue:[
+ action value.
+ newProcessMaybeReady := true
+ ]
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
+
+ exceptArray notNil ifTrue:[
+ "/ only for win32
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= pidsFinished size
+ and:[ (pid := pidsFinished at:readyIndex) notNil ]]]
+ whileTrue:[
+ |osProcessStatus actionBlock|
"/'pid signaled: ' infoPrint. pid infoPrintCR.
- actionBlock := osChildExitActions removeKey:pid ifAbsent:nil.
- osProcessStatus := OperatingSystem childProcessWait:false pid:pid.
- osProcessStatus notNil ifTrue:[
- (osProcessStatus pid = pid) ifTrue:[
- actionBlock notNil ifTrue:[
- actionBlock value:osProcessStatus.
- newProcessMaybeReady := true
- ].
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
- ].
+ actionBlock := osChildExitActions removeKey:pid ifAbsent:nil.
+ osProcessStatus := OperatingSystem childProcessWait:false pid:pid.
+ osProcessStatus notNil ifTrue:[
+ (osProcessStatus pid = pid) ifTrue:[
+ actionBlock notNil ifTrue:[
+ actionBlock value:osProcessStatus.
+ newProcessMaybeReady := true
+ ].
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
+ ].
].
^ newProcessMaybeReady
@@ -3298,8 +3311,8 @@
gotIOInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 21.12.1995 / 16:17:40 / stefan"
@@ -3317,67 +3330,67 @@
readFdArray/writeFdArray in the debugger)"
readFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- ('Processor [info]: removing invalid read-select fileDescriptor: ' , fd printString) infoPrintCR.
- readFdArray at:idx put:nil.
- readCheckArray at:idx put:nil.
- (sema := readSemaphoreArray at:idx) notNil ifTrue:[
- readSemaphoreArray at:idx put:nil.
- sema signalOnce.
- ].
- ]
- ].
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ ('Processor [info]: removing invalid read-select fileDescriptor: ' , fd printString) infoPrintCR.
+ readFdArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
+ (sema := readSemaphoreArray at:idx) notNil ifTrue:[
+ readSemaphoreArray at:idx put:nil.
+ sema signalOnce.
+ ].
+ ]
+ ].
].
writeFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- ('Processor [info]: removing invalid write-select fileDescriptor: ' , fd printString) infoPrintCR.
- writeFdArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
- (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
- writeSemaphoreArray at:idx put:nil.
- sema signalOnce.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ ('Processor [info]: removing invalid write-select fileDescriptor: ' , fd printString) infoPrintCR.
+ writeFdArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
+ (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+ writeSemaphoreArray at:idx put:nil.
+ sema signalOnce.
+ ].
+ ]
+ ]
].
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- osChildExitActions keysDo:[:eachPid |
- |result sema|
-
- eachPid notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- ('Processor [info]: removing invalid except-select pid: ' , eachPid printString) infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ]
- ]
- ].
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ osChildExitActions keysDo:[:eachPid |
+ |result sema|
+
+ eachPid notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ ('Processor [info]: removing invalid except-select pid: ' , eachPid printString) infoPrintCR.
+ osChildExitActions safeRemoveKey:eachPid.
+ ]
+ ]
+ ].
].
"Modified: 12.4.1996 / 09:32:58 / stefan"
@@ -3389,8 +3402,8 @@
what to do now."
activeProcess ~~ scheduler ifTrue:[
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
!
@@ -3406,25 +3419,25 @@
n := timeoutArray size.
1 to:n do:[:index |
- aTime := timeoutArray at:index.
- aTime notNil ifTrue:[
- now isNil ifTrue:[
- now := OperatingSystem getMillisecondTime.
- ].
- delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now.
- delta <= 0 ifTrue:[
- ^ 0.
- ].
- minDelta isNil ifTrue:[
- minDelta := delta
- ] ifFalse:[
- minDelta := minDelta min:delta
- ]
- ]
+ aTime := timeoutArray at:index.
+ aTime notNil ifTrue:[
+ now isNil ifTrue:[
+ now := OperatingSystem getMillisecondTime.
+ ].
+ delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now.
+ delta <= 0 ifTrue:[
+ ^ 0.
+ ].
+ minDelta isNil ifTrue:[
+ minDelta := delta
+ ] ifFalse:[
+ minDelta := minDelta min:delta
+ ]
+ ]
].
minDelta isNil ifTrue:[
- "this is safe, since always called with interruptsBlocked"
- anyTimeouts := false.
+ "this is safe, since always called with interruptsBlocked"
+ anyTimeouts := false.
].
^ minDelta
@@ -3440,8 +3453,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"
@@ -3458,88 +3471,88 @@
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 checkForIOWithTimeout: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 checkForIOWithTimeout:0) ifTrue:[
+ ^ self "go back checking"
+ ]
+ ]
].
exitWhenNoMoreUserProcesses ifTrue:[
- "/ check if there are any processes at all
- "/ stop dispatching if there is none
- "/ (and anyTimeouts is false, 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
-
- anyTimeouts ifFalse:[
- 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 anyTimeouts is false, 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
+
+ anyTimeouts ifFalse:[
+ anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
+ anySema ifFalse:[
+ anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
+ anySema ifFalse:[
+ self anyUserProcessAtAll ifFalse:[
+ dispatching := false.
+ ^ self
+ ]
+ ].
+ ].
+ ].
].
preWaitActions notNil ifTrue:[
- preWaitActions do:[:action | action value].
+ preWaitActions do:[:action | action value].
].
"/
"/ 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 checkForIOWithTimeout: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 checkForIOWithTimeout: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 checkForIOWithTimeout:millis
@@ -3551,11 +3564,11 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.302 2015-02-04 20:08:53 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.303 2015-04-27 17:04:46 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.302 2015-02-04 20:08:53 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.303 2015-04-27 17:04:46 cg Exp $'
! !