hg/stx-libbasic: comparison ProcessorScheduler.st

equal deleted inserted replaced

-:58ac5885aa41
+:901c91d6dd50
 "
 Object subclass:#ProcessorScheduler
 	instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
 		activeProcessId currentPriority readFdArray readSemaphoreArray
-		readCheckArray writeFdArray writeSemaphoreArray timeoutArray
+		readCheckArray writeFdArray writeSemaphoreArray writeCheckArray timeoutArray
 		timeoutActionArray timeoutProcessArray timeoutSemaphoreArray
 		idleActions anyTimeouts dispatching interruptedProcess
 		useIOInterrupts gotIOInterrupt osChildExitActions
 		gotChildSignalInterrupt exitWhenNoMoreUserProcesses
 		suspendScheduler timeSliceProcess supportDynamicPriorities
 	TimeSlicingPriorityLimit                for preemptive priority scheduling only:
 						processes are only timesliced, if running
 						at or below this priority.
-	EventPollingInterval			for systems which do not support select on
+	EventPollingInterval                    for systems which do not support select on
 						a fileDescriptor: the polling interval in millis.
 most interesting methods:
 	Processor>>suspend:                  (see also Process>>suspend)
 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.
 "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 ( __MKSMALLINT(tid));
+	RETURN ( __MKSMALLINT(tid));
 }
 %}
 .
 "
 arrive here, if creation of process in VM failed.
 ! !
 !ProcessorScheduler methodsFor:'I/O event actions'!
 disableFd:aFileDescriptor
-"disable block events on aFileDescriptor.
+"obsolete event support: disable block events on aFileDescriptor.
 This is a leftover support for pure-event systems and may vanish."
 |idx "{Class: SmallInteger }"
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
+useIOInterrupts ifTrue:[
+	OperatingSystem disableIOInterruptsOn:aFileDescriptor
+].
 idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
 idx ~~ 0 ifTrue:[
-useIOInterrupts ifTrue:[
+	readFdArray at:idx put:nil.
-OperatingSystem disableIOInterruptsOn:aFileDescriptor
+	readCheckArray at:idx put:nil.
-].
+	readSemaphoreArray at:idx put:nil
-readFdArray at:idx put:nil.
+].
-readCheckArray at:idx put:nil.
+idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1.
-readSemaphoreArray at:idx put:nil
+idx ~~ 0 ifTrue:[
+	writeFdArray at:idx put:nil.
+	writeCheckArray at:idx put:nil.
+	writeSemaphoreArray at:idx put:nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:16:00 / cg"
 !
 enableIOAction:aBlock onInput:aFileDescriptor
-"half-obsolete event support: arrange for aBlock to be
+"obsolete event support: arrange for aBlock to be
 evaluated when input on aFileDescriptor arrives.
 This is a leftover support for pure-event systems and may vanish."
 |idx "{Class: SmallInteger }"
 wasBlocked|
 	^ 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"
 "
 handle all timeout actions
 "
 anyTimeouts ifTrue:[
-self evaluateTimeouts
+	self evaluateTimeouts
 ].
 "first do a quick check for semaphores using checkActions - this is needed for
 devices like the X-connection, where some events might be in the event
 queue but the sockets input queue is empty.
-Without these checks, a select might block even though there is work to do
+Without these checks, a select might block even though there is work to do.
+Also, this is needed for poor MSDOS, where WaitForObject does not work with
+sockets and pipes (sigh)
 "
 any := false.
 nActions := readCheckArray size.
 1 to:nActions do:[:index |
-checkBlock := readCheckArray at:index.
+	checkBlock := readCheckArray at:index.
-(checkBlock notNil and:[checkBlock value]) ifTrue:[
+	(checkBlock notNil and:[checkBlock value]) ifTrue:[
-sema := readSemaphoreArray at:index.
+	    sema := readSemaphoreArray at:index.
-sema notNil ifTrue:[
+	    sema notNil ifTrue:[
-sema signalOnce.
+		sema signalOnce.
-].
+	    ].
-any := true.
+	    any := true.
-]
+	]
+].
+nActions := writeCheckArray size.
+1 to:nActions do:[:index |
+	checkBlock := writeCheckArray at:index.
+	(checkBlock notNil and:[checkBlock value]) ifTrue:[
+	    sema := writeSemaphoreArray at:index.
+	    sema notNil ifTrue:[
+		sema signalOnce.
+	    ].
+	    any := true.
+	]
 ].
 "now, someone might be runnable ..."
 p := self highestPriorityRunnableProcess.
 p isNil ifTrue:[
-"/ no one runnable, hard wait for event or timeout
+	"/ no one runnable, hard wait for event or timeout
-self waitForEventOrTimeout.
+	self waitForEventOrTimeout.
-"/ check for OS process termination
+	"/ check for OS process termination
-gotChildSignalInterrupt ifTrue:[
+	gotChildSignalInterrupt ifTrue:[
-gotChildSignalInterrupt := false.
+	    gotChildSignalInterrupt := false.
-self handleChildSignalInterrupt
+	    self handleChildSignalInterrupt
-].
+	].
 	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	^ self
 ].
 pri := p priority.
 "
 (a future version will have a process running to handle a timeout queue)
 "
 "
 pri < TimingPriority ifTrue:[
-anyTimeouts ifTrue:[
+	anyTimeouts ifTrue:[
-millis := self timeToNextTimeout.
+	    millis := self timeToNextTimeout.
-millis == 0 ifTrue:[
+	    millis == 0 ifTrue:[
-	        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+		wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 		^ self
 	    ]
-]
+	]
 ].
 "
 "
 if the process to run has a lower than UserInterruptPriority,
 or by installing a poll-interrupt after 50ms (if the OS does not).
 "
 pri < UserInterruptPriority ifTrue:[
 "comment out this if above is uncommented"
-anyTimeouts ifTrue:[
+	anyTimeouts ifTrue:[
-millis := self timeToNextTimeout.
+	    millis := self timeToNextTimeout.
-millis == 0 ifTrue:[
+	    millis == 0 ifTrue:[
-	        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+		wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 		^ self
 	    ].
-].
+	].
 "---"
-useIOInterrupts ifTrue:[
+	useIOInterrupts ifTrue:[
 "/            readFdArray do:[:fd |
 "/                (fd notNil and:[fd >= 0]) ifTrue:[
 "/                    OperatingSystem enableIOInterruptsOn:fd
 "/                ].
 "/            ].
-] ifFalse:[
+	] ifFalse:[
-millis notNil ifTrue:[
+	    millis notNil ifTrue:[
-millis := millis min:EventPollingInterval
+		millis := millis min:EventPollingInterval
-] ifFalse:[
+	    ] ifFalse:[
-millis := EventPollingInterval
+		millis := EventPollingInterval
-]
+	    ]
-]
+	]
 ].
 millis notNil ifTrue:[
-"schedule a clock interrupt after millis milliseconds"
+	"schedule a clock interrupt after millis milliseconds"
-OperatingSystem enableTimer:millis rounded.
+	OperatingSystem enableTimer:millis rounded.
 ].
 scheduledProcesses notNil ifTrue:[
-scheduledProcesses add:p
+	scheduledProcesses add:p
 ].
 "
 now let the process run - will come back here by reschedule
 from ioInterrupt or timerInterrupt ... (running at max+1)
 "
 self threadSwitch:p.
 "... when we arrive here, we are back on stage.
-Either by an ALARM or IO signal, or by a suspend of another process
+	 Either by an ALARM or IO signal, or by a suspend of another process
 "
 millis notNil ifTrue:[
-OperatingSystem disableTimer.
+	OperatingSystem disableTimer.
 ].
 "/ check for OS process termination
 gotChildSignalInterrupt ifTrue:[
-gotChildSignalInterrupt := false.
+	gotChildSignalInterrupt := false.
-self handleChildSignalInterrupt
+	self handleChildSignalInterrupt
 ].
 "/ check for new input
 OperatingSystem unblockInterrupts.
 (gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
-gotIOInterrupt := false.
+	gotIOInterrupt := false.
-self checkForInputWithTimeout:0.
+	self checkForInputWithTimeout:0.
 ].
 wasBlocked ifTrue:[OperatingSystem blockInterrupts].
 "Modified: / 12.4.1996 / 10:14:18 / stefan"
 |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
 "
 readFdArray := Array new:5.
 readCheckArray := Array new:5.
 readSemaphoreArray := Array new:5.
 writeFdArray := Array new:3.
+writeCheckArray := Array new:3.
 writeSemaphoreArray := Array new:3.
 timeoutArray := Array new:5.
 timeoutSemaphoreArray := Array new:5.
 timeoutActionArray := Array new:5.
 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"
 ! !
 This is only used with win32's native threads."
 |id pri l s|
 OperatingSystem interruptsBlocked ifFalse:[
-MiniDebugger
+	MiniDebugger
-enterWithMessage:'immediateInterrupt with no interruptsBlocked'
+	    enterWithMessage:'immediateInterrupt with no interruptsBlocked'
-mayProceed:true.
+	    mayProceed:true.
 ].
 (why == 2) ifTrue:[
-s := #wrapWait.
+	 s := #wrapWait.
 ] ifFalse:[
-(why == 3) ifTrue:[
+	(why == 3) ifTrue:[
-s := #osWait.
+	    s := #osWait.
-] ifFalse:[
+	] ifFalse:[
-s := #stopped.
+	    s := #stopped.
-].
+	].
 ].
 activeProcess setStateTo:s if:#active.
 pri := activeProcess priority.
 l := quiescentProcessLists at:pri.
 "notice: this is slightly faster than putting the if-code into
 the ifAbsent block, because [] is a shared cheap block, created at compile time
 "
 (l isNil or:[(l remove:activeProcess ifAbsent:nil) isNil]) ifTrue:[
-"/ 'Processor [warning]: bad immediateInterrupt: not on run list' errorPrintCR.
+	"/ 'Processor [warning]: bad immediateInterrupt: not on run list' errorPrintCR.
-MiniDebugger enterWithMessage:'bad immediateInterrupt: not on run list' mayProceed:true.
+	MiniDebugger enterWithMessage:'bad immediateInterrupt: not on run list' mayProceed:true.
-^ self
+	^ self
 ].
 "/    id := scheduler id.
 "/    pri := scheduler priority.
 "/    scheduler state:#active.
 This is only used with win32's native threads."
 |index pri aProcess l|
 OperatingSystem interruptsBlocked ifFalse:[
-MiniDebugger
+	MiniDebugger
-enterWithMessage:'resumeImmediateInterrupt with no interruptsBlocked'
+	    enterWithMessage:'resumeImmediateInterrupt with no interruptsBlocked'
-mayProceed:true.
+	    mayProceed:true.
 ].
 index := KnownProcessIds identityIndexOf:id.
 index ~~ 0 ifTrue:[
-aProcess := KnownProcesses at:index.
+	aProcess := KnownProcesses at:index.
-"/
+	"/
-"/ CG: the situation below may happen, if the wrapCall
+	"/ CG: the situation below may happen, if the wrapCall
-"/ finishes before the process was layed to sleep
+	"/ finishes before the process was layed to sleep
-"/ (i.e. schedulerIRQ arrives before the threadSwitch
+	"/ (i.e. schedulerIRQ arrives before the threadSwitch
-"/ was finished.
+	"/ was finished.
-"/ In that case, simply resume it and everything is OK.
+	"/ In that case, simply resume it and everything is OK.
-"/
+	"/
 "/        aProcess state ~~ #wrapWait ifTrue:[
 "/            'ProcSched [info]: oops - resumeImmIRQ for non wrapWait process' infoPrintCR.
 "/            ^ self
 "/        ].
-pri := aProcess priority.
+	pri := aProcess priority.
-l := quiescentProcessLists at:pri.
+	l := quiescentProcessLists at:pri.
-"if already running, ignore"
+	"if already running, ignore"
-l notNil ifTrue:[
+	l notNil ifTrue:[
-(l identityIndexOf:aProcess) ~~ 0 ifTrue:[
+	    (l identityIndexOf:aProcess) ~~ 0 ifTrue:[
-'ProcSched [info]: oops - resumeImmIRQ for already running process' infoPrintCR.
+		'ProcSched [info]: oops - resumeImmIRQ for already running process' infoPrintCR.
-^ self
+		^ self
-]
+	    ]
-] ifFalse:[
+	] ifFalse:[
-l := LinkedList new.
+	    l := LinkedList new.
-quiescentProcessLists at:pri put:l.
+	    quiescentProcessLists at:pri put:l.
-].
+	].
-l addLast:aProcess.
+	l addLast:aProcess.
-aProcess state:#run.
+	aProcess state:#run.
 ] ifFalse:[
-'ProcSched [info]: oops - resumeImmIRQ for unknown process' infoPrintCR.
+	'ProcSched [info]: oops - resumeImmIRQ for unknown process' infoPrintCR.
 ]
 "Modified: / 28.9.1998 / 11:36:53 / 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"
 !
 The method returns the value from aBlockReturningPid (i.e a pid or nil)."
 |pid blocked osProcessStatus|
 OperatingSystem supportsChildInterrupts ifTrue:[
-"/ SIGCHLD is supported,
+	"/ SIGCHLD is supported,
-"/ aBlock will be evaluated, as soon as a SIGCHLD interrupt for pid has been received.
+	"/ aBlock will be evaluated, as soon as a SIGCHLD interrupt for pid has been received.
-OperatingSystem enableChildSignalInterrupts.
+	OperatingSystem enableChildSignalInterrupts.
-blocked := OperatingSystem blockInterrupts.
+	blocked := OperatingSystem blockInterrupts.
-pid := aBlockReturningPid value.
+	pid := aBlockReturningPid value.
-pid notNil ifTrue:[
+	pid notNil ifTrue:[
-osChildExitActions at:pid put:actionBlock.
+	    osChildExitActions at:pid put:actionBlock.
-].
+	].
-blocked ifFalse:[
+	blocked ifFalse:[
-OperatingSystem unblockInterrupts.
+	    OperatingSystem unblockInterrupts.
-].
+	].
 ] ifFalse:[
-"/ SIGCHLD is not supported, fork a high prio process
+	"/ SIGCHLD is not supported, fork a high prio process
-"/ to poll for for the exit of pid.
+	"/ to poll for for the exit of pid.
-blocked := OperatingSystem blockInterrupts.
+	blocked := OperatingSystem blockInterrupts.
-pid := aBlockReturningPid value.
+	pid := aBlockReturningPid value.
-pid notNil ifTrue:[
+	pid notNil ifTrue:[
-osChildExitActions at:pid put:actionBlock.
+	    osChildExitActions at:pid put:actionBlock.
-].
+	].
-blocked ifFalse:[
+	blocked ifFalse:[
-OperatingSystem unblockInterrupts.
+	    OperatingSystem unblockInterrupts.
-].
+	].
-[
+	[
-[
+	    [
-|polling myDelay t|
+	      |polling myDelay t|
-polling := true.
+	      polling := true.
-myDelay := Delay forMilliseconds:(t := EventPollingInterval).
+	      myDelay := Delay forMilliseconds:(t := EventPollingInterval).
-[polling] whileTrue:[
+	      [polling] whileTrue:[
-t ~~ EventPollingInterval ifTrue:[
+		  t ~~ EventPollingInterval ifTrue:[
-"/ interval changed -> need a new delay
+		      "/ interval changed -> need a new delay
-myDelay delay:(t := EventPollingInterval).
+		      myDelay delay:(t := EventPollingInterval).
-].
+		  ].
-myDelay wait.
+		  myDelay wait.
-(osChildExitActions includesKey:pid) ifFalse:[
+		  (osChildExitActions includesKey:pid) ifFalse:[
-polling := false.
+		      polling := false.
-] ifTrue:[
+		  ] ifTrue:[
-osProcessStatus := OperatingSystem childProcessWait:false pid:pid.
+		      osProcessStatus := OperatingSystem childProcessWait:false pid:pid.
-osProcessStatus notNil ifTrue:[
+		      osProcessStatus notNil ifTrue:[
-(osProcessStatus pid = pid) ifTrue:[
+			  (osProcessStatus pid = pid) ifTrue:[
-osChildExitActions removeKey:pid ifAbsent:nil.
+			      osChildExitActions removeKey:pid ifAbsent:nil.
-actionBlock value:osProcessStatus.
+			      actionBlock value:osProcessStatus.
-polling := false.
+			      polling := false.
-] ifFalse:[
+			  ] ifFalse:[
-osProcessStatus stillAlive
+			      osProcessStatus stillAlive
-]
+			  ]
-]
+		      ]
-].
+		  ].
-]
+	      ]
-] valueOnUnwindDo:[
+	  ] valueOnUnwindDo:[
-osChildExitActions removeKey:pid ifAbsent:nil
+	      osChildExitActions removeKey:pid ifAbsent:nil
-]
+	  ]
-] forkAt:TimingPriority.
+	] forkAt:TimingPriority.
 ].
 ^ pid
 "Created: / 25.3.1997 / 10:54:56 / stefan"
 "Modified: / 25.3.1997 / 11:21:05 / stefan"
 self scheduleInterruptActionsOf:aProcess.
 "
 and, make the process runnable
 "
 aProcess state ~~ #stopped ifTrue:[
-aProcess state == #osWait ifTrue:[
+	aProcess state == #osWait ifTrue:[
-('Processor [warning]: ignored scheduleForInterrupt:Process ',(aProcess id) printString,' state osWait') errorPrintCR.
+	    ('Processor [warning]: ignored scheduleForInterrupt:Process ',(aProcess id) printString,' state osWait') errorPrintCR.
-"/ self halt.
+	    "/ self halt.
-] ifFalse:[
+	] ifFalse:[
-"
+	    "
-and, make the process runnable
+	     and, make the process runnable
-"
+	    "
-self resume:aProcess
+	    self resume:aProcess
-]
+	]
 ]
 "Modified: / 24.8.1998 / 18:31:32 / cg"
 !
 currentPriority := pri.
 %{
 extern OBJ ___threadSwitch();
 if (__isSmallInteger(id)) {
-ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0);
+	ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0);
 } else {
-ok = false;
+	ok = false;
 }
 %}.
 "time passes spent in some other process ...
 ... here again"
 activeProcess := oldProcess.
 activeProcessId := oldId.
 currentPriority := oldProcess priority.
 ok == true ifFalse:[
-"
+	"
-switch failed for some reason -
+	 switch failed for some reason -
-destroy (hard-terminate) the bad process.
+	 destroy (hard-terminate) the bad process.
-This happens when:
+	 This happens when:
-- the stack went above the absolute limit
+	 - the stack went above the absolute limit
-(VM switches back to scheduler)
+	   (VM switches back to scheduler)
-- a halted process cannot execute its interrupt
+	 - a halted process cannot execute its interrupt
-actions (win32 only)
+	   actions (win32 only)
-"
+	"
-(id := p id) ~~ 0 ifTrue:[
+	(id := p id) ~~ 0 ifTrue:[
-id notNil ifTrue:[
+	    id notNil ifTrue:[
-'Processor [warning]: problem with process ' errorPrint.
+		'Processor [warning]: problem with process ' errorPrint.
-id errorPrint.
+		id errorPrint.
-(nm := p name) notNil ifTrue:[
+		(nm := p name) notNil ifTrue:[
-' (' errorPrint. nm errorPrint. ')' errorPrint.
+		    ' (' errorPrint. nm errorPrint. ')' errorPrint.
-].
+		].
 		ok == #halted ifTrue:[
 		    "/ that process was halted (win32 only)
 		    p state:#halted.
-'; stopped it.' errorPrintCR.
+		   '; stopped it.' errorPrintCR.
-self suspend:p.
+		   self suspend:p.
 		] ifFalse:[
-'; hard-terminate it.' errorPrintCR.
+		   '; hard-terminate it.' errorPrintCR.
-'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
+		   'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
-p state:#cleanup.
+		   p state:#cleanup.
-self terminateNoSignal:p.
+		   self terminateNoSignal:p.
 		]
-]
+	    ]
-]
+	]
 ].
 zombie notNil ifTrue:[
-self class threadDestroy:zombie.
+	self class threadDestroy:zombie.
-zombie := nil
+	zombie := nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
 !ProcessorScheduler methodsFor:'priority constants'!
 "
 check for valid argument
 "
 newPrio := prio.
 newPrio < 1 ifTrue:[
-newPrio := 1.
+	newPrio := 1.
 ] ifFalse:[
-newPrio > HighestPriority ifTrue:[
+	newPrio > HighestPriority ifTrue:[
-newPrio := HighestPriority
+	    newPrio := HighestPriority
-]
+	]
 ].
 [
-wasBlocked := OperatingSystem blockInterrupts.
+	wasBlocked := OperatingSystem blockInterrupts.
-aProcess setPriority:newPrio.
+	aProcess setPriority:newPrio.
-oldList := quiescentProcessLists at:oldPrio.
+	oldList := quiescentProcessLists at:oldPrio.
-oldList notNil ifTrue:[
+	oldList notNil ifTrue:[
-(oldList remove:aProcess ifAbsent:nil) notNil ifTrue:[
+	    (oldList remove:aProcess ifAbsent:nil) notNil ifTrue:[
-newList := quiescentProcessLists at:newPrio.
+		newList := quiescentProcessLists at:newPrio.
-newList isNil ifTrue:[
+		newList isNil ifTrue:[
-quiescentProcessLists at:newPrio put:(newList := LinkedList new).
+		    quiescentProcessLists at:newPrio put:(newList := LinkedList new).
-].
+		].
-newList addLast:aProcess.
+		newList addLast:aProcess.
-"if its the current process lowering its prio
+		"if its the current process lowering its prio
-or another one raising, we have to reschedule"
+		 or another one raising, we have to reschedule"
-aProcess == activeProcess ifTrue:[
+		aProcess == activeProcess ifTrue:[
-currentPriority := newPrio.
+		    currentPriority := newPrio.
-newPrio < oldPrio ifTrue:[
+		    newPrio < oldPrio ifTrue:[
-self threadSwitch:scheduler.
+			self threadSwitch:scheduler.
-]
+		    ]
-] ifFalse:[
+		] ifFalse:[
-newPrio > currentPriority ifTrue:[
+		    newPrio > currentPriority ifTrue:[
-self threadSwitch:aProcess.
+			self threadSwitch:aProcess.
-]
+		    ]
-].
+		].
-]
+	    ]
-]
+	]
 ] valueNowOrOnUnwindDo:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ]
 "Modified: / 4.8.1998 / 00:08:54 / 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
 "ignore, if process is already dead"
 (aProcess isNil or:[aProcess id isNil]) ifTrue:[^ self].
 (s := aProcess state) == #osWait ifTrue:[
-'Processor [warning]: bad resume: #osWait' errorPrintCR.
+	'Processor [warning]: bad resume: #osWait' errorPrintCR.
-"/ MiniDebugger enterWithMessage:'bad resume: state osWait'.
+	"/ MiniDebugger enterWithMessage:'bad resume: state osWait'.
-^ self.
+	^ self.
 ].
 s == #stopped ifTrue:[
-'Processor [warning]: bad resume: #stopped' errorPrintCR.
+	'Processor [warning]: bad resume: #stopped' errorPrintCR.
-^ self.
+	^ 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].
 (pri > currentPriority) ifTrue:[
-"
+	"
-its prio is higher; immediately transfer control to it
+	 its prio is higher; immediately transfer control to it
-"
+	"
-self threadSwitch:aProcess
+	self threadSwitch:aProcess
 ] ifFalse:[
-"
+	"
-its prio is lower; it will have to wait for a while ...
+	 its prio is lower; it will have to wait for a while ...
-"
+	"
-aProcess state:#run
+	aProcess state:#run
 ]
 "Modified: / 24.8.1998 / 18:28:42 / cg"
 !
 suspend:aProcess
 "remove the argument, aProcess from the list of runnable processes.
 If the process is the current one, reschedule.
 Notice:
-This method should only be called by Process>>suspend or
+	 This method should only be called by Process>>suspend or
-Process>>suspendWithState:"
+	 Process>>suspendWithState:"
 |pri l p wasBlocked|
 "
 some debugging stuff
 "
 aProcess isNil ifTrue:[
-InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: nil suspend'.
+	InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: nil suspend'.
-^ self
+	^ self
 ].
 aProcess id isNil ifTrue:[
-InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: bad suspend: already dead'.
+	InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: bad suspend: already dead'.
-self threadSwitch:scheduler.
+	self threadSwitch:scheduler.
-^ self
+	^ self
 ].
 aProcess == scheduler ifTrue:[
-"only the scheduler may suspend itself"
+	"only the scheduler may suspend itself"
-activeProcess == scheduler ifTrue:[
+	activeProcess == scheduler ifTrue:[
-suspendScheduler := true.
+	    suspendScheduler := true.
-[suspendScheduler] whileTrue:[
+	    [suspendScheduler] whileTrue:[
-self dispatch.
+		self dispatch.
-].
+	    ].
-^ self
+	    ^ self
-].
+	].
-InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: scheduler should never be suspended'.
+	InvalidProcessSignal raiseWith:aProcess errorString:'PROCESSOR: scheduler should never be suspended'.
-^ self
+	^ self
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 pri := aProcess priority.
 "notice: this is slightly faster than putting the if-code into
 the ifAbsent block, because [] is a shared cheap block, created at compile time
 "
 (l isNil or:[(l remove:aProcess ifAbsent:nil) isNil]) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-'Processor [warning]: bad suspend: not on run list' errorPrintCR.
+	'Processor [warning]: bad suspend: not on run list' errorPrintCR.
-"/ MiniDebugger enterWithMessage:'bad suspend: not on run list'.
+	"/ MiniDebugger enterWithMessage:'bad suspend: not on run list'.
-aProcess == activeProcess ifTrue:[
+	aProcess == activeProcess ifTrue:[
-self threadSwitch:scheduler.
+	    self threadSwitch:scheduler.
-].
+	].
-^ self
+	^ self
 ].
 (aProcess == activeProcess) ifTrue:[
-"we can immediately switch sometimes"
+	"we can immediately switch sometimes"
-l isEmpty ifFalse:[
+	l isEmpty ifFalse:[
-p := l first
+	    p := l first
-] ifTrue:[
+	] ifTrue:[
-p := scheduler
+	    p := scheduler
-].
+	].
-self threadSwitch:p
+	self threadSwitch:p
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: / 23.9.1996 / 13:49:24 / stefan"
 "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"
 !
 "start preemptive scheduling (timeSlicing)"
 timeSliceProcess notNil ifTrue: [^ self].
 timeSliceProcess := [
-[
+	[
-|myDelay t flipFlop|
+	    |myDelay t flipFlop|
-myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
+	    myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
-flipFlop := true.
+	    flipFlop := true.
-[true] whileTrue: [
+	    [true] whileTrue: [
-t ~~ TimeSliceInterval ifTrue:[
+		t ~~ TimeSliceInterval ifTrue:[
-"/ interval changed -> need a new delay
+		    "/ interval changed -> need a new delay
-myDelay delay:(t := TimeSliceInterval).
+		    myDelay delay:(t := TimeSliceInterval).
-].
+		].
-myDelay wait.
+		myDelay wait.
-self slice.
+		self slice.
-"/ every other tick, recompute priorities.
+		"/ every other tick, recompute priorities.
-flipFlop := flipFlop not.
+		flipFlop := flipFlop not.
-flipFlop ifTrue:[
+		flipFlop ifTrue:[
-scheduledProcesses isNil ifTrue:[
+		    scheduledProcesses isNil ifTrue:[
-scheduledProcesses := IdentitySet new.
+			scheduledProcesses := IdentitySet new.
-] ifFalse:[
+		    ] ifFalse:[
-supportDynamicPriorities == true ifTrue:[
+			supportDynamicPriorities == true ifTrue:[
-self recomputeDynamicPriorities.
+			    self recomputeDynamicPriorities.
-].
+			].
-scheduledProcesses removeAll.
+			scheduledProcesses removeAll.
-].
+		    ].
-].
+		].
-]
+	    ]
-] valueOnUnwindDo:[
+	] valueOnUnwindDo:[
-timeSliceProcess := nil
+	    timeSliceProcess := nil
-]
+	]
 ] newProcess.
 timeSliceProcess priority:HighestPriority.
 timeSliceProcess name:'time slicer'.
 timeSliceProcess restartable:true.
 timeSliceProcess beSystemProcess.
 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.
-idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
+	writeCheckArray at:idx put:nil.
+	idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx+1.
 ].
 idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-timeoutArray at:idx put:nil.
+	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"
 !
 arrives. This will only happen, if the OS supports selecting on fileDescriptors."
 self signal:aSemaphore onInput:aFileDescriptor orCheck:nil
 !
+signal:aSemaphore onInputStream:aStream
+"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 ?
+	self signal:aSemaphore onInput:aStream aFileDescriptor orCheck:nil
+] ifFalse:[
+	"/ nope - must poll ...
+	self signal:aSemaphore onInput:nil orCheck:[aStream canReadWithoutBlocking]
+]
+!
 signal:aSemaphore onInput:aFileDescriptor orCheck:aBlock
 "arrange for a semaphore to be triggered when input on aFileDescriptor
-arrives OR checkblock evaluates to true. The checkBlock will be evaluated
+arrives OR checkblock evaluates to true.
-by the scheduler from time to time (i.e. every few milliseconds).
+The checkBlock will be evaluated by the scheduler from time to time
+(i.e. every few milliseconds).
 (This is req'd for buffered input, where a select may not detect
 data which has already been read into a buffer - as in Xlib.
 Or on systems, where we cannot select on a displays eventQ, such as windows)"
 |idx "{ Class: SmallInteger }"
 fd := aFileDescriptor.
 wasBlocked := OperatingSystem blockInterrupts.
 fd isNil ifTrue:[
-	'Processor [info]: no fd to select on - polling with checkBlock' infoPrintCR.
 	(readCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
-	    readFdArray := readFdArray copyWith:nil.
+	    idx := readFdArray identityIndexOf:nil startingAt:1.
-	    readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+	    idx ~~ 0 ifTrue:[
-	    readCheckArray := readCheckArray copyWith:aBlock.
+		readFdArray at:idx put:aFileDescriptor.
+		readSemaphoreArray at:idx put:aSemaphore.
+		readCheckArray at:idx put:aBlock
+	    ] ifFalse:[
+		readFdArray := readFdArray copyWith:nil.
+		readSemaphoreArray := readSemaphoreArray copyWith:aSemaphore.
+		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"
 !
-signal:aSemaphore onOutput:aFileDescriptor
+signal:aSemaphore onOutputStream:aStream
+"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 ?
+	self signal:aSemaphore onOutput:aStream aFileDescriptor orCheck:nil
+] ifFalse:[
+	"/ nope - must poll ...
+	self signal:aSemaphore onOutput:nil orCheck:[aStream canWriteWithoutBlocking]
+]
+!
+signal:aSemaphore onOutput:aFileDescriptor orCheck:aBlock
 "arrange for a semaphore to be triggered when output on aFileDescriptor
-is possible. (i.e. can be written without blocking).
+is possible (i.e. can be written without blocking) or aBlock returns true.
-This will only happen, if the OS supports selecting on fileDescriptors."
+The checkBlock will be evaluated by the scheduler from time to time
+(i.e. every few milliseconds).
+This checkBlock is required for poor windows, where a WaitForObject does
+not know ab�ut sockets."
 |idx "{ Class: SmallInteger }"
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
-(writeFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
-idx := writeFdArray identityIndexOf:nil startingAt:1.
+aFileDescriptor isNil ifTrue:[
-idx ~~ 0 ifTrue:[
+	(writeCheckArray identityIndexOf:aBlock startingAt:1) == 0 ifTrue:[
-writeFdArray at:idx put:aFileDescriptor.
+	    idx := writeFdArray identityIndexOf:nil startingAt:1.
-writeSemaphoreArray at:idx put:aSemaphore.
+	    idx ~~ 0 ifTrue:[
-] ifFalse:[
+		writeFdArray at:idx put:aFileDescriptor.
-writeFdArray := writeFdArray copyWith:aFileDescriptor.
+		writeSemaphoreArray at:idx put:aSemaphore.
-writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+		writeCheckArray at:idx put:aBlock
-].
+	    ] ifFalse:[
-useIOInterrupts ifTrue:[
+		writeFdArray := writeFdArray copyWith:nil.
-OperatingSystem enableIOInterruptsOn:aFileDescriptor
+		writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
-].
+		writeCheckArray := writeCheckArray copyWith:aBlock.
+	    ]
-].
+	]
+] ifFalse:[
+	(writeFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[
+	    idx := writeFdArray identityIndexOf:nil startingAt:1.
+	    idx ~~ 0 ifTrue:[
+		writeFdArray at:idx put:aFileDescriptor.
+		writeSemaphoreArray at:idx put:aSemaphore.
+		writeCheckArray at:idx put:aBlock
+	    ] ifFalse:[
+		writeFdArray := writeFdArray copyWith:aFileDescriptor.
+		writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+		writeCheckArray := writeCheckArray copyWith:aBlock.
+	    ].
+	    useIOInterrupts ifTrue:[
+		OperatingSystem enableIOInterruptsOn:aFileDescriptor
+	    ].
+	]
+].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 4.8.1997 / 15:21:49 / 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
-fefature should be disabled to avoid a blocking XPending.
+	fefature 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"
 ! !
 now := OperatingSystem getMillisecondTime.
 blocksToEvaluate := nil.
 n := timeoutArray size.
 anyTimeouts := false.
 1 to:n do:[:index |
-aTime := timeoutArray at:index.
+	aTime := timeoutArray at:index.
-aTime notNil ifTrue:[
+	aTime notNil ifTrue:[
-(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
+	    (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
-"this one should be triggered"
+		"this one should be triggered"
-sema := timeoutSemaphoreArray at:index.
+		sema := timeoutSemaphoreArray at:index.
-sema notNil ifTrue:[
+		sema notNil ifTrue:[
-timeoutSemaphoreArray at:index put:nil.
+		    timeoutSemaphoreArray at:index put:nil.
-sema signalOnce.
+		    sema signalOnce.
-] ifFalse:[
+		] ifFalse:[
-"to support pure-events"
+		    "to support pure-events"
-block := timeoutActionArray at:index.
+		    block := timeoutActionArray at:index.
-block notNil ifTrue:[
+		    block notNil ifTrue:[
-blocksToEvaluate isNil ifTrue:[
+			blocksToEvaluate isNil ifTrue:[
-blocksToEvaluate := OrderedCollection new:10.
+			    blocksToEvaluate := OrderedCollection new:10.
-processes := OrderedCollection new:10.
+			    processes := OrderedCollection new:10.
-].
+			].
-blocksToEvaluate add:block.
+			blocksToEvaluate add:block.
-processes add:(timeoutProcessArray at:index).
+			processes add:(timeoutProcessArray at:index).
-timeoutActionArray at:index put:nil.
+			timeoutActionArray at:index put:nil.
-timeoutProcessArray at:index put:nil.
+			timeoutProcessArray at:index put:nil.
-]
+		    ]
-].
+		].
-timeoutArray at:index put:nil.
+		timeoutArray at:index put:nil.
-] ifTrue:[
+	    ] ifTrue:[
-anyTimeouts := true
+		anyTimeouts := true
-]
+	    ]
-]
+	]
 ].
 blocksToEvaluate notNil ifTrue:[
-blocksToEvaluate keysAndValuesDo:[:index :block |
+	blocksToEvaluate keysAndValuesDo:[:index :block |
-|p|
+	    |p|
-p := processes at:index.
+	    p := processes at:index.
-(p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
+	    (p isNil or:[p == scheduler or:[PureEventDriven]]) ifTrue:[
-block value
+		block value
-] ifFalse:[
+	    ] ifFalse:[
-p isDead ifTrue:[
+		p isDead ifTrue:[
-"/ a timedBlock for a process which has already terminated
+		    "/ a timedBlock for a process which has already terminated
-"/ issue a warning and do not execute it.
+		    "/ issue a warning and do not execute it.
-"/ (exeuting here may be dangerous, since it would run at scheduler priority here,
+		    "/ (exeuting here may be dangerous, since it would run at scheduler priority here,
-"/  and thereby could block the whole smalltalk system.
+		    "/  and thereby could block the whole smalltalk system.
-"/  For this reason is it IGNORED here.)
+		    "/  For this reason is it IGNORED here.)
-('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
+		    ('ProcessorScheduler [warning]: cannot evaluate timedBlock for dead process: ''' , p name , '''') infoPrintCR.
-('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
+		    ('ProcessorScheduler [warning]: the timedBlock is: ' , block displayString) infoPrintCR.
-] ifFalse:[
+		] ifFalse:[
-p interruptWith:block
+		    p interruptWith:block
-]
+		]
-]
+	    ]
-]
+	]
 ]
 "Modified: / 9.11.1998 / 21:25:02 / cg"
 !
 "/ must enable interrupts, to be able to get out of a
 "/ long wait (especially, to handle sigChild in the meantime)
 (wasBlocked := OperatingSystem interruptsBlocked) ifTrue:[
-OperatingSystem unblockInterrupts.
+	OperatingSystem unblockInterrupts.
 ].
 fd := OperatingSystem
-selectOnAnyReadable:readFdArray
+	      selectOnAnyReadable:readFdArray
-writable:writeFdArray
+			 writable:writeFdArray
-exception:nil
+			exception:nil
-withTimeOut:millis.
+		      withTimeOut:millis.
 wasBlocked ifTrue:[
-OperatingSystem blockInterrupts.
+	OperatingSystem blockInterrupts.
 ].
 fd isNil ifTrue:[
-"/ either still nothing to do,
+	"/ either still nothing to do,
-"/ or error (which should not happen)
+	"/ or error (which should not happen)
-(err := OperatingSystem lastErrorSymbol) notNil ifTrue:[
+	(err := OperatingSystem lastErrorSymbol) notNil ifTrue:[
-err == #EBADF ifTrue:[
+	    err == #EBADF ifTrue:[
-"/ mhmh - one of the fd's given to me is corrupt.
+		"/ mhmh - one of the fd's given to me is corrupt.
-"/ find out which one .... and remove it
+		"/ find out which one .... and remove it
-'Processor [info]: obsolete FD in select - clearing' infoPrintCR.
+		'Processor [info]: obsolete FD in select - clearing' infoPrintCR.
-OperatingSystem clearLastErrorNumber.
+		OperatingSystem clearLastErrorNumber.
-self removeCorruptedFds
+		self removeCorruptedFds
-] ifFalse:[
+	    ] ifFalse:[
-err == #ENOENT ifTrue:[
+		err == #ENOENT ifTrue:[
-'Processor [warning]: ENOENT in select; rd=' infoPrint.
+		    'Processor [warning]: ENOENT in select; rd=' infoPrint.
-readFdArray infoPrint.
+		    readFdArray infoPrint.
-' wr=' infoPrint.
+		    ' wr=' infoPrint.
-writeFdArray infoPrintCR.
+		    writeFdArray infoPrintCR.
-] ifFalse:[
+		] ifFalse:[
-'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
+		    'Processor [warning]: error in select: ' infoPrint. err infoPrintCR.
-]
+		]
-].
+	    ].
-]
+	]
 ] ifFalse:[
-index := readFdArray indexOf:fd.
+	index := readFdArray indexOf:fd.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-sema := readSemaphoreArray at:index.
+	    sema := readSemaphoreArray at:index.
-sema notNil ifTrue:[
+	    sema notNil ifTrue:[
-sema signalOnce.
+		sema signalOnce.
-^ true
+		^ true
-].
+	    ].
-action := readCheckArray at:index.
+	    action := readCheckArray at:index.
-action notNil ifTrue:[
+	    action notNil ifTrue:[
-action value.
+		action value.
-^ true
+		 ^ true
-]
+	    ]
-]
+	]
 ].
 ^ false
 "Modified: / 12.4.1996 / 09:31:22 / stefan"
 "Modified: / 14.6.1998 / 17:31:51 / 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"
 !
 readFdArray keysAndValuesDo:[:idx :fd |
 	|rslt sema|
 	(fd notNil "and:[fd >= 0]") ifTrue:[
 	    rslt := OperatingSystem
-		        selectOnAnyReadable:(Array with:fd)
+			selectOnAnyReadable:(Array with:fd)
-			           writable:nil
+				   writable:nil
-			          exception:nil
+				  exception:nil
-			        withTimeOut:0.
+				withTimeOut:0.
 	    (rslt isNil and:[OperatingSystem lastErrorSymbol == #EBADF]) ifTrue:[
-	        ('Processor [info]: removing invalid read-select fileDescriptor: ' , fd printString) errorPrintCR.
+		('Processor [info]: removing invalid read-select fileDescriptor: ' , fd printString) errorPrintCR.
-	        readFdArray at:idx put:nil.
+		readFdArray at:idx put:nil.
-	        OperatingSystem clearLastErrorNumber.
+		readCheckArray at:idx put:nil.
-	        (sema := readSemaphoreArray at:idx) notNil ifTrue:[
+		OperatingSystem clearLastErrorNumber.
+		(sema := readSemaphoreArray at:idx) notNil ifTrue:[
 		    readSemaphoreArray at:idx put:nil.
 		    sema signal.
-	        ].
+		].
 	    ]
 	].
 ].
 writeFdArray keysAndValuesDo:[:idx :fd |
 	|rslt sema|
-	rslt := OperatingSystem
+	(fd notNil) ifTrue:[
-		    selectOnAnyReadable:nil
+	    rslt := OperatingSystem
-			       writable:(Array with:fd)
+			selectOnAnyReadable:nil
-			      exception:nil
+				   writable:(Array with:fd)
-			    withTimeOut:0.
+				  exception:nil
+				withTimeOut:0.
-	(rslt isNil and:[OperatingSystem lastErrorSymbol == #EBADF]) ifTrue:[
-	    ('Processor [info]: removing invalid write-select fileDescriptor: ' , fd printString) errorPrintCR.
+	    (rslt isNil and:[OperatingSystem lastErrorSymbol == #EBADF]) ifTrue:[
-	    writeFdArray at:idx put:nil.
+		('Processor [info]: removing invalid write-select fileDescriptor: ' , fd printString) errorPrintCR.
-	    OperatingSystem clearLastErrorNumber.
+		writeFdArray at:idx put:nil.
-	    (sema := writeSemaphoreArray at:idx) notNil ifTrue:[
+		writeCheckArray at:idx put:nil.
-		writeSemaphoreArray at:idx put:nil.
+		OperatingSystem clearLastErrorNumber.
-		sema signal.
+		(sema := writeSemaphoreArray at:idx) notNil ifTrue:[
-	    ].
+		    writeSemaphoreArray at:idx put:nil.
+		    sema signal.
+		].
+	    ]
 	]
 ].
 "Modified: 12.4.1996 / 09:32:58 / stefan"
 "Modified: 27.1.1997 / 20:09:27 / 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
 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"
 !
 ].
 OperatingSystem supportsIOInterrupts ifTrue:[
 	dT := 999999
 ] ifFalse:[
-dT := EventPollingInterval
+	dT := EventPollingInterval
 ].
 millis isNil ifTrue:[
 	millis := dT.
 ] ifFalse:[
 ! !
 !ProcessorScheduler class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.180 1999-10-08 09:03:21 ca Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.181 1999-12-14 18:46:28 cg Exp $'
 ! !
 ProcessorScheduler initialize!

changeset 5101	901c91d6dd50
parent 4879	a4fc6ad599f6
child 5103	7b1f6c93b3aa