--- a/ProcessorScheduler.st Tue Jul 25 11:28:28 2017 +0200
+++ b/ProcessorScheduler.st Tue Jul 25 15:51:40 2017 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -14,26 +14,26 @@
"{ NameSpace: Smalltalk }"
Object subclass:#ProcessorScheduler
- instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
- activeProcessId currentPriority readFdArray readSemaphoreArray
- readCheckArray writeFdArray writeSemaphoreArray writeCheckArray
- timeoutArray timeoutActionArray timeoutProcessArray
- timeoutSemaphoreArray idleActions anyTimeouts dispatching
- interruptedProcess useIOInterrupts gotIOInterrupt
- osChildExitActions gotChildSignalInterrupt
- exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
- supportDynamicPriorities timeSliceNeededSemaphore
- scheduledProcesses preWaitActions timeoutHandlerProcess
- readableResultFdArray writableResultFdArray exceptFdArray
- exceptResultFdArray exceptSemaphoreArray interruptCounter
- timedActionCounter'
- classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
- UserSchedulingPriority UserInterruptPriority TimingPriority
- HighestPriority SchedulingPriority MaxNumberOfProcesses
- InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
- EventPollingInterval MaxProcessId'
- poolDictionaries:''
- category:'Kernel-Processes'
+ instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
+ activeProcessId currentPriority readFdArray readSemaphoreArray
+ readCheckArray writeFdArray writeSemaphoreArray writeCheckArray
+ timeoutArray timeoutActionArray timeoutProcessArray
+ timeoutSemaphoreArray idleActions anyTimeouts dispatching
+ interruptedProcess useIOInterrupts gotIOInterrupt
+ osChildExitActions gotChildSignalInterrupt
+ exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
+ supportDynamicPriorities timeSliceNeededSemaphore
+ scheduledProcesses preWaitActions timeoutHandlerProcess
+ readableResultFdArray writableResultFdArray exceptFdArray
+ exceptResultFdArray exceptSemaphoreArray interruptCounter
+ timedActionCounter'
+ classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
+ UserSchedulingPriority UserInterruptPriority TimingPriority
+ HighestPriority SchedulingPriority MaxNumberOfProcesses
+ InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
+ EventPollingInterval MaxProcessId'
+ poolDictionaries:''
+ category:'Kernel-Processes'
!
!ProcessorScheduler class methodsFor:'documentation'!
@@ -41,7 +41,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -224,16 +224,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.
@@ -241,10 +241,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.
@@ -274,15 +274,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).
].
"
@@ -291,7 +291,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
@@ -346,22 +346,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"
@@ -418,7 +418,7 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(id)) {
- __threadDestroy(__intVal(id));
+ __threadDestroy(__intVal(id));
}
%}
!
@@ -432,7 +432,7 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(id)) {
- __threadInterrupt(__intVal(id));
+ __threadInterrupt(__intVal(id));
}
%}
!
@@ -474,7 +474,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"
@@ -528,26 +528,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].
@@ -652,7 +652,7 @@
wasBlocked := OperatingSystem blockInterrupts.
idleActions isNil ifTrue:[
- idleActions := OrderedCollection new
+ idleActions := OrderedCollection new
].
idleActions add:aBlock.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -930,9 +930,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.
].
"
@@ -965,7 +965,7 @@
supportDynamicPriorities := false.
exitWhenNoMoreUserProcesses isNil ifTrue:[
- exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
+ exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
].
"
@@ -977,10 +977,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.
@@ -993,8 +993,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"
@@ -1020,16 +1020,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.
@@ -1040,7 +1040,7 @@
self initialize.
processesToRestart do:[:p |
- p imageRestart
+ p imageRestart
]
"Modified: / 7.6.1998 / 02:23:56 / cg"
@@ -1058,44 +1058,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"
@@ -1161,9 +1161,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"
@@ -1180,37 +1180,37 @@
"/ no interrupt processing, to avoid races with monitorPid
wasBlocked := OperatingSystem blockInterrupts.
[
- [
- osProcessStatus := OperatingSystem childProcessWait:blocking pid:nil.
- osProcessStatus notNil ifTrue:[
- |pid action|
-
- pid := osProcessStatus pid.
- osProcessStatus stillAlive ifTrue:[
- action := osChildExitActions at:pid ifAbsent:nil.
- ] ifFalse:[
- action := osChildExitActions removeKey:pid ifAbsent:nil.
- ].
- action notNil ifTrue:[
- action value:osProcessStatus
- ].
- ].
-
- "/ if pollChildProcesses does block, poll only one status change.
- "/ we will get another SIGCHLD for other status changes.
-
- osProcessStatus notNil and:[blocking not]
- ] whileTrue.
-
- "/ if there are no more waiters, disable SIGCHILD handler.
- "/ this helps us with synchronous waiters (e.g. pclose),
- "/ But they should block SIGCHLD anyway.
-
- osChildExitActions isEmpty ifTrue:[
- OperatingSystem disableChildSignalInterrupts.
- ].
+ [
+ osProcessStatus := OperatingSystem childProcessWait:blocking pid:nil.
+ osProcessStatus notNil ifTrue:[
+ |pid action|
+
+ pid := osProcessStatus pid.
+ osProcessStatus stillAlive ifTrue:[
+ action := osChildExitActions at:pid ifAbsent:nil.
+ ] ifFalse:[
+ action := osChildExitActions removeKey:pid ifAbsent:nil.
+ ].
+ action notNil ifTrue:[
+ action value:osProcessStatus
+ ].
+ ].
+
+ "/ if pollChildProcesses does block, poll only one status change.
+ "/ we will get another SIGCHLD for other status changes.
+
+ osProcessStatus notNil and:[blocking not]
+ ] whileTrue.
+
+ "/ if there are no more waiters, disable SIGCHILD handler.
+ "/ this helps us with synchronous waiters (e.g. pclose),
+ "/ But they should block SIGCHLD anyway.
+
+ osChildExitActions isEmpty ifTrue:[
+ OperatingSystem disableChildSignalInterrupts.
+ ].
] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
"Modified: 5.1.1996 / 16:56:11 / stefan"
@@ -1272,10 +1272,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"
@@ -1490,17 +1490,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.
@@ -1508,10 +1508,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].
@@ -1527,8 +1527,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].
! !
@@ -1553,12 +1553,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"
@@ -1678,23 +1678,23 @@
listArray := quiescentProcessLists.
[prio >= 1] whileTrue:[
- l := listArray at:prio.
- l notNil ifTrue:[
- l notEmpty ifTrue:[
- p := l firstLink.
- "
- if it got corrupted somehow ...
- "
- p isDead ifTrue:[
- 'Processor [warning]: dead process removed' errorPrintCR.
- l removeFirst.
- p := nil.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ p
- ]
- ].
- prio := prio - 1
+ l := listArray at:prio.
+ l notNil ifTrue:[
+ l notEmpty ifTrue:[
+ p := l firstLink.
+ "
+ if it got corrupted somehow ...
+ "
+ p isDead ifTrue:[
+ 'Processor [warning]: dead process removed' errorPrintCR.
+ l removeFirst.
+ p := nil.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ p
+ ]
+ ].
+ prio := prio - 1
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ nil
@@ -1744,22 +1744,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
"
!
@@ -1869,13 +1869,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:
@@ -2181,16 +2181,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.
@@ -2200,25 +2200,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].
@@ -2233,63 +2233,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"
@@ -2340,19 +2340,19 @@
timeSliceNeededSemaphore := Semaphore new name:'timeSlice needed'.
timeSliceProcess := [
- [
- self timeSlicingLoop.
- ] ifCurtailed:[
- timeSliceProcess := nil.
- 'Processor [info]: timeslicer finished' infoPrintCR.
- ]
+ [
+ self timeSlicingLoop.
+ ] ifCurtailed:[
+ timeSliceProcess := nil.
+ 'Processor [info]: timeslicer finished' infoPrintCR.
+ ]
] newProcess.
timeSliceProcess
- priority:HighestPriority;
- name:'time slicer';
- restartable:true;
- beSystemProcess;
- resume.
+ priority:HighestPriority;
+ name:'time slicer';
+ restartable:true;
+ beSystemProcess;
+ resume.
"
Processor stopTimeSlicing.
@@ -2367,10 +2367,10 @@
"stop preemptive scheduling (timeSlicing)"
timeSliceProcess notNil ifTrue: [
- timeSliceProcess terminate.
- timeSliceProcess := nil.
- scheduledProcesses := nil.
- timeSliceNeededSemaphore := nil.
+ timeSliceProcess terminate.
+ timeSliceProcess := nil.
+ scheduledProcesses := nil.
+ timeSliceNeededSemaphore := nil.
]
"
@@ -2445,51 +2445,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
@@ -2505,34 +2505,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].
@@ -2592,20 +2592,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.
@@ -2630,30 +2630,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
"/ ].
@@ -2690,57 +2690,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].
@@ -2791,57 +2791,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].
@@ -2875,18 +2875,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"
@@ -3122,10 +3122,11 @@
firstBlockToEvaluate firstProcess
n "{ Class: SmallInteger }"
indexOfLastTimeout "{ Class: SmallInteger }"
- halfSize "{ Class: SmallInteger }"
- wasBlocked p|
-
- anyTimeouts ifFalse:[ ^ self].
+ halfSize "{ Class: SmallInteger }" process wasBlocked|
+
+ anyTimeouts ifFalse:[
+ ^ self
+ ].
anyTimeouts := false.
indexOfLastTimeout := 0.
@@ -3140,6 +3141,7 @@
"/ Thus firstBlockToEvaluate+firstProcess effectively cache the first slot of the lazy allocated collection.
"/ looks ugly, but as this is called very often, reduces idle allocation by a lot.
+ wasBlocked := OperatingSystem blockInterrupts.
now := OperatingSystem getMillisecondTime.
n := timeoutArray size.
1 to:n do:[:index |
@@ -3151,7 +3153,7 @@
sema := timeoutSemaphoreArray at:index.
sema notNil ifTrue:[
timeoutSemaphoreArray at:index put:nil.
- timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
sema signalOnceWithoutReschedule.
] ifFalse:[
"to support pure-events"
@@ -3172,10 +3174,14 @@
blocksAndProcessesToEvaluate isNil ifTrue:[
blocksAndProcessesToEvaluate := OrderedCollection
with:firstBlockToEvaluate
- with:firstProcess.
+ with:firstProcess
+ with:block
+ with:(timeoutProcessArray at:index).
+ ] ifFalse:[
+ blocksAndProcessesToEvaluate
+ add:block;
+ add:(timeoutProcessArray at:index).
].
- blocksAndProcessesToEvaluate add:block.
- blocksAndProcessesToEvaluate add:(timeoutProcessArray at:index).
].
timeoutActionArray at:index put:nil.
timeoutProcessArray at:index put:nil.
@@ -3194,14 +3200,10 @@
n > 20 ifTrue:[
halfSize := n // 2.
(indexOfLastTimeout ~~ 0 and:[indexOfLastTimeout < halfSize]) ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- (timeoutArray at:indexOfLastTimeout+1) isNil ifTrue:[ "/ no new timeouts arrived
- timeoutArray := timeoutArray copyTo:halfSize.
- timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
- timeoutActionArray := timeoutActionArray copyTo:halfSize.
- timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
- ].
- wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+ timeoutArray := timeoutArray copyTo:halfSize.
+ timeoutSemaphoreArray := timeoutSemaphoreArray copyTo:halfSize.
+ timeoutActionArray := timeoutActionArray copyTo:halfSize.
+ timeoutProcessArray := timeoutProcessArray copyTo:halfSize.
].
].
@@ -3209,7 +3211,7 @@
"/ above code avoided the creation of an OrderedCollection
blocksAndProcessesToEvaluate isNil ifTrue:[
firstBlockToEvaluate notNil ifTrue:[
- timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
(firstProcess isNil or:[firstProcess == scheduler or:[PureEventDriven]]) ifTrue:[
firstBlockToEvaluate value
] ifFalse:[
@@ -3236,12 +3238,12 @@
n := blocksAndProcessesToEvaluate size.
1 to:n by:2 do:[:index |
block := blocksAndProcessesToEvaluate at:index.
- p := blocksAndProcessesToEvaluate at:index+1.
- (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+ process := blocksAndProcessesToEvaluate at:index+1.
+ (process isNil or:[process == scheduler or:[PureEventDriven]]) ifTrue:[
block value.
- timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
] ifFalse:[
- p isDead ifTrue:[
+ 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,
@@ -3253,17 +3255,18 @@
"/ (timeoutHandlerProcess notNil and:[timeoutHandlerProcess isDead not]) ifTrue:[
"/ timeoutHandlerProcess interruptWith:block.
"/ ] ifFalse:[
- ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , p name , '''') errorPrintCR.
+ ('ProcessorScheduler [warning]: cannot evaluate timedBlock (', block displayString, ') for dead process: ''' , process name , '''') errorPrintCR.
"/ ].
] ifFalse:[
- timedActionCounter := (timedActionCounter + 1 bitAnd:SmallInteger maxVal).
- p interruptWith:block
+ timedActionCounter := (timedActionCounter + 1) bitAnd:SmallInteger maxVal.
+ process interruptWith:block
]
]
]
].
-
- "Modified: / 24-07-2017 / 16:15:36 / stefan"
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+
+ "Modified: / 25-07-2017 / 14:49:46 / stefan"
"Modified: / 25-07-2017 / 11:27:00 / cg"
!
@@ -3278,10 +3281,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].
!
@@ -3318,14 +3321,14 @@
index := anID.
(index > 0) ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
-
- timeoutArray at:index put:nil.
- timeoutActionArray at:index put:nil.
- timeoutSemaphoreArray at:index put:nil.
- timeoutProcessArray at:index put:nil.
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ timeoutArray at:index put:nil.
+ timeoutActionArray at:index put:nil.
+ timeoutSemaphoreArray at:index put:nil.
+ timeoutProcessArray at:index put:nil.
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
"Created: 23.9.1996 / 14:32:33 / cg"
@@ -3343,39 +3346,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.
@@ -3419,7 +3422,7 @@
wasBlocked := OperatingSystem blockInterrupts.
preWaitActions isNil ifTrue:[
- preWaitActions := OrderedCollection new
+ preWaitActions := OrderedCollection new
].
preWaitActions add:aBlock.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -3655,9 +3658,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"
@@ -3675,91 +3678,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"
@@ -3771,9 +3774,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
]
!
@@ -3789,25 +3792,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
@@ -3823,9 +3826,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"