hg/stx-libbasic: comparison ProcessorScheduler.st

equal deleted inserted replaced

-:3f422740eb30
+:c2aa28a1ca72
 "
 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
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 hereby transferred.
 "
 "{ Package: 'stx:libbasic' }"
 Object subclass:#ProcessorScheduler
-instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
+	instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
-activeProcessId currentPriority readFdArray readSemaphoreArray
+		activeProcessId currentPriority readFdArray readSemaphoreArray
-readCheckArray writeFdArray writeSemaphoreArray writeCheckArray
+		readCheckArray writeFdArray writeSemaphoreArray writeCheckArray
-timeoutArray timeoutActionArray timeoutProcessArray
+		timeoutArray timeoutActionArray timeoutProcessArray
-timeoutSemaphoreArray idleActions anyTimeouts dispatching
+		timeoutSemaphoreArray idleActions anyTimeouts dispatching
-interruptedProcess useIOInterrupts gotIOInterrupt
+		interruptedProcess useIOInterrupts gotIOInterrupt
-osChildExitActions gotChildSignalInterrupt
+		osChildExitActions gotChildSignalInterrupt
-exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
+		exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess
-supportDynamicPriorities scheduledProcesses preWaitActions
+		supportDynamicPriorities scheduledProcesses preWaitActions
-timeoutHandlerProcess'
+		timeoutHandlerProcess'
-classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
+	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven
-UserSchedulingPriority UserInterruptPriority TimingPriority
+		UserSchedulingPriority UserInterruptPriority TimingPriority
-HighestPriority SchedulingPriority MaxNumberOfProcesses
+		HighestPriority SchedulingPriority MaxNumberOfProcesses
-InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
+		InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
-EventPollingInterval'
+		EventPollingInterval'
-poolDictionaries:''
+	poolDictionaries:''
-category:'Kernel-Processes'
+	category:'Kernel-Processes'
 !
 !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
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 event.
 Timeslicing will not be done for processes running above TimeSlicingPriorityLimit, which
 allows for critical processes to run unaffected to completion.
 WARNING:
-timesliced priority scheduling is an experimental feature. There is no warranty,
+	timesliced priority scheduling is an experimental feature. There is no warranty,
-(at the moment), that the system runs reliable in this mode.
+	(at the moment), that the system runs reliable in this mode.
-The problem is, that shared collections may now be easily modified by other
+	The problem is, that shared collections may now be easily modified by other
-processes, running at the same time.
+	processes, running at the same time.
-The class library has being investigated for such possible trouble spots
+	The class library has being investigated for such possible trouble spots
-(we have eliminated many weak spots, and added critical regions at many places,
+	(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 ...)
+	 but cannot guarantee that all of them have been found so far ...)
-We found that many existing public domain programs are not prepared for
+	We found that many existing public domain programs are not prepared for
-being interrupted by a same-prio process and therefore may corrupt their
+	being interrupted by a same-prio process and therefore may corrupt their
-data. If in doubt, disable this fefature.
+	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.
 However, use it at your own risk.
 To demonstrate the effect of timeSlicing, do the following:
-- disable timeSlicing (in the launchers misc-settings menu)
+	- disable timeSlicing (in the launchers misc-settings menu)
-- open a workSpace
+	- open a workSpace
-- in the workspace, evaluate:
+	- in the workspace, evaluate:
-[true] whileTrue:[1000 factorial]
+		[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.
 However, CTRL-C in the workspace is still possible to stop the endless loop,
 since that is handled by the (higher prio) event dispatcher process.
 by sending #terminate."
 |id sz "{ Class: SmallInteger }"|
 something == #ElementExpired ifTrue:[
-sz := KnownProcessIds size.
+	sz := KnownProcessIds size.
-1 to:sz do:[:index |
+	1 to:sz do:[:index |
-"/ (KnownProcesses at:index) isNil ifTrue:[
+	    "/ (KnownProcesses at:index) isNil ifTrue:[
-(KnownProcesses at:index) == 0 ifTrue:[
+	    (KnownProcesses at:index) == 0 ifTrue:[
-id := KnownProcessIds at:index.
+		id := KnownProcessIds at:index.
-id notNil ifTrue:[
+		id notNil ifTrue:[
-'Processor [warning]: terminating thread ' errorPrint.
+		    'Processor [warning]: terminating thread ' errorPrint.
-id errorPrint.
+		    id errorPrint.
-' (no longer refd)' errorPrintCR.
+		    ' (no longer refd)' errorPrintCR.
-self threadDestroy:id.
+		    self threadDestroy:id.
-KnownProcessIds at:index put:nil.
+		    KnownProcessIds at:index put:nil.
-].
+		].
-KnownProcesses at:index put:nil.
+		KnownProcesses at:index put:nil.
-]
+	    ]
-]
+	]
 ]
 "Created: 7.1.1997 / 16:45:42 / stefan"
 "Modified: 10.1.1997 / 19:10:48 / cg"
 ! !
 "physical creation of a process.
 (warning: low level entry, no administration done).
 This may raise an exception, if a VM process could not be created."
 MaxNumberOfProcesses notNil ifTrue:[
-KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
+	KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[
-(KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
+	    (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[
-"
+		"
-the number of processes has reached the (soft) limit.
+		 the number of processes has reached the (soft) limit.
-This limit prevents runaway programs from creating too many
+		 This limit prevents runaway programs from creating too many
-processes. If you continue in the debugger, the process will be
+		 processes. If you continue in the debugger, the process will be
-created as usual. If you dont want this, abort or terminate.
+		 created as usual. If you dont want this, abort or terminate.
-"
+		"
-self error:'too many processes'.
+		self error:'too many processes'.
-]
+	    ]
-]
+	]
 ].
 %{
 int tid;
 extern int __threadCreate();
 tid = __threadCreate(aProcess,
-0   /* stackSize: no longer needed */,
+			 0   /* stackSize: no longer needed */,
-__isSmallInteger(id) ? __intVal(id)     /* assign id */
+			 __isSmallInteger(id) ? __intVal(id)     /* assign id */
-: -1              /* let VM assign one */  );
+					      : -1              /* let VM assign one */  );
 if (tid) {
-RETURN ( __mkSmallInteger(tid));
+	RETURN ( __mkSmallInteger(tid));
 }
 %}
 .
 "
 arrive here, if creation of process in VM failed.
 (warning: low level entry, no administration done)"
 %{  /* NOCONTEXT */
 if (__isSmallInteger(id)) {
-__threadDestroy(__intVal(id));
+	__threadDestroy(__intVal(id));
 }
 %}
 !
 threadInterrupt:id
 |idx "{Class: SmallInteger }"
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 useIOInterrupts ifTrue:[
-OperatingSystem disableIOInterruptsOn:aFileDescriptor
+	OperatingSystem disableIOInterruptsOn:aFileDescriptor
 ].
 idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
 idx ~~ 0 ifTrue:[
-readFdArray at:idx put:nil.
+	readFdArray at:idx put:nil.
-readCheckArray at:idx put:nil.
+	readCheckArray at:idx put:nil.
-readSemaphoreArray at:idx put:nil
+	readSemaphoreArray at:idx put:nil
 ].
 idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1.
 idx ~~ 0 ifTrue:[
-writeFdArray at:idx put:nil.
+	writeFdArray at:idx put:nil.
-writeCheckArray at:idx put:nil.
+	writeCheckArray at:idx put:nil.
-writeSemaphoreArray at:idx put:nil
+	writeSemaphoreArray at:idx put:nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:16:00 / cg"
 !
 |idx "{Class: SmallInteger }"
 wasBlocked|
 aFileDescriptor < 0 ifTrue:[
-'Processor [warning]: ignored invalid fd for IO action.' errorPrintCR.
+	'Processor [warning]: ignored invalid fd for IO action.' errorPrintCR.
-thisContext fullPrintAll.
+	thisContext fullPrintAll.
-^ self
+	^ self
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 (readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
-idx := readFdArray identityIndexOf:nil startingAt:1.
+	idx := readFdArray identityIndexOf:nil startingAt:1.
-idx ~~ 0 ifTrue:[
+	idx ~~ 0 ifTrue:[
-readFdArray at:idx put:aFileDescriptor.
+	    readFdArray at:idx put:aFileDescriptor.
-readCheckArray at:idx put:aBlock.
+	    readCheckArray at:idx put:aBlock.
-readSemaphoreArray at:idx put:nil
+	    readSemaphoreArray at:idx put:nil
-] ifFalse:[
+	] ifFalse:[
-readFdArray := readFdArray copyWith:aFileDescriptor.
+	    readFdArray := readFdArray copyWith:aFileDescriptor.
-readCheckArray := readCheckArray copyWith:aBlock.
+	    readCheckArray := readCheckArray copyWith:aBlock.
-readSemaphoreArray := readSemaphoreArray copyWith:nil.
+	    readSemaphoreArray := readSemaphoreArray copyWith:nil.
-].
+	].
-useIOInterrupts ifTrue:[
+	useIOInterrupts ifTrue:[
-OperatingSystem enableIOInterruptsOn:aFileDescriptor
+	    OperatingSystem enableIOInterruptsOn:aFileDescriptor
-].
+	].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:17:28 / cg"
 |nPrios "{ Class: SmallInteger }"
 p l|
 KnownProcesses isNil ifTrue:[
-KnownProcesses := WeakArray new:30.
+	KnownProcesses := WeakArray new:30.
-KnownProcesses addDependent:self class.
+	KnownProcesses addDependent:self class.
-KnownProcessIds := OrderedCollection new.
+	KnownProcessIds := OrderedCollection new.
 ].
 "
 create a collection with process lists; accessed using the priority as key
 "
 timeoutProcessArray := Array new:5.
 anyTimeouts := false.
 dispatching := false.
 exitWhenNoMoreUserProcesses isNil ifTrue:[
-exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
+	exitWhenNoMoreUserProcesses := false. "/ mhmh - how about true ?
 ].
 useIOInterrupts := OperatingSystem supportsIOInterrupts.
 gotIOInterrupt := false.
 osChildExitActions := Dictionary new.
 gotChildSignalInterrupt := false.
 "
 lay all processes to rest, collect restartable ones
 "
 processesToRestart := OrderedCollection new.
 KnownProcesses do:[:p |
-(p notNil and:[p ~~ 0]) ifTrue:[
+	(p notNil and:[p ~~ 0]) ifTrue:[
-"how, exactly should this be done ?"
+	    "how, exactly should this be done ?"
-p isRestartable == true ifTrue:[
+	    p isRestartable == true ifTrue:[
-p nextLink:nil.
+		p nextLink:nil.
-processesToRestart add:p
+		processesToRestart add:p
-] ifFalse:[
+	    ] ifFalse:[
-p setId:nil state:#dead
+		p setId:nil state:#dead
-]
+	    ]
-].
+	].
 ].
 scheduler setId:nil state:#dead.
 "
 now, start from scratch
 "
 KnownProcesses := nil.
 self initialize.
 processesToRestart do:[:p |
-p imageRestart
+	p imageRestart
 ]
 "Modified: / 7.6.1998 / 02:23:56 / cg"
 ! !
 "child changed state - switch to scheduler process which will decide
 what to do now."
 gotChildSignalInterrupt := true.
 activeProcess ~~ scheduler ifTrue:[
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 "Modified: 12.4.1996 / 10:12:18 / stefan"
 !
 wasBlocked := OperatingSystem blockInterrupts.
 index := 1.
 sz := KnownProcessIds size.
 [index <= sz] whileTrue:[
-(KnownProcesses at:index) isNil ifTrue:[
+	(KnownProcesses at:index) isNil ifTrue:[
-oldId := KnownProcessIds at:index.
+	    oldId := KnownProcessIds at:index.
-oldId notNil ifTrue:[
+	    oldId notNil ifTrue:[
-self class threadDestroy:oldId.
+		self class threadDestroy:oldId.
-].
+	    ].
-KnownProcesses at:index put:aProcess.
+	    KnownProcesses at:index put:aProcess.
-KnownProcessIds at:index put:aProcess id.
+	    KnownProcessIds at:index put:aProcess id.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	    ^ self
-].
+	].
-index := index + 1
+	index := index + 1
 ].
 KnownProcessIds grow:index.
 KnownProcessIds at:index put:aProcess id.
 oldSize := KnownProcesses size.
 (index > oldSize) ifTrue:[
-newShadow := WeakArray new:(oldSize * 2).
+	newShadow := WeakArray new:(oldSize * 2).
-newShadow addDependent:self class.
+	newShadow addDependent:self class.
-newShadow replaceFrom:1 with:KnownProcesses.
+	newShadow replaceFrom:1 with:KnownProcesses.
-KnownProcesses := newShadow
+	KnownProcesses := newShadow
 ].
 KnownProcesses at:index put:aProcess.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 7.1.1997 / 16:48:39 / stefan"
 |index wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 index := KnownProcesses identityIndexOf:aProcess.
 index ~~ 0 ifTrue:[
-KnownProcessIds at:index put:nil.
+	KnownProcessIds at:index put:nil.
-KnownProcesses at:index put:nil.
+	KnownProcesses at:index put:nil.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
 !ProcessorScheduler methodsFor:'process creation'!
 wasBlocked := OperatingSystem blockInterrupts.
 listArray := quiescentProcessLists.
 [prio >= 1] whileTrue:[
-l := listArray at:prio.
+	l := listArray at:prio.
-l notNil ifTrue:[
+	l notNil ifTrue:[
-l do:[:aProcess |
+	    l do:[:aProcess |
-aProcess processGroupId ~~ 0 ifTrue:[
+		aProcess processGroupId ~~ 0 ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+		    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ true.
+		    ^ true.
-]
+		]
-]
+	    ]
-].
+	].
-prio := prio - 1
+	prio := prio - 1
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ false
 "
 prio := HighestPriority.
 wasBlocked := OperatingSystem blockInterrupts.
 listArray := quiescentProcessLists.
 [prio >= 1] whileTrue:[
-l := listArray at:prio.
+	l := listArray at:prio.
-l notNil ifTrue:[
+	l notNil ifTrue:[
-l isEmpty ifFalse:[
+	    l isEmpty ifFalse:[
-p := l first.
+		p := l first.
-"
+		"
-if it got corrupted somehow ...
+		 if it got corrupted somehow ...
-"
+		"
-p id isNil ifTrue:[
+		p id isNil ifTrue:[
-'Processor [warning]: process with nil id removed' errorPrintCR.
+		    'Processor [warning]: process with nil id removed' errorPrintCR.
-l removeFirst.
+		    l removeFirst.
-p := nil.
+		    p := nil.
-].
+		].
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+		wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ p
+		^ p
-]
+	    ]
-].
+	].
-prio := prio - 1
+	prio := prio - 1
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ nil
 "Modified: 12.2.1997 / 12:41:49 / cg"
 "ignore, if process is already dead"
 (aProcess isNil or:[aProcess id isNil]) ifTrue:[^ self].
 aProcess == activeProcess ifTrue:[
-"special handling for waiting schedulers"
+	"special handling for waiting schedulers"
-aProcess == scheduler ifTrue:[
+	aProcess == scheduler ifTrue:[
-suspendScheduler := false.
+	    suspendScheduler := false.
-].
+	].
-^ self
+	^ self
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 pri := aProcess priority.
 l := quiescentProcessLists at:pri.
 "if already running, ignore"
 l notNil ifTrue:[
-(l identityIndexOf:aProcess) ~~ 0 ifTrue:[
+	(l identityIndexOf:aProcess) ~~ 0 ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	    ^ self
-]
+	]
 ] ifFalse:[
-l := LinkedList new.
+	l := LinkedList new.
-quiescentProcessLists at:pri put:l.
+	quiescentProcessLists at:pri put:l.
 ].
 l addLast:aProcess.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 aProcess state:#run
 "
 debugging consistency check - will be removed later
 "
 activeProcess priority ~~ currentPriority ifTrue:[
-'Processor [warning]: process changed its priority' errorPrintCR.
+	'Processor [warning]: process changed its priority' errorPrintCR.
-currentPriority := activeProcess priority.
+	currentPriority := activeProcess priority.
 ].
 l := quiescentProcessLists at:currentPriority.
 sz := l size.
 "
 debugging consistency checks - will be removed later
 "
 sz == 0 ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-'Processor [warning]: empty runnable list' errorPrintCR.
+	'Processor [warning]: empty runnable list' errorPrintCR.
-^ self
+	^ self
 ].
 "
 check if the running process is not the only one
 "
 sz ~~ 1 ifTrue:[
-"
+	"
-bring running process to the end
+	 bring running process to the end
-"
+	"
-l removeFirst.
+	l removeFirst.
-l addLast:activeProcess.
+	l addLast:activeProcess.
-"
+	"
-and switch to first in the list
+	 and switch to first in the list
-"
+	"
-self threadSwitch:(l first).
+	self threadSwitch:(l first).
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 10.1.1997 / 18:04:35 / cg"
 ! !
 "recompute dynamic priorities."
 |processesDecreased processesToIncrease|
 scheduledProcesses notNil ifTrue:[
-"/ this is written a bit cryptic - to avoid creation
+	"/ this is written a bit cryptic - to avoid creation
-"/ of garbage objects (Id'sets) if possible.
+	"/ of garbage objects (Id'sets) if possible.
-"/ since this runs 50 times a second and most of the
+	"/ since this runs 50 times a second and most of the
-"/ time, no rescheduling is req'd
+	"/ time, no rescheduling is req'd
-scheduledProcesses do:[:aProcess |
+	scheduledProcesses do:[:aProcess |
-|range prio|
+	    |range prio|
-"/ decrease priority of processes that did run
+	    "/ decrease priority of processes that did run
-(range := aProcess priorityRange) notNil ifTrue:[
+	    (range := aProcess priorityRange) notNil ifTrue:[
-aProcess priority > range start ifTrue:[
+		aProcess priority > range start ifTrue:[
-processesDecreased isNil ifTrue:[
+		    processesDecreased isNil ifTrue:[
-processesDecreased := IdentitySet new.
+			processesDecreased := IdentitySet new.
-].
+		    ].
-processesDecreased add:aProcess.
+		    processesDecreased add:aProcess.
-]
+		]
-]
+	    ]
-].
+	].
-processesDecreased notNil ifTrue:[
+	processesDecreased notNil ifTrue:[
-processesDecreased do:[:aProcess |
+	    processesDecreased do:[:aProcess |
-|newPri|
+		|newPri|
-"/ newPri := aProcess priority - 1.
+		"/ newPri := aProcess priority - 1.
-newPri := aProcess priorityRange start.
+		newPri := aProcess priorityRange start.
-self changePriority:newPri for:aProcess.
+		self changePriority:newPri for:aProcess.
-].
+	    ].
-].
+	].
-"/ and increase all prios of those that did not run, but are runnable
+	"/ and increase all prios of those that did not run, but are runnable
-TimeSlicingPriorityLimit to:1 by:-1 do:[:i |
+	TimeSlicingPriorityLimit to:1 by:-1 do:[:i |
-|list|
+	    |list|
-(list := quiescentProcessLists at:i) size > 0 ifTrue:[
+	    (list := quiescentProcessLists at:i) size > 0 ifTrue:[
-list do:[:aProcess |
+		list do:[:aProcess |
-|range prio|
+		    |range prio|
-(range := aProcess priorityRange) notNil ifTrue:[
+		    (range := aProcess priorityRange) notNil ifTrue:[
-(processesDecreased isNil
+			(processesDecreased isNil
-or:[(processesDecreased includes:aProcess) not]) ifTrue:[
+			or:[(processesDecreased includes:aProcess) not]) ifTrue:[
-aProcess priority < range stop ifTrue:[
+			    aProcess priority < range stop ifTrue:[
-processesToIncrease isNil ifTrue:[
+				processesToIncrease isNil ifTrue:[
-processesToIncrease := IdentitySet new.
+				    processesToIncrease := IdentitySet new.
-].
+				].
-processesToIncrease add:aProcess
+				processesToIncrease add:aProcess
-]
+			    ]
-]
+			]
-]
+		    ]
-]
+		]
-]
+	    ]
-].
+	].
-processesToIncrease notNil ifTrue:[
+	processesToIncrease notNil ifTrue:[
-processesToIncrease do:[:aProcess |
+	    processesToIncrease do:[:aProcess |
-self changePriority:(aProcess priority + 1) for:aProcess.
+		self changePriority:(aProcess priority + 1) for:aProcess.
-].
+	    ].
-].
+	].
 ].
 "Modified: / 21.9.1998 / 09:07:54 / cg"
 !
 wasBlocked := OperatingSystem blockInterrupts.
 i := TimeSlicingPriorityLimit.
 [(i > 0) and:[(list := quiescentProcessLists at:i) size <= 1]] whileTrue: [i := i - 1].
 i ~~ 0 ifTrue: [
-"/ shuffle that list
+	"/ shuffle that list
-list addLast:(list removeFirst).
+	list addLast:(list removeFirst).
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: / 4.8.1998 / 00:13:32 / cg"
 !
 stopTimeSlicing
 "stop preemptive scheduling (timeSlicing)"
 timeSliceProcess notNil ifTrue: [
-timeSliceProcess terminate.
+	timeSliceProcess terminate.
-timeSliceProcess := nil.
+	timeSliceProcess := nil.
-scheduledProcesses := nil
+	scheduledProcesses := nil
 ]
 "
 Processor stopTimeSlicing
 "
 wasBlocked fd|
 wasBlocked := OperatingSystem blockInterrupts.
 idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-useIOInterrupts ifTrue:[
+	useIOInterrupts ifTrue:[
-fd := readFdArray at:idx.
+	    fd := readFdArray at:idx.
-fd notNil ifTrue:[
+	    fd notNil ifTrue:[
-OperatingSystem disableIOInterruptsOn:fd
+		OperatingSystem disableIOInterruptsOn:fd
-].
+	    ].
-].
+	].
-readFdArray at:idx put:nil.
+	readFdArray at:idx put:nil.
-readSemaphoreArray at:idx put:nil.
+	readSemaphoreArray at:idx put:nil.
-readCheckArray at:idx put:nil.
+	readCheckArray at:idx put:nil.
-idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-useIOInterrupts ifTrue:[
+	useIOInterrupts ifTrue:[
-fd := writeFdArray at:idx.
+	    fd := writeFdArray at:idx.
-fd notNil ifTrue:[
+	    fd notNil ifTrue:[
-OperatingSystem disableIOInterruptsOn:fd
+		OperatingSystem disableIOInterruptsOn:fd
-].
+	    ].
-].
+	].
-writeFdArray at:idx put:nil.
+	writeFdArray at:idx put:nil.
-writeSemaphoreArray at:idx put:nil.
+	writeSemaphoreArray at:idx put:nil.
-writeCheckArray at:idx put:nil.
+	writeCheckArray at:idx put:nil.
-idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-timeoutArray at:idx put:nil.
+	timeoutArray at:idx put:nil.
-timeoutSemaphoreArray at:idx put:nil.
+	timeoutSemaphoreArray at:idx put:nil.
-timeoutActionArray at:idx put:nil.
+	timeoutActionArray at:idx put:nil.
-timeoutProcessArray at:idx put:nil.
+	timeoutProcessArray at:idx put:nil.
-idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:19:33 / cg"
 !
 wasBlocked|
 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 := timeoutArray identityIndexOf:nil startingAt:1.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-timeoutSemaphoreArray at:index put:aSemaphore.
+	    timeoutSemaphoreArray at:index put:aSemaphore.
-timeoutArray at:index put:aMillisecondTime.
+	    timeoutArray at:index put:aMillisecondTime.
-timeoutActionArray at:index put:nil.
+	    timeoutActionArray at:index put:nil.
-timeoutProcessArray at:index put:nil
+	    timeoutProcessArray at:index put:nil
-] ifFalse:[
+	] ifFalse:[
-timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:aSemaphore.
+	    timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:aSemaphore.
-timeoutArray := timeoutArray copyWith:aMillisecondTime.
+	    timeoutArray := timeoutArray copyWith:aMillisecondTime.
-timeoutActionArray := timeoutActionArray copyWith:nil.
+	    timeoutActionArray := timeoutActionArray copyWith:nil.
-timeoutProcessArray := timeoutProcessArray copyWith:nil
+	    timeoutProcessArray := timeoutProcessArray copyWith:nil
-].
+	].
 ].
 anyTimeouts := true.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 aFileDescriptor isNil ifTrue:[
-(readCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
+	(readCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
-idx := readFdArray identityIndexOf:nil startingAt:1.
+	    idx := readFdArray identityIndexOf:nil startingAt:1.
-idx ~~ 0 ifTrue:[
+	    idx ~~ 0 ifTrue:[
-readFdArray at:idx put:aFileDescriptor.
+		readFdArray at:idx put:aFileDescriptor.
-readSemaphoreArray at:idx put:aSemaphore.
+		readSemaphoreArray at:idx put:aSemaphore.
-readCheckArray at:idx put:aBlock
+		readCheckArray at:idx put:aBlock
-] ifFalse:[
+	    ] ifFalse:[
-readFdArray := readFdArray copyWith:nil.
+		readFdArray := readFdArray copyWith:nil.
-readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+		readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
-readCheckArray := readCheckArray copyWith:aBlock.
+		readCheckArray := readCheckArray copyWith:aBlock.
-]
+	    ]
-]
+	]
 ] ifFalse:[
-(readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
+	(readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
-idx := readFdArray identityIndexOf:nil startingAt:1.
+	    idx := readFdArray identityIndexOf:nil startingAt:1.
-idx ~~ 0 ifTrue:[
+	    idx ~~ 0 ifTrue:[
-readFdArray at:idx put:aFileDescriptor.
+		readFdArray at:idx put:aFileDescriptor.
-readSemaphoreArray at:idx put:aSemaphore.
+		readSemaphoreArray at:idx put:aSemaphore.
-readCheckArray at:idx put:aBlock
+		readCheckArray at:idx put:aBlock
-] ifFalse:[
+	    ] ifFalse:[
-readFdArray := readFdArray copyWith:aFileDescriptor.
+		readFdArray := readFdArray copyWith:aFileDescriptor.
-readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+		readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
-readCheckArray := readCheckArray copyWith:aBlock.
+		readCheckArray := readCheckArray copyWith:aBlock.
-].
+	    ].
-useIOInterrupts ifTrue:[
+	    useIOInterrupts ifTrue:[
-OperatingSystem enableIOInterruptsOn:aFileDescriptor
+		OperatingSystem enableIOInterruptsOn:aFileDescriptor
-].
+	    ].
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:20:45 / cg"
 !
 "arrange for a semaphore to be triggered when input on aStream arrives.
 This will do a select, if the OS supports selecting on that filedescriptor,
 otherwise, it will be polled every few milliseconds (MSDOS)."
 aStream canBeSelected ifTrue:[
-"/ can this stream be selected on ?
+	"/ can this stream be selected on ?
-self signal:aSemaphore onInput:aStream fileDescriptor orCheck:nil
+	self signal:aSemaphore onInput:aStream fileDescriptor orCheck:nil
 ] ifFalse:[
-"/ nope - must poll ...
+	"/ nope - must poll ...
-self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
+	self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
 ]
 "Modified: / 14.12.1999 / 23:58:50 / cg"
 !
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 aFileDescriptor isNil ifTrue:[
-(writeCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
+	(writeCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
-idx := writeFdArray identityIndexOf:nil startingAt:1.
+	    idx := writeFdArray identityIndexOf:nil startingAt:1.
-idx ~~ 0 ifTrue:[
+	    idx ~~ 0 ifTrue:[
-writeFdArray at:idx put:aFileDescriptor.
+		writeFdArray at:idx put:aFileDescriptor.
-writeSemaphoreArray at:idx put:aSemaphore.
+		writeSemaphoreArray at:idx put:aSemaphore.
-writeCheckArray at:idx put:aBlock
+		writeCheckArray at:idx put:aBlock
-] ifFalse:[
+	    ] ifFalse:[
-writeFdArray := writeFdArray copyWith:nil.
+		writeFdArray := writeFdArray copyWith:nil.
-writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+		writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
-writeCheckArray := writeCheckArray copyWith:aBlock.
+		writeCheckArray := writeCheckArray copyWith:aBlock.
-]
+	    ]
-]
+	]
 ] ifFalse:[
-(writeFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
+	(writeFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
-idx := writeFdArray identityIndexOf:nil startingAt:1.
+	    idx := writeFdArray identityIndexOf:nil startingAt:1.
-idx ~~ 0 ifTrue:[
+	    idx ~~ 0 ifTrue:[
-writeFdArray at:idx put:aFileDescriptor.
+		writeFdArray at:idx put:aFileDescriptor.
-writeSemaphoreArray at:idx put:aSemaphore.
+		writeSemaphoreArray at:idx put:aSemaphore.
-writeCheckArray at:idx put:aBlock
+		writeCheckArray at:idx put:aBlock
-] ifFalse:[
+	    ] ifFalse:[
-writeFdArray := writeFdArray copyWith:aFileDescriptor.
+		writeFdArray := writeFdArray copyWith:aFileDescriptor.
-writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+		writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
-writeCheckArray := writeCheckArray copyWith:aBlock.
+		writeCheckArray := writeCheckArray copyWith:aBlock.
-].
+	    ].
-useIOInterrupts ifTrue:[
+	    useIOInterrupts ifTrue:[
-OperatingSystem enableIOInterruptsOn:aFileDescriptor
+		OperatingSystem enableIOInterruptsOn:aFileDescriptor
-].
+	    ].
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:21:49 / cg"
 "arrange for a semaphore to be triggered when output on aStream is possible.
 This will do a select, if the OS supports selecting on that filedescriptor,
 otherwise, it will be polled every few milliseconds (MSDOS)."
 aStream canBeSelected ifTrue:[
-"/ can this stream be selected on ?
+	"/ can this stream be selected on ?
-self signal:aSemaphore onOutput:aStream fileDescriptor orCheck:nil
+	self signal:aSemaphore onOutput:aStream fileDescriptor orCheck:nil
 ] ifFalse:[
-"/ nope - must poll ...
+	"/ nope - must poll ...
-self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
+	self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
 ]
 "Modified: / 14.12.1999 / 23:59:19 / cg"
 ! !
 If enabled, arrangements are made for data-availability to trigger an
 interrupt.
 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),
+	some systems do not support IO-interrupts (or have a broken stdio-lib),
-and this feature is always disabled;
+	and this feature is always disabled;
 Also notice:
-we found that in some Xlib-implementations, interrupted reads are not
+	we found that in some Xlib-implementations, interrupted reads are not
-handled correctly (especially in multi-headed applications), and this
+	handled correctly (especially in multi-headed applications), and this
-feature should be disabled to avoid a blocking XPending.
+	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"
 ! !
 wasBlocked|
 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 := timeoutArray indexOf:nil.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-timeoutArray at:index put:aMillisecondTime.
+	    timeoutArray at:index put:aMillisecondTime.
-timeoutActionArray at:index put:aBlock.
+	    timeoutActionArray at:index put:aBlock.
-timeoutSemaphoreArray at:index put:nil.
+	    timeoutSemaphoreArray at:index put:nil.
-timeoutProcessArray at:index put:aProcess
+	    timeoutProcessArray at:index put:aProcess
-] ifFalse:[
+	] ifFalse:[
-timeoutArray := timeoutArray copyWith:aMillisecondTime.
+	    timeoutArray := timeoutArray copyWith:aMillisecondTime.
-timeoutActionArray := timeoutActionArray copyWith:aBlock.
+	    timeoutActionArray := timeoutActionArray copyWith:aBlock.
-timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
+	    timeoutSemaphoreArray := timeoutSemaphoreArray copyWith:nil.
-timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
+	    timeoutProcessArray := timeoutProcessArray copyWith:aProcess.
-index := timeoutArray size.
+	    index := timeoutArray size.
-].
+	].
 ].
 anyTimeouts := true.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ index
 wasBlocked := OperatingSystem blockInterrupts.
 now := OperatingSystem getMillisecondTime.
 then := OperatingSystem millisecondTimeAdd:now and:delta.
 id := self
-addTimeoutFunctionCall:anExternalFunction
+	addTimeoutFunctionCall:anExternalFunction
-for:aProcess
+	for:aProcess
-atMilliseconds:then
+	atMilliseconds:then
-with:argument.
+	with:argument.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ id
 "Created: 23.9.1996 / 14:28:27 / cg"
 |action|
 action := [anExternalFunction callWith:argument].
 ^ self
-addTimedBlock:action
+	addTimedBlock:action
-for:aProcess
+	for:aProcess
-atMilliseconds:milliTime.
+	atMilliseconds:milliTime.
 "Created: 23.9.1996 / 14:29:30 / cg"
 "Modified: 23.9.1996 / 14:34:57 / cg"
 !
 aBlock isNil ifTrue:[^ self].
 wasBlocked := OperatingSystem blockInterrupts.
 index := timeoutActionArray identityIndexOf:aBlock startingAt:1.
 (index ~~ 0) ifTrue:[
-timeoutArray at:index put:nil.
+	timeoutArray at:index put:nil.
-timeoutActionArray at:index put:nil.
+	timeoutActionArray at:index put:nil.
-timeoutSemaphoreArray at:index put:nil.
+	timeoutSemaphoreArray at:index put:nil.
-timeoutProcessArray at:index put:nil.
+	timeoutProcessArray at:index put:nil.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 removeTimeoutWithID:anID
 |index "{ Class: SmallInteger }"
 wasBlocked|
 index := anID.
 (index > 0) ifTrue:[
-wasBlocked := OperatingSystem blockInterrupts.
+	wasBlocked := OperatingSystem blockInterrupts.
-timeoutArray at:index put:nil.
+	timeoutArray at:index put:nil.
-timeoutActionArray at:index put:nil.
+	timeoutActionArray at:index put:nil.
-timeoutSemaphoreArray at:index put:nil.
+	timeoutSemaphoreArray at:index put:nil.
-timeoutProcessArray at:index put:nil.
+	timeoutProcessArray at:index put:nil.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ]
 "Created: 23.9.1996 / 14:32:33 / cg"
 "Modified: 23.9.1996 / 14:35:09 / cg"
 !
 Notice, that at the time of the message, we are still in the context
 of whichever process is currently running."
 gotIOInterrupt := true.
 activeProcess ~~ scheduler ifTrue:[
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 "Modified: 21.12.1995 / 16:17:40 / stefan"
 "Modified: 4.8.1997 / 14:23:08 / cg"
 !
 schedulerInterrupt
 "forced reschedule - switch to scheduler process which will decide
 what to do now."
 activeProcess ~~ scheduler ifTrue:[
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 !
 timeToNextTimeout
 "return the delta-T (in millis) to next timeout, or nil if
 If there were many, the list should be kept sorted ... keeping deltas
 to next (as in Unix kernel)"
 n := timeoutArray size.
 1 to:n do:[:index |
-aTime := timeoutArray at:index.
+	aTime := timeoutArray at:index.
-aTime notNil ifTrue:[
+	aTime notNil ifTrue:[
-now isNil ifTrue:[
+	    now isNil ifTrue:[
-now := OperatingSystem getMillisecondTime.
+		now := OperatingSystem getMillisecondTime.
-].
+	    ].
-(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0].
+	    (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0].
-delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now.
+	    delta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now.
-minDelta isNil ifTrue:[
+	    minDelta isNil ifTrue:[
-minDelta := delta
+		minDelta := delta
-] ifFalse:[
+	    ] ifFalse:[
-minDelta := minDelta min:delta
+		minDelta := minDelta min:delta
-]
+	    ]
-]
+	]
 ].
 ^ minDelta
 !
 This method is called by the VM' interrupt handling mechanism.
 Notice, that at the time of the message, we are still in the context
 of whichever process is currently running."
 activeProcess ~~ scheduler ifTrue:[
-interruptedProcess := activeProcess.
+	interruptedProcess := activeProcess.
-self threadSwitch:scheduler
+	self threadSwitch:scheduler
 ]
 "Modified: 18.10.1996 / 20:35:54 / cg"
 !
 "/ stop dispatching if there is none
 "/ (and millis is nil, which means that no timeout blocks are present)
 "/ and no readSemaphores are present (which means that noone is waiting for input)
 "/ and no writeSemaphores are present
-anySema := false.
+anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/ don't care about input data - if there is no user process, nobod relevant is doing the IO anyway!!
+anySema ifFalse:[
-"/
+anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
+].
-"/        anySema := (readSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/        anySema ifFalse:[
-"/            anySema := (writeSemaphoreArray findFirst:[:sema | sema notNil]) ~~ 0.
-"/        ].
 anySema ifFalse:[
 self anyUserProcessAtAll ifFalse:[
 dispatching := false.
 ^ self
 ]
 ! !
 !ProcessorScheduler class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.241 2007-04-03 16:39:13 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.242 2007-04-03 16:47:43 stefan Exp $'
 ! !
 ProcessorScheduler initialize!

changeset 10495	c2aa28a1ca72
parent 10494	3f422740eb30
child 10497	3c6d5a8121a3