--- a/ProcessorScheduler.st Fri May 25 12:50:02 2018 +0200
+++ b/ProcessorScheduler.st Fri May 25 14:29:43 2018 +0200
@@ -2,7 +2,7 @@
"
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
@@ -40,12 +40,21 @@
category:'Kernel-Processes'
!
+!ProcessorScheduler primitiveDefinitions!
+%{
+# ifndef _STDIO_H_INCLUDED_
+# include <stdio.h>
+# define _STDIO_H_INCLUDED_
+# endif
+%}
+! !
+
!ProcessorScheduler class methodsFor:'documentation'!
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
@@ -80,8 +89,8 @@
can be quaranteed to make progress, by giving it a range from low to a higher (usually user-) prios.
If it was suspended long enough, its prio will be dynamically increased, until it gets a slice to run
(and then drops back to its low background prio). So it will get a chance to do some work.
-
- Final Notice:
+
+ Final Notice:
Smalltalk/X used to support a mode (configured and compiled) without
process support. This non-process mode was called 'pureEventDriven' mode
and was useful to quickly port ST/X to systems, where these facilities
@@ -95,102 +104,102 @@
and will vanish over time from the code.
[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
"
!
@@ -228,16 +237,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.
@@ -245,10 +254,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.
@@ -278,15 +287,15 @@
SchedulingPriority := 31.
InvalidProcessSignal isNil ifTrue:[
- InvalidProcessSignal := Error newSignalMayProceed:true.
- InvalidProcessSignal nameClass:self message:#invalidProcessSignal.
- InvalidProcessSignal notifierString:'invalid process'.
+ InvalidProcessSignal := Error newSignalMayProceed:true.
+ InvalidProcessSignal nameClass:self message:#invalidProcessSignal.
+ InvalidProcessSignal notifierString:'invalid process'.
].
Processor isNil ifTrue:[
- "create the one and only processor"
-
- Smalltalk at:#Processor put:(self basicNew initialize).
+ "create the one and only processor"
+
+ Smalltalk at:#Processor put:(self basicNew initialize).
].
"
@@ -295,7 +304,7 @@
"
PureEventDriven := self threadsAvailable not.
PureEventDriven ifTrue:[
- 'Processor [error]: no process support - running event driven' errorPrintCR
+ 'Processor [error]: no process support - running event driven' errorPrintCR
].
self initializeVMMaxProcessId
@@ -350,22 +359,22 @@
|id sz "{ Class: SmallInteger }"|
something == #ElementExpired ifTrue:[
- sz := KnownProcessIds size.
- 1 to:sz do:[:index |
- "/ (KnownProcesses at:index) isNil ifTrue:[
- (KnownProcesses at:index) class == SmallInteger ifTrue:[
- id := KnownProcessIds at:index.
- id notNil ifTrue:[
- 'Processor [warning]: terminating thread ' errorPrint.
- id errorPrint.
- ' (no longer refd)' errorPrintCR.
-
- self threadDestroy:id.
- KnownProcessIds at:index put:nil.
- ].
- KnownProcesses at:index put:nil.
- ]
- ]
+ sz := KnownProcessIds size.
+ 1 to:sz do:[:index |
+ "/ (KnownProcesses at:index) isNil ifTrue:[
+ (KnownProcesses at:index) class == SmallInteger ifTrue:[
+ id := KnownProcessIds at:index.
+ id notNil ifTrue:[
+ 'Processor [warning]: terminating thread ' errorPrint.
+ id errorPrint.
+ ' (no longer refd)' errorPrintCR.
+
+ self threadDestroy:id.
+ KnownProcessIds at:index put:nil.
+ ].
+ KnownProcesses at:index put:nil.
+ ]
+ ]
]
"Created: 7.1.1997 / 16:45:42 / stefan"
@@ -380,17 +389,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 don't 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 don't want this, abort or terminate.
+ "
+ self error:'too many processes'.
+ ]
+ ]
].
%{
@@ -398,11 +407,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));
}
%}
.
@@ -422,7 +431,7 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(id)) {
- __threadDestroy(__intVal(id));
+ __threadDestroy(__intVal(id));
}
%}
!
@@ -436,7 +445,7 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(id)) {
- __threadInterrupt(__intVal(id));
+ __threadInterrupt(__intVal(id));
}
%}
!
@@ -478,7 +487,7 @@
"evaluate aBlock for each (living) processes in the system"
KnownProcesses do:[:p |
- (p notNil and:[p class ~~ SmallInteger]) ifTrue:[aBlock value:p]
+ (p notNil and:[p class ~~ SmallInteger]) ifTrue:[aBlock value:p]
]
"Created: / 26-10-2012 / 13:02:33 / cg"
@@ -532,26 +541,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].
@@ -656,7 +665,7 @@
wasBlocked := OperatingSystem blockInterrupts.
idleActions isNil ifTrue:[
- idleActions := OrderedCollection new
+ idleActions := OrderedCollection new
].
idleActions add:aBlock.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -691,7 +700,7 @@
handle all timeout actions
"
anyTimeouts ifTrue:[
- self evaluateTimeouts
+ self evaluateTimeouts
].
"first do a quick check for semaphores using checkActions - this is needed for
@@ -703,40 +712,40 @@
"
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.
- ].
- ]
+ checkBlock := readCheckArray at:index.
+ (checkBlock notNil and:[checkBlock value]) ifTrue:[
+ sema := readSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ].
+ ]
].
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.
- ].
- ]
+ checkBlock := writeCheckArray at:index.
+ (checkBlock notNil and:[checkBlock value]) ifTrue:[
+ sema := writeSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ ].
+ ]
].
"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.
@@ -767,13 +776,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
+ ]
+ ]
].
"
@@ -786,38 +795,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
].
"
@@ -829,17 +838,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
@@ -847,8 +856,8 @@
OperatingSystem unblockInterrupts.
(gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
- gotIOInterrupt := false.
- self checkForIOWithTimeout:0.
+ gotIOInterrupt := false.
+ self checkForIOWithTimeout:0.
].
wasBlocked ifTrue:[OperatingSystem blockInterrupts].
@@ -866,8 +875,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.
@@ -876,42 +885,42 @@
"/ (thanks to stefans objectAllocation monitor,
"/ this safes a bit of memory allocation in the scheduler)
- dispatchAction :=
- [
- [dispatching] whileTrue:[
- self dispatch
- ]
- ].
-
- handlerAction :=
- [:ex |
- (HaltInterrupt accepts:ex creator) ifTrue:[
- "/ in a standalone application, we do not want those
- (Smalltalk isDebuggableApp) ifTrue:[
- ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
- "/ MiniDebugger enter. -- should this be done when some --debug/--verbose was given?
- ].
- ex proceed.
- ].
-
- ('Processor [info]: caught (and ignored) signal (', ex creator printString, ')') infoPrintCR.
- ex return
- ].
+ dispatchAction :=
+ [
+ [dispatching] whileTrue:[
+ self dispatch
+ ]
+ ].
+
+ handlerAction :=
+ [:ex |
+ (HaltInterrupt accepts:ex creator) ifTrue:[
+ "/ in a standalone application, we do not want those
+ (Smalltalk isDebuggableApp) ifTrue:[
+ ('Processor [info]: ignored (', ex creator printString, ')') infoPrintCR.
+ "/ MiniDebugger enter. -- should this be done when some --debug/--verbose was given?
+ ].
+ 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,
@@ -933,9 +942,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.
].
"
@@ -968,7 +977,7 @@
supportDynamicPriorities := false.
exitWhenNoMoreUserProcesses isNil ifTrue:[
- exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
+ exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
].
"
@@ -980,10 +989,10 @@
currentPriority := SchedulingPriority.
p := Process basicNew.
p
- setId:0 state:#run;
- setPriority:currentPriority;
- name:'scheduler';
- beSystemProcess.
+ setId:0 state:#run;
+ setPriority:currentPriority;
+ name:'scheduler';
+ beSystemProcess.
scheduler := activeProcess := p.
activeProcessId := 0.
@@ -996,8 +1005,8 @@
"
useIOInterrupts ifTrue:[ObjectMemory ioInterruptHandler:self].
ObjectMemory
- timerInterruptHandler:self;
- childSignalInterruptHandler:self.
+ timerInterruptHandler:self;
+ childSignalInterruptHandler:self.
"Modified: / 7.1.1997 / 16:48:26 / stefan"
"Modified: / 4.2.1999 / 13:08:39 / cg"
@@ -1023,16 +1032,16 @@
"
processesToRestart := OrderedCollection new.
KnownProcesses do:[:p |
- (p notNil and:[p class ~~ SmallInteger]) ifTrue:[
- "how, exactly should this be done ?"
-
- p isRestartable == true ifTrue:[
- p nextLink:nil.
- processesToRestart add:p
- ] ifFalse:[
- p setId:nil state:#dead
- ]
- ].
+ (p notNil and:[p class ~~ SmallInteger]) ifTrue:[
+ "how, exactly should this be done ?"
+
+ p isRestartable == true ifTrue:[
+ p nextLink:nil.
+ processesToRestart add:p
+ ] ifFalse:[
+ p setId:nil state:#dead
+ ]
+ ].
].
scheduler setId:nil state:#dead.
@@ -1043,7 +1052,7 @@
self initialize.
processesToRestart do:[:p |
- p imageRestart
+ p imageRestart
]
"Modified: / 7.6.1998 / 02:23:56 / cg"
@@ -1061,44 +1070,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"
@@ -1115,19 +1124,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.
@@ -1138,15 +1147,15 @@
the ifAbsent block, because [] is a shared cheap block, created at compile time
"
(l isNil or:[(l removeIdentical:activeProcess ifAbsent:nil) isNil]) ifTrue:[
- "/ the vm wants to suspend a not running thread.
- "/ should not, but does happen, although very seldom (a race condition?)
- "/ ignore in standalone apps; enter a minidebugger if not.
- "/ it is (currently not clear, how this happens, but seems to be harmless)
- Logger warning:'Processor [warning]: bad vmSuspendInterrupt: process not on run list'.
- Smalltalk isDebuggableApp ifTrue:[
- MiniDebugger enterWithMessage:'bad vmSuspendInterrupt: not on run list' mayProceed:true.
- ].
- ^ self
+ "/ the vm wants to suspend a not running thread.
+ "/ should not, but does happen, although very seldom (a race condition?)
+ "/ ignore in standalone apps; enter a minidebugger if not.
+ "/ it is (currently not clear, how this happens, but seems to be harmless)
+ Logger warning:'Processor [warning]: bad vmSuspendInterrupt: process not on run list'.
+ Smalltalk isDebuggableApp ifTrue:[
+ MiniDebugger enterWithMessage:'bad vmSuspendInterrupt: not on run list' mayProceed:true.
+ ].
+ ^ self
].
"Modified: / 31-03-2017 / 13:12:49 / cg"
@@ -1164,9 +1173,9 @@
gotChildSignalInterrupt := true.
interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 12.4.1996 / 10:12:18 / stefan"
@@ -1184,37 +1193,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: / 28-02-1996 / 21:36:31 / cg"
@@ -1243,21 +1252,21 @@
"/ start the OS-Process
pid := aBlockReturningPid value.
pid notNil ifTrue:[
- osChildExitActions at:pid put:actionBlock.
- "check for a race, that SIGCHILD was received before we could register the actionBlock"
- osProcessStatus := OperatingSystem childProcessWait:false pid:pid.
- osProcessStatus notNil ifTrue:[
- "be careful, some implementations of #childProcessWait:pid:
- (wait() and wait3() in very old unixes) wait for any pid!!"
- osProcessStatus stillAlive ifTrue:[
- waitedForactionBlock := osChildExitActions at:pid ifAbsent:nil.
- ] ifFalse:[
- waitedForactionBlock := osChildExitActions removeKey:pid ifAbsent:nil.
- ].
- waitedForactionBlock notNil ifTrue:[
- waitedForactionBlock value:osProcessStatus
- ].
- ].
+ osChildExitActions at:pid put:actionBlock.
+ "check for a race, that SIGCHILD was received before we could register the actionBlock"
+ osProcessStatus := OperatingSystem childProcessWait:false pid:pid.
+ osProcessStatus notNil ifTrue:[
+ "be careful, some implementations of #childProcessWait:pid:
+ (wait() and wait3() in very old unixes) wait for any pid!!"
+ osProcessStatus stillAlive ifTrue:[
+ waitedForactionBlock := osChildExitActions at:pid ifAbsent:nil.
+ ] ifFalse:[
+ waitedForactionBlock := osChildExitActions removeKey:pid ifAbsent:nil.
+ ].
+ waitedForactionBlock notNil ifTrue:[
+ waitedForactionBlock value:osProcessStatus
+ ].
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ pid
@@ -1283,10 +1292,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"
@@ -1338,9 +1347,9 @@
extern OBJ ___threadSwitch();
if (__isSmallInteger(id)) {
- ok = ___threadSwitch(__context, __intVal(id), singleStep == true, 0);
+ ok = ___threadSwitch(__context, __intVal(id), singleStep == true, 0);
} else {
- ok = false;
+ ok = false;
}
%}.
@@ -1353,40 +1362,40 @@
currentPriority := oldProcess priority.
ok ~~ true ifTrue:[
- "
- 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.
- (id ~~ 0 and:[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.
+ (id ~~ 0 and:[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:[
- "delayed processing of terminated process (see #terminateNoSignal)"
- self class threadDestroy:zombie.
- zombie := nil
+ "delayed processing of terminated process (see #terminateNoSignal)"
+ self class threadDestroy:zombie.
+ zombie := nil
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -1501,17 +1510,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.
@@ -1519,10 +1528,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].
@@ -1538,8 +1547,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].
! !
@@ -1564,12 +1573,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"
@@ -1600,9 +1609,9 @@
in standAlone applications."
Screen notNil ifTrue:[
- Screen allScreens notEmptyOrNil ifTrue:[
- WindowGroup scheduledWindowGroups notEmptyOrNil ifTrue:[^ true].
- ].
+ Screen allScreens notEmptyOrNil ifTrue:[
+ WindowGroup scheduledWindowGroups notEmptyOrNil ifTrue:[^ true].
+ ].
].
^ false
@@ -1625,50 +1634,50 @@
listArray := quiescentProcessLists.
prio to:1 by:-1 do:[:pri|
- l := listArray at:pri.
- l notNil ifTrue:[
- l linksDo:[:aProcess |
- aProcess isUserProcess ifTrue:[
- "/ 'anyUserProcess: found quiescent ' _errorPrint. aProcess asString _errorPrintCR.
- ^ true.
- ]
- ]
- ].
+ l := listArray at:pri.
+ l notNil ifTrue:[
+ l linksDo:[:aProcess |
+ aProcess isUserProcess ifTrue:[
+ "/ 'anyUserProcess: found quiescent ' _errorPrint. aProcess asString _errorPrintCR.
+ ^ true.
+ ]
+ ]
+ ].
].
checkProcessBlock := [:p | p notNil and:[p isUserProcess and:[p isDead not]]].
- (scheduledProcesses notNil
+ (scheduledProcesses notNil
and:[scheduledProcesses contains:checkProcessBlock]) ifTrue:[
- "/ 'anyUserProcess: found scheduled ' _errorPrint.
+ "/ 'anyUserProcess: found scheduled ' _errorPrint.
"/ (scheduledProcesses detect:[:p | p notNil and:[p isUserProcess and:[p state ~~ #dead]] ]) asString _errorPrintCR.
- ^ true.
- ].
+ ^ true.
+ ].
checkSemaBlock := [:sema |
- sema notNil
- and:[sema waitingProcesses contains:checkProcessBlock]
- ].
-
+ sema notNil
+ and:[sema waitingProcesses contains:checkProcessBlock]
+ ].
+
"/ any user process waiting on a sema?
(readSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on read sema' _errorPrintCR.
- ^ true.
+ ^ true.
].
(writeSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on write sema' _errorPrintCR.
- ^ true.
+ ^ true.
].
(timeoutSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on timeout sema' _errorPrintCR.
- ^ true.
+ ^ true.
].
(exceptSemaphoreArray contains:checkSemaBlock) ifTrue:[
"/ 'anyUserProcess: found on except sema' _errorPrintCR.
- ^ true.
+ ^ true.
].
(timeoutProcessArray contains:checkProcessBlock) ifTrue:[
- ^ true.
+ ^ true.
].
^ false
@@ -1692,22 +1701,22 @@
listArray := quiescentProcessLists.
prio to:1 by:-1 do:[:pri|
- l := listArray at:pri.
- 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
- ]
- ].
+ l := listArray at:pri.
+ 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
+ ]
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ nil
@@ -1758,22 +1767,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
"
!
@@ -1785,21 +1794,21 @@
coll := OrderedCollection new.
wasBlocked := OperatingSystem blockInterrupts.
- KnownProcesses validElementsDo:[:eachProcess|
- eachProcess processGroupId = anInteger ifTrue:[
- coll add:eachProcess.
- ].
+ KnownProcesses validElementsDo:[:eachProcess|
+ eachProcess processGroupId = anInteger ifTrue:[
+ coll add:eachProcess.
+ ].
].
wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
^ coll.
"
- Processor processesWithGroupId:0
- Processor processesWithGroupId:4711
+ Processor processesWithGroupId:0
+ Processor processesWithGroupId:4711
"
! !
@@ -1819,48 +1828,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 it's 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 it's 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: / 04-08-1998 / 00:08:54 / cg"
@@ -1883,13 +1892,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:
@@ -1903,8 +1912,8 @@
makeRunnable:aProcess
"set aProcess runnable - but do not reschedule.
Answer:
- the process, that has a higher priority than the current running process
- nil if the current process should keep running.
+ the process, that has a higher priority than the current running process
+ nil if the current process should keep running.
NOTE: must not perform an operation inside that causes a reschedule."
|listForPrio state pri wasBlocked|
@@ -1914,50 +1923,50 @@
state := aProcess state.
state == #osWait ifTrue:[
- 'Processor [warning]: bad resume: #osWait' errorPrintCR.
- "/ MiniDebugger enterWithMessage:'bad resume: state osWait'.
- ^ nil.
+ 'Processor [warning]: bad resume: #osWait' errorPrintCR.
+ "/ MiniDebugger enterWithMessage:'bad resume: state osWait'.
+ ^ nil.
].
state == #stopped ifTrue:[
- "by definition, stopped processes cannot be resumed"
- ^ nil.
+ "by definition, stopped processes cannot be resumed"
+ ^ nil.
].
aProcess == activeProcess ifTrue:[
- "special handling for waiting schedulers"
- aProcess == scheduler ifTrue:[
- suspendScheduler := false.
- ].
- ^ nil
+ "special handling for waiting schedulers"
+ aProcess == scheduler ifTrue:[
+ suspendScheduler := false.
+ ].
+ ^ nil
].
wasBlocked := OperatingSystem blockInterrupts.
pri := aProcess priority.
listForPrio := quiescentProcessLists at:pri.
listForPrio notNil ifTrue:[
- (listForPrio identityIndexOf:aProcess) ~~ 0 ifTrue:[
- "if already running, ignore"
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ nil
- ]
+ (listForPrio identityIndexOf:aProcess) ~~ 0 ifTrue:[
+ "if already running, ignore"
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ nil
+ ]
] ifFalse:[
- listForPrio := LinkedList new.
- quiescentProcessLists at:pri put:listForPrio.
+ listForPrio := LinkedList new.
+ quiescentProcessLists at:pri put:listForPrio.
].
listForPrio addLast:aProcess.
aProcess state:#run.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
pri > currentPriority ifTrue:[
- "priority of aProcess is higher, must reschedule"
- ^ aProcess.
+ "priority of aProcess is higher, must reschedule"
+ ^ aProcess.
].
"/ tell timeslicer (if present), that some work might be needed...
"/ answer true, if a reschedule is needed for the timeslicer
(timeSliceNeededSemaphore notNil and:[timeSliceNeededSemaphore signalIfWithReturn]) ifTrue:[
- "cause a reschedule"
- ^ scheduler.
+ "cause a reschedule"
+ ^ scheduler.
].
^ nil.
@@ -1994,8 +2003,8 @@
someOtherProcessToSchedule := self makeRunnable:aProcess.
someOtherProcessToSchedule notNil ifTrue:[
- "another process priority is higher, reschedule"
- self threadSwitch:someOtherProcessToSchedule.
+ "another process priority is higher, reschedule"
+ self threadSwitch:someOtherProcessToSchedule.
].
"Modified: / 20-02-2017 / 11:35:23 / stefan"
@@ -2017,8 +2026,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|
@@ -2026,31 +2035,31 @@
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 == activeProcess) ifTrue:[
- "this is a no-op if the process has no interrupt actions"
- aProcess interrupt.
+ "this is a no-op if the process has no interrupt actions"
+ aProcess interrupt.
].
wasBlocked := OperatingSystem blockInterrupts.
@@ -2062,23 +2071,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].
@@ -2126,17 +2135,17 @@
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"
- self checkForEndOfDispatch.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ self checkForEndOfDispatch.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
aProcess setId:nil state:#dead.
@@ -2146,32 +2155,32 @@
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 proceedableError:'active process is zombie'.
- self class threadDestroy:zombie.
- ].
-
- self unRemember:aProcess.
- zombie := id.
- self checkForEndOfDispatch.
-
- 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 proceedableError:'active process is zombie'.
+ self class threadDestroy:zombie.
+ ].
+
+ self unRemember:aProcess.
+ zombie := id.
+ self checkForEndOfDispatch.
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self threadSwitch:scheduler.
+ "not reached"
+ ^ self
].
self unRemember:aProcess.
@@ -2196,16 +2205,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.
@@ -2215,25 +2224,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].
@@ -2248,63 +2257,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"
@@ -2333,14 +2342,14 @@
prio := TimeSlicingPriorityLimit.
[(prio > 0) and:[(list := quiescentProcessLists at:prio) size <= 1]] whileTrue: [prio := prio - 1].
prio ~~ 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: / 04-08-1998 / 00:13:32 / cg"
@@ -2355,19 +2364,19 @@
timeSliceNeededSemaphore := Semaphore name:'timeSlice needed'.
timeSliceProcess := [
- [
- self timeSlicingLoop.
- ] ifCurtailed:[
- timeSliceProcess := nil.
- 'Processor [info]: timeslicer finished' infoPrintCR.
- ]
+ [
+ self timeSlicingLoop.
+ ] ifCurtailed:[
+ timeSliceProcess := nil.
+ 'Processor [info]: timeslicer finished' infoPrintCR.
+ ]
] newProcess.
timeSliceProcess
- priority:HighestPriority;
- name:'time slicer';
- restartable:true;
- beSystemProcess;
- resume.
+ priority:HighestPriority;
+ name:'time slicer';
+ restartable:true;
+ beSystemProcess;
+ resume.
"
Processor stopTimeSlicing.
@@ -2382,10 +2391,10 @@
"stop preemptive scheduling (timeSlicing)"
timeSliceProcess notNil ifTrue: [
- timeSliceProcess terminate.
- timeSliceProcess := nil.
- scheduledProcesses := nil.
- timeSliceNeededSemaphore := nil.
+ timeSliceProcess terminate.
+ timeSliceProcess := nil.
+ scheduledProcesses := nil.
+ timeSliceNeededSemaphore := nil.
]
"
@@ -2426,25 +2435,25 @@
Smalltalk verbose ifTrue:[ '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.
! !
@@ -2460,51 +2469,51 @@
wasBlocked := OperatingSystem blockInterrupts.
useIOInterrupts ifTrue:[
- OperatingSystem disableIOInterruptsOn:aFileDescriptor.
+ OperatingSystem disableIOInterruptsOn:aFileDescriptor.
].
idx := readFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
- readFdArray at:idx put:nil.
- readCheckArray at:idx put:nil.
- (sema := readSemaphoreArray at:idx) notNil ifTrue:[
- readSemaphoreArray at:idx put:nil.
- semaCollection isNil ifTrue:[semaCollection := Set new].
- semaCollection add:sema.
- ].
- idx := readFdArray indexOf:aFileDescriptor startingAt:idx+1.
+ readFdArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
+ (sema := readSemaphoreArray at:idx) notNil ifTrue:[
+ readSemaphoreArray at:idx put:nil.
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
+ ].
+ idx := readFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
idx := writeFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
- writeFdArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
- (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
- writeSemaphoreArray at:idx put:nil.
- semaCollection isNil ifTrue:[semaCollection := Set new].
- semaCollection add:sema.
- ].
- idx := writeFdArray indexOf:aFileDescriptor startingAt:idx+1.
+ writeFdArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
+ (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+ writeSemaphoreArray at:idx put:nil.
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
+ ].
+ idx := writeFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
idx := exceptFdArray indexOf:aFileDescriptor startingAt:1.
[idx ~~ 0] whileTrue:[
- exceptFdArray at:idx put:nil.
- (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
- exceptSemaphoreArray at:idx put:nil.
- semaCollection isNil ifTrue:[semaCollection := Set new].
- semaCollection add:sema.
- ].
- idx := exceptFdArray indexOf:aFileDescriptor startingAt:idx+1.
+ exceptFdArray at:idx put:nil.
+ (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
+ exceptSemaphoreArray at:idx put:nil.
+ semaCollection isNil ifTrue:[semaCollection := Set new].
+ semaCollection add:sema.
+ ].
+ idx := exceptFdArray indexOf:aFileDescriptor startingAt:idx+1.
].
semaCollection isNil ifTrue:[
- semaCollection := #().
+ semaCollection := #().
] ifFalse:[
- doSignal ifTrue:[
- semaCollection do:[:eachSema|
- eachSema signalForAll.
- semaCollection := #().
- ].
- ].
+ doSignal ifTrue:[
+ semaCollection do:[:eachSema|
+ eachSema signalForAll.
+ semaCollection := #().
+ ].
+ ].
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ semaCollection
@@ -2520,34 +2529,34 @@
idx := 0.
[idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- useIOInterrupts ifTrue:[
- fd := readFdArray at:idx.
- fd notNil ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- ].
- readFdArray at:idx put:nil.
- readSemaphoreArray at:idx put:nil.
- readCheckArray at:idx put:nil.
+ useIOInterrupts ifTrue:[
+ fd := readFdArray at:idx.
+ fd notNil ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ ].
+ readFdArray at:idx put:nil.
+ readSemaphoreArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
].
idx := 0.
[idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- useIOInterrupts ifTrue:[
- fd := writeFdArray at:idx.
- fd notNil ifTrue:[
- OperatingSystem disableIOInterruptsOn:fd
- ].
- ].
- writeFdArray at:idx put:nil.
- writeSemaphoreArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
+ useIOInterrupts ifTrue:[
+ fd := writeFdArray at:idx.
+ fd notNil ifTrue:[
+ OperatingSystem disableIOInterruptsOn:fd
+ ].
+ ].
+ writeFdArray at:idx put:nil.
+ writeSemaphoreArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
].
idx := 0.
[idx := exceptSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
idx ~~ 0] whileTrue:[
- exceptFdArray at:idx put:nil.
- exceptSemaphoreArray at:idx put:nil.
+ exceptFdArray at:idx put:nil.
+ exceptSemaphoreArray at:idx put:nil.
].
self removeTimeoutForSemaphore:aSemaphore.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -2607,20 +2616,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.
@@ -2645,30 +2654,30 @@
aSemphore is never nil, but one of aFileDescriptor, aBlock may be nil"
aFileDescriptor isNil ifTrue:[
- idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil.
- idx == 0 ifTrue:[
- "aSemaphore is not registered yet, have to create a new slot"
- exceptFdArray := exceptFdArray copyWith:nil.
- exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
- ] ifFalse:[
- slot := exceptSemaphoreArray at:idx.
- slot isNil ifTrue:[
- exceptSemaphoreArray at:idx put:aSemaphore.
- ]
- ]
+ idx := exceptSemaphoreArray identityIndexOf:aSemaphore or:nil.
+ idx == 0 ifTrue:[
+ "aSemaphore is not registered yet, have to create a new slot"
+ exceptFdArray := exceptFdArray copyWith:nil.
+ exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
+ ] ifFalse:[
+ slot := exceptSemaphoreArray at:idx.
+ slot isNil ifTrue:[
+ exceptSemaphoreArray at:idx put:aSemaphore.
+ ]
+ ]
] ifFalse:[
- idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil.
- idx == 0 ifTrue:[
- "aFileDescriptor is not registered yet, have to create a new slot"
- exceptFdArray := exceptFdArray copyWith:aFileDescriptor.
- exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
- ] ifFalse:[
- slot := exceptFdArray at:idx.
- slot isNil ifTrue:[
- exceptFdArray at:idx put:aFileDescriptor.
- exceptSemaphoreArray at:idx put:aSemaphore.
- ].
- ].
+ idx := exceptFdArray identityIndexOf:aFileDescriptor or:nil.
+ idx == 0 ifTrue:[
+ "aFileDescriptor is not registered yet, have to create a new slot"
+ exceptFdArray := exceptFdArray copyWith:aFileDescriptor.
+ exceptSemaphoreArray := exceptSemaphoreArray copyWith:aSemaphore.
+ ] ifFalse:[
+ slot := exceptFdArray at:idx.
+ slot isNil ifTrue:[
+ exceptFdArray at:idx put:aFileDescriptor.
+ exceptSemaphoreArray at:idx put:aSemaphore.
+ ].
+ ].
"/ (useIOInterrupts and:[slot isNil]) ifTrue:[
"/ OperatingSystem enableIOInterruptsOn:aFileDescriptor
"/ ].
@@ -2705,57 +2714,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].
@@ -2768,11 +2777,11 @@
otherwise, it will be polled every few milliseconds (MSDOS)."
aStream canBeSelected ifTrue:[
- "/ can this stream be selected on ?
- self signal:aSemaphore onInput:aStream fileHandle orCheck:nil
+ "/ can this stream be selected on ?
+ self signal:aSemaphore onInput:aStream fileHandle 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"
@@ -2806,57 +2815,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].
@@ -2869,11 +2878,11 @@
otherwise, it will be polled every few milliseconds (MSDOS)."
aStream canBeSelected ifTrue:[
- "/ can this stream be selected on ?
- self signal:aSemaphore onOutput:aStream fileHandle orCheck:nil
+ "/ can this stream be selected on ?
+ self signal:aSemaphore onOutput:aStream fileHandle 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"
@@ -2890,18 +2899,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"
@@ -2911,7 +2920,7 @@
addTimedBlock:aBlock after:timeDurationOrSeconds
"add the argument, aBlock to the list of time-scheduled-blocks; to be
- evaluated after timeDuration.
+ evaluated after timeDuration.
The process which installs this timed
block will later be interrupted for execution of the block.
(if it is running, the interrupt will occur in whatever method it is
@@ -2922,9 +2931,9 @@
|millis|
- millis := timeDurationOrSeconds isNumber
- ifTrue:[ timeDurationOrSeconds * 1000 ]
- ifFalse:[ timeDurationOrSeconds getMilliseconds ].
+ millis := timeDurationOrSeconds isNumber
+ ifTrue:[ timeDurationOrSeconds * 1000 ]
+ ifFalse:[ timeDurationOrSeconds getMilliseconds ].
^ self addTimedBlock:aBlock for:activeProcess afterMilliseconds:millis
"Modified (comment): / 20-07-2017 / 16:43:12 / cg"
@@ -3039,16 +3048,16 @@
!
addTimedBlock:aBlock for:aProcess atMilliseconds:aMillisecondTime
- "add the argument, aBlock to the list of time-scheduled-blocks;
+ "add the argument, aBlock to the list of time-scheduled-blocks;
to be evaluated by aProcess when the millisecondClock value passes
aMillisecondTime.
If that block is already in the timeout list, its trigger-time is changed.
- The process specified by the argument, aProcess
+ The process specified by the argument, aProcess
will be interrupted for execution of the block.
If aProcess is nil, the block will be evaluated by the scheduler itself
(which is dangerous: the block should not raise any error conditions).
If the process is active at trigger time, the interrupt will occur in
- whatever method it is executing;
+ whatever method it is executing;
if suspended at trigger time, it will be resumed.
The block will be removed from the timed-block list after evaluation
(i.e. it will trigger only once).
@@ -3060,21 +3069,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.
@@ -3102,10 +3111,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
@@ -3128,9 +3137,9 @@
action := [anExternalFunction callWith:argument].
^ self
- addTimedBlock:action
- for:aProcess
- atMilliseconds:milliTime.
+ addTimedBlock:action
+ for:aProcess
+ atMilliseconds:milliTime.
"Created: / 23-09-1996 / 14:29:30 / cg"
"Modified (comment): / 20-07-2017 / 16:43:42 / cg"
@@ -3145,8 +3154,8 @@
indexOfLastTimeout "{ Class: SmallInteger }"
halfSize "{ Class: SmallInteger }" process wasBlocked|
- anyTimeouts ifFalse:[
- ^ self
+ anyTimeouts ifFalse:[
+ ^ self
].
anyTimeouts := false.
indexOfLastTimeout := 0.
@@ -3166,142 +3175,142 @@
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.
- timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
- sema signalOnceWithoutReschedule.
- ] ifFalse:[
- "to support pure-events"
- block := timeoutActionArray at:index.
- block notNil ifTrue:[
+ 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.
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
+ sema signalOnceWithoutReschedule.
+ ] ifFalse:[
+ "to support pure-events"
+ block := timeoutActionArray at:index.
+ block notNil ifTrue:[
"/ RecentHomeMethods isNil ifTrue:[
"/ RecentHomeMethods := OrderedCollection new.
-"/ ].
+"/ ].
"/ RecentHomeMethods add:block homeMethod.
"/ RecentHomeMethods size > 30 ifTrue:[ RecentHomeMethods removeFirst ].
-
- "/ usually (>99%), there is only one single timeout action to call;
- "/ avoid creation of an OrderedCollection
- firstBlockToEvaluate isNil ifTrue:[
- firstBlockToEvaluate := block.
- firstProcess := timeoutProcessArray at:index.
- ] ifFalse:[
- blocksAndProcessesToEvaluate isNil ifTrue:[
- blocksAndProcessesToEvaluate := OrderedCollection
- with:firstBlockToEvaluate
- with:firstProcess
- with:block
- with:(timeoutProcessArray at:index).
- ] ifFalse:[
- blocksAndProcessesToEvaluate
- add:block;
- 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.
- ]
- ]
+
+ "/ usually (>99%), there is only one single timeout action to call;
+ "/ avoid creation of an OrderedCollection
+ firstBlockToEvaluate isNil ifTrue:[
+ firstBlockToEvaluate := block.
+ firstProcess := timeoutProcessArray at:index.
+ ] ifFalse:[
+ blocksAndProcessesToEvaluate isNil ifTrue:[
+ blocksAndProcessesToEvaluate := OrderedCollection
+ with:firstBlockToEvaluate
+ with:firstProcess
+ with:block
+ with:(timeoutProcessArray at:index).
+ ] ifFalse:[
+ blocksAndProcessesToEvaluate
+ add:block;
+ 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 ~~ 0 and:[indexOfLastTimeout < halfSize]) ifTrue:[
- timeoutArray := timeoutArray copyTo:halfSize.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
- timeoutActionArray := timeoutActionArray copyTo:halfSize.
- timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
- ].
+ halfSize := n // 2.
+ (indexOfLastTimeout ~~ 0 and:[indexOfLastTimeout < halfSize]) ifTrue:[
+ timeoutArray := timeoutArray copyTo:halfSize.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
+ timeoutActionArray := timeoutActionArray copyTo:halfSize.
+ timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
+ ].
].
"/ usually (>99%), there is only one single timeout action to call;
"/ above code avoided the creation of an OrderedCollection
blocksAndProcessesToEvaluate isNil ifTrue:[
- firstBlockToEvaluate notNil ifTrue:[
- timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
- (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
- firstBlockToEvaluate value.
+ firstBlockToEvaluate notNil ifTrue:[
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
+ (firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
+ firstBlockToEvaluate value.
%{
- if (__immediateInterrupt__) {
- /* should never happen */
- fprintf(stderr, "VM [warning]: immediateInterrupt is enabled after timeout block\n");
- __debugBreakPoint__();
- __dumpObject__(firstBlockToEvaluate, __LINE__);
- __immediateInterrupt__ = 0;
- }
+ if (__immediateInterrupt__) {
+ /* should never happen */
+ console_fprintf(stderr, "VM [warning]: immediateInterrupt is enabled after timeout block\n");
+ __debugBreakPoint__();
+ __dumpObject__(firstBlockToEvaluate, __LINE__);
+ __immediateInterrupt__ = 0;
+ }
%}.
- ] ifFalse:[
- firstProcess isDead ifTrue:[
- "/ a timedBlock for a process which has already terminated
- "/ issue a warning and do not execute it.
- "/ (executing here may be dangerous, since it would run at scheduler priority here,
- "/ 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 (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') errorPrintCR.
- "/ ].
- ] ifFalse:[
- firstProcess interruptWith:firstBlockToEvaluate
- ]
- ]
- ].
+ ] ifFalse:[
+ firstProcess isDead ifTrue:[
+ "/ a timedBlock for a process which has already terminated
+ "/ issue a warning and do not execute it.
+ "/ (executing here may be dangerous, since it would run at scheduler priority here,
+ "/ 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 (', firstBlockToEvaluate displayString, ') for dead process: ''' , firstProcess name , '''') errorPrintCR.
+ "/ ].
+ ] ifFalse:[
+ firstProcess interruptWith:firstBlockToEvaluate
+ ]
+ ]
+ ].
] ifFalse:[
- n := blocksAndProcessesToEvaluate size.
- 1 to:n by:2 do:[:index |
- block := blocksAndProcessesToEvaluate at:index.
- process := blocksAndProcessesToEvaluate at:index+1.
- (process isNil or:[process == scheduler or:[PureEventDriven]]) ifTrue:[
- block value.
+ n := blocksAndProcessesToEvaluate size.
+ 1 to:n by:2 do:[:index |
+ block := blocksAndProcessesToEvaluate at:index.
+ process := blocksAndProcessesToEvaluate at:index+1.
+ (process isNil or:[process == scheduler or:[PureEventDriven]]) ifTrue:[
+ block value.
%{
- if (__immediateInterrupt__) {
- /* should never happen */
- fprintf(stderr, "VM [warning]: immediateInterrupt is enabled after timeout block\n");
- __debugBreakPoint__();
+ if (__immediateInterrupt__) {
+ /* should never happen */
+ console_fprintf(stderr, "VM [warning]: immediateInterrupt is enabled after timeout block\n");
+ __debugBreakPoint__();
// __dumpObject__(block, __LINE__);
- __immediateInterrupt__ = 0;
- }
+ __immediateInterrupt__ = 0;
+ }
%}.
- timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
- ] ifFalse:[
- process isDead ifTrue:[
- "/ a timedBlock for a process which has already terminated
- "/ issue a warning and do not execute it.
- "/ (executing here may be dangerous, since it would run at scheduler priority here,
- "/ 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 (', block displayString, ') for dead process: ''' , process name , '''') errorPrintCR.
- "/ ].
- ] ifFalse:[
- timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
- process interruptWith:block
- ]
- ]
- ]
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
+ ] ifFalse:[
+ process isDead ifTrue:[
+ "/ a timedBlock for a process which has already terminated
+ "/ issue a warning and do not execute it.
+ "/ (executing here may be dangerous, since it would run at scheduler priority here,
+ "/ 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 (', block displayString, ') for dead process: ''' , process name , '''') errorPrintCR.
+ "/ ].
+ ] ifFalse:[
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
+ process interruptWith:block
+ ]
+ ]
+ ]
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -3321,10 +3330,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].
@@ -3343,13 +3352,13 @@
index := 0.
[
- index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:index+1.
- index ~~ 0
+ index := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:index+1.
+ index ~~ 0
] whileTrue:[
- timeoutArray at:index put:nil.
- timeoutSemaphoreArray at:index put:nil.
- timeoutActionArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
+ timeoutArray at:index put:nil.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutActionArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -3362,24 +3371,24 @@
"remove the timeOut with anID (as returned by #addTimedBlock)
from the list of time-scheduled-blocks.
- DANGER: do not use.
- Use #removeTimedBlock: or or #removeTimeoutForSemaphore: or #removeTimeoutWithID:object: instead, which are safe.
- If you keep an outdated timeoutID and remove it later,
- the wrong timeout which re-uses the same id may be removed!!"
+ DANGER: do not use.
+ Use #removeTimedBlock: or or #removeTimeoutForSemaphore: or #removeTimeoutWithID:object: instead, which are safe.
+ If you keep an outdated timeoutID and remove it later,
+ the wrong timeout which re-uses the same id may be removed!!"
|index "{ Class: SmallInteger }"
wasBlocked|
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-09-1996 / 14:32:33 / cg"
@@ -3397,39 +3406,39 @@
index := anID.
(anID notNil and:[index > 0]) ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
-
- (aBlockOrSemaphore notNil
- and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore
- and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[
- 'Processor: trying to remove stale timeout id - ignored' errorPrintCR.
- ] ifFalse:[
- timeoutArray at:index put:nil.
- timeoutActionArray at:index put:nil.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
- ].
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ (aBlockOrSemaphore notNil
+ and:[(timeoutActionArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore
+ and:[(timeoutSemaphoreArray at:index ifAbsent:[]) ~~ aBlockOrSemaphore]]) ifTrue:[
+ 'Processor: trying to remove stale timeout id - ignored' errorPrintCR.
+ ] ifFalse:[
+ timeoutArray at:index put:nil.
+ timeoutActionArray at:index put:nil.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
!
timeoutHandlerProcess
(timeoutHandlerProcess isNil or:[timeoutHandlerProcess isDead]) ifTrue:[
- timeoutHandlerProcess :=
- [
- [
- self timeoutHandlerProcessLoop.
- ] ensure:[
- timeoutHandlerProcess := nil
- ].
- ] newProcess.
-
- timeoutHandlerProcess
- priority:TimingPriority;
- name:'timeout handler';
- beSystemProcess;
- resume.
+ timeoutHandlerProcess :=
+ [
+ [
+ self timeoutHandlerProcessLoop.
+ ] ensure:[
+ timeoutHandlerProcess := nil
+ ].
+ ] newProcess.
+
+ timeoutHandlerProcess
+ priority:TimingPriority;
+ name:'timeout handler';
+ beSystemProcess;
+ resume.
].
^ timeoutHandlerProcess.
@@ -3446,17 +3455,17 @@
mySema := Semaphore name:'timeoutHandler'.
[
- [
- mySema wait.
- ] on:Exception do:[:ex|
- "/ an error occurred in one of the timeout actions.
-
- "ignore errors, but tell the user"
- InfoPrinting == true ifTrue:[
- ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
- thisContext fullPrintAll.
- ].
- ].
+ [
+ mySema wait.
+ ] on:Exception do:[:ex|
+ "/ an error occurred in one of the timeout actions.
+
+ "ignore errors, but tell the user"
+ InfoPrinting == true ifTrue:[
+ ('ProcessorScheduler [warning]: error while handling timeouts in TimeoutHandlerProcess: ''' , ex description , '''') infoPrintCR.
+ thisContext fullPrintAll.
+ ].
+ ].
] loop.
! !
@@ -3473,7 +3482,7 @@
wasBlocked := OperatingSystem blockInterrupts.
preWaitActions isNil ifTrue:[
- preWaitActions := OrderedCollection new
+ preWaitActions := OrderedCollection new
].
preWaitActions add:aBlock.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -3495,31 +3504,31 @@
checkForEndOfDispatch
|wasBlocked|
-
+
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
- wasBlocked := OperatingSystem blockInterrupts.
-
- "/ 'scheduled: ' _errorPrint. self anyScheduledWindowGroupAtAll asString _errorPrintCR.
- "/ 'anyUserProcess: ' _errorPrint. self anyUserProcessAtAll asString _errorPrintCR.
-
- self anyScheduledWindowGroupAtAll ifFalse:[
- self anyUserProcessAtAll ifFalse:[
- Smalltalk verbose ifTrue:[
- 'Processor [info]: end of dispatch' infoPrintCR.
- ].
- dispatching := false.
+ "/ 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
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ "/ 'scheduled: ' _errorPrint. self anyScheduledWindowGroupAtAll asString _errorPrintCR.
+ "/ 'anyUserProcess: ' _errorPrint. self anyUserProcessAtAll asString _errorPrintCR.
+
+ self anyScheduledWindowGroupAtAll ifFalse:[
+ self anyUserProcessAtAll ifFalse:[
+ Smalltalk verbose ifTrue:[
+ 'Processor [info]: end of dispatch' infoPrintCR.
+ ].
+ dispatching := false.
"/ MiniInspector basicNew printInstVarsOf:self.
"/ quiescentProcessLists infoPrintCR.
"/ MiniDebugger enter:thisContext withMessage:'about to exit' mayProceed:true.
- ].
- ].
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
"Modified: / 01-08-2017 / 17:16:54 / stefan"
@@ -3540,158 +3549,158 @@
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).
].
exceptArray := exceptFdArray.
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- |hasPids|
-
- hasPids := false.
- osChildExitActions keysDo:[:eachPid|
- eachPid address = 0 ifTrue:[
- Logger warning:'Processor: remove 0-handle pid: %1' with:eachPid.
- osChildExitActions safeRemoveKey:eachPid.
- ] ifFalse:[
- hasPids := true.
- ].
- ].
- hasPids ifTrue:[
- exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ |hasPids|
+
+ hasPids := false.
+ osChildExitActions keysDo:[:eachPid|
+ eachPid address = 0 ifTrue:[
+ Logger warning:'Processor: remove 0-handle pid: %1' with:eachPid.
+ osChildExitActions safeRemoveKey:eachPid.
+ ] ifFalse:[
+ hasPids := true.
+ ].
+ ].
+ hasPids ifTrue:[
+ exceptArray := (exceptArray upTo:nil), osChildExitActions keys asArray.
"/'exceptArray: ' print. exceptArray printCR.
- ].
+ ].
].
exceptResultFdArray size < exceptArray size ifTrue:[
- exceptResultFdArray := Array new:(40 max:exceptArray size).
+ exceptResultFdArray := Array new:(40 max:exceptArray size).
].
nReady := OperatingSystem
- selectOnAnyReadable:readFdArray
- writable:writeFdArray
- exception:exceptArray
- readableInto:readableResultFdArray
- writableInto:writableResultFdArray
- exceptionInto:exceptResultFdArray
- withTimeOut:millis.
+ selectOnAnyReadable:readFdArray
+ writable:writeFdArray
+ exception:exceptArray
+ readableInto:readableResultFdArray
+ writableInto:writableResultFdArray
+ exceptionInto:exceptResultFdArray
+ 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)."
- "disable possible write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- (action notNil and:[action value]) ifTrue:[
- 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"
- "disable possible read side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ].
- (action notNil and:[action value]) ifTrue:[
- newProcessMaybeReady := true.
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
+ 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)."
+ "disable possible write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ (action notNil and:[action value]) ifTrue:[
+ 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"
+ "disable possible read side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ].
+ (action notNil and:[action value]) ifTrue:[
+ newProcessMaybeReady := true.
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
"/'except result got: ' print. exceptArray printCR. exceptResultFdArray printCR.
- readyIndex := 1.
- [nReady > 0
- and:[ readyIndex <= exceptResultFdArray size
- and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
- ] whileTrue:[
+ readyIndex := 1.
+ [nReady > 0
+ and:[ readyIndex <= exceptResultFdArray size
+ and:[ (fdOrPid := exceptResultFdArray at:readyIndex) notNil ]]
+ ] whileTrue:[
"/'except got: ' print. fdOrPid printCR.
- index := exceptFdArray identityIndexOf:fdOrPid.
- index ~~ 0 ifTrue:[
- sema := exceptSemaphoreArray at:index.
- sema notNil ifTrue:[
- sema signalOnce.
- newProcessMaybeReady := true.
- "disable possible read/write side and timeouts as well"
- self disableSemaphore:sema.
- ].
- ] ifFalse:[ "may be a PID?"
- |osProcessStatus actionBlock|
-
- actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
+ index := exceptFdArray identityIndexOf:fdOrPid.
+ index ~~ 0 ifTrue:[
+ sema := exceptSemaphoreArray at:index.
+ sema notNil ifTrue:[
+ sema signalOnce.
+ newProcessMaybeReady := true.
+ "disable possible read/write side and timeouts as well"
+ self disableSemaphore:sema.
+ ].
+ ] ifFalse:[ "may be a PID?"
+ |osProcessStatus actionBlock|
+
+ actionBlock := osChildExitActions removeKey:fdOrPid ifAbsent:nil.
"/'pid signaled: ' print. fdOrPid printCR.
- actionBlock notNil ifTrue:[
- osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
- (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
- actionBlock value:osProcessStatus.
- newProcessMaybeReady := true.
- ].
- ].
- ].
- nReady := nReady - 1.
- readyIndex := readyIndex + 1.
- ].
+ actionBlock notNil ifTrue:[
+ osProcessStatus := OperatingSystem childProcessWait:false pid:fdOrPid.
+ (osProcessStatus notNil and:[osProcessStatus pid = fdOrPid]) ifTrue:[
+ actionBlock value:osProcessStatus.
+ newProcessMaybeReady := true.
+ ].
+ ].
+ ].
+ nReady := nReady - 1.
+ readyIndex := readyIndex + 1.
+ ].
].
^ newProcessMaybeReady
@@ -3710,9 +3719,9 @@
gotIOInterrupt := true.
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 21.12.1995 / 16:17:40 / stefan"
@@ -3730,91 +3739,91 @@
readFdArray/writeFdArray in the debugger)"
readFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- readFdArray at:idx put:nil.
- readCheckArray at:idx put:nil.
- (sema := readSemaphoreArray at:idx) notNil ifTrue:[
- readSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ].
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid read-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ readFdArray at:idx put:nil.
+ readCheckArray at:idx put:nil.
+ (sema := readSemaphoreArray at:idx) notNil ifTrue:[
+ readSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ].
].
writeFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- writeFdArray at:idx put:nil.
- writeCheckArray at:idx put:nil.
- (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
- writeSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid write-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ writeFdArray at:idx put:nil.
+ writeCheckArray at:idx put:nil.
+ (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+ writeSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ]
].
exceptFdArray keysAndValuesDo:[:idx :fd |
- |result sema|
-
- fd notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
- exceptFdArray at:idx put:nil.
- (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
- exceptSemaphoreArray at:idx put:nil.
- self removeTimeoutForSemaphore:sema.
- sema signalForAll.
- ].
- ]
- ]
+ |result sema|
+
+ fd notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:fd)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid exception-select fileDescriptor: ' infoPrint. fd infoPrint. ' idx: 'infoPrint. idx infoPrintCR.
+ exceptFdArray at:idx put:nil.
+ (sema := exceptSemaphoreArray at:idx) notNil ifTrue:[
+ exceptSemaphoreArray at:idx put:nil.
+ self removeTimeoutForSemaphore:sema.
+ sema signalForAll.
+ ].
+ ]
+ ]
].
OperatingSystem isMSWINDOWSlike ifTrue:[
- "/
- "/ win32 does a WaitForMultipleObjects in select...
- "/ unix waits for SIGCHLD
- "/
- osChildExitActions keysDo:[:eachPid |
- |result sema|
-
- eachPid notNil ifTrue:[
- result := OperatingSystem
- selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
- readableInto:nil writableInto:nil exceptionInto:nil
- withTimeOut:0.
-
- result < 0 ifTrue:[
- 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
- osChildExitActions safeRemoveKey:eachPid.
- ]
- ]
- ].
+ "/
+ "/ win32 does a WaitForMultipleObjects in select...
+ "/ unix waits for SIGCHLD
+ "/
+ osChildExitActions keysDo:[:eachPid |
+ |result sema|
+
+ eachPid notNil ifTrue:[
+ result := OperatingSystem
+ selectOnAnyReadable:nil writable:nil exception:(Array with:eachPid)
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ result < 0 ifTrue:[
+ 'Processor [info]: removing invalid exception-select pid: ' infoPrint. eachPid infoPrintCR.
+ osChildExitActions safeRemoveKey:eachPid.
+ ]
+ ]
+ ].
].
"Modified: 12.4.1996 / 09:32:58 / stefan"
@@ -3826,9 +3835,9 @@
what to do now."
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
!
@@ -3844,25 +3853,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
@@ -3878,9 +3887,9 @@
of whichever process is currently running."
activeProcess ~~ scheduler ifTrue:[
- interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
- interruptedProcess := activeProcess.
- self threadSwitch:scheduler
+ interruptCounter := interruptCounter + 1 bitAnd:SmallInteger maxVal.
+ interruptedProcess := activeProcess.
+ self threadSwitch:scheduler
]
"Modified: 18.10.1996 / 20:35:54 / cg"
@@ -3897,81 +3906,81 @@
doingGC := true.
[doingGC] whileTrue:[
- anyTimeouts ifTrue:[
- millis := self timeToNextTimeout.
- (millis notNil and:[millis <= 0]) ifTrue:[
- ^ self "oops - hurry up checking"
- ].
- ].
-
- "
- if it's 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 it's 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
-
- "/ cg: changed to only check when a process terminated
- "/ self checkForEndOfDispatch.
- dispatching ifFalse:[
- ^ 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
+
+ "/ cg: changed to only check when a process terminated
+ "/ self checkForEndOfDispatch.
+ dispatching ifFalse:[
+ ^ 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