hg/stx-libbasic: comparison ProcSched.st

equal deleted inserted replaced

-:f82adeef20af
+:02f9aa61f71b
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
+'From Smalltalk/X, Version:3.1.9 on 5-aug-1997 at 4:51:43 pm'                   !
 Object subclass:#ProcessorScheduler
 	instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
 		activeProcessId currentPriority readFdArray readSemaphoreArray
 		readCheckArray writeFdArray writeSemaphoreArray timeoutArray
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.
 idx ~~ 0 ifTrue:[
-	readFdArray at:idx put:nil.
+useIOInterrupts ifTrue:[
-	readCheckArray at:idx put:nil.
+OperatingSystem disableIOInterruptsOn:aFileDescriptor
-	readSemaphoreArray at:idx put:nil
+].
+readFdArray at:idx put:nil.
+readCheckArray at:idx put:nil.
+readSemaphoreArray 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
 evaluated when input on aFileDescriptor arrives.
 |idx "{Class: SmallInteger }"
 wasBlocked|
 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:[
+OperatingSystem enableIOInterruptsOn:aFileDescriptor
+].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+"Modified: 4.8.1997 / 15:17:28 / cg"
 ! !
 !ProcessorScheduler methodsFor:'accessing'!
 activePriority
 "
 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
 "
 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.
-	]
+]
 ].
 "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
-	].
+].
-	^ 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:[^ self].
+millis == 0 ifTrue:[^ 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:[^ self].
+millis == 0 ifTrue:[^ self].
-	].
+].
 "---"
-	useIOInterrupts ifTrue:[
+useIOInterrupts ifTrue:[
-	    readFdArray do:[:fd |
+"/            readFdArray do:[:fd |
-		(fd notNil and:[fd >= 0]) ifTrue:[
+"/                (fd notNil and:[fd >= 0]) ifTrue:[
-		    OperatingSystem enableIOInterruptsOn:fd
+"/                    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.
 ].
 "
 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
 (gotIOInterrupt or:[useIOInterrupts not]) ifTrue:[
-	gotIOInterrupt := false.
+gotIOInterrupt := false.
-	self checkForInputWithTimeout:0.
+self checkForInputWithTimeout:0.
 ]
 "Modified: 12.4.1996 / 10:14:18 / stefan"
-"Modified: 9.1.1997 / 16:12:44 / cg"
+"Modified: 4.8.1997 / 15:34:09 / cg"
 !
 dispatchLoop
 "central dispatch loop; the scheduler process is always staying in
 this method, looping forever."
 "start preemptive scheduling (timeSlicing)"
 timeSliceProcess notNil ifTrue: [^ self].
 timeSliceProcess := [
-	[
+[
-	    |myDelay t|
+|myDelay t|
-	    myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
+myDelay := Delay forMilliseconds:(t := TimeSliceInterval).
-	    [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
-	    ]
+]
-	] valueOnUnwindDo:[
+] valueOnUnwindDo:[
-	    timeSliceProcess := nil
+timeSliceProcess := nil
-	]
+]
 ] newProcess.
 timeSliceProcess priority:HighestPriority.
 timeSliceProcess name:'time slicer'.
+timeSliceProcess restartable:true.
 timeSliceProcess beSystemProcess.
 timeSliceProcess resume.
 "
 Processor stopTimeSlicing.
 Processor startTimeSlicing.
 "
 "Created: 17.1.1997 / 16:42:02 / cg"
-"Modified: 24.1.1997 / 21:34:24 / cg"
+"Modified: 4.8.1997 / 15:10:44 / cg"
 !
 stopTimeSlicing
 "stop preemptive scheduling (timeSlicing)"
 timeSliceProcess notNil ifTrue: [
-	timeSliceProcess terminate.
+timeSliceProcess terminate.
+timeSliceProcess := nil.
 ]
 "
 Processor stopTimeSlicing
 "
 "Created: 17.1.1997 / 16:43:03 / cg"
-"Modified: 17.1.1997 / 16:43:42 / cg"
+"Modified: 4.8.1997 / 14:27:45 / cg"
 ! !
 !ProcessorScheduler methodsFor:'semaphore signalling'!
 disableSemaphore:aSemaphore
 "disable triggering of a semaphore"
 |idx "{ Class: SmallInteger }"
-wasBlocked|
+wasBlocked fd|
 wasBlocked := OperatingSystem blockInterrupts.
 idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-	readFdArray at:idx put:nil.
+useIOInterrupts ifTrue:[
-	readSemaphoreArray at:idx put:nil.
+fd := readFdArray at:idx.
-	readCheckArray at:idx put:nil.
+fd notNil ifTrue:[
-	idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx.
+OperatingSystem disableIOInterruptsOn:fd
+].
+].
+readFdArray at:idx put:nil.
+readSemaphoreArray at:idx put:nil.
+readCheckArray at:idx put:nil.
+idx := readSemaphoreArray identityIndexOf:aSemaphore startingAt:idx.
 ].
 idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:1.
 [idx ~~ 0] whileTrue:[
-	writeFdArray at:idx put:nil.
+useIOInterrupts ifTrue:[
-	writeSemaphoreArray at:idx put:nil.
+fd := writeFdArray at:idx.
-	idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx.
+fd notNil ifTrue:[
+OperatingSystem disableIOInterruptsOn:fd
+].
+].
+writeFdArray at:idx put:nil.
+writeSemaphoreArray at:idx put:nil.
+idx := writeSemaphoreArray identityIndexOf:aSemaphore startingAt:idx.
 ].
 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.
+idx := timeoutSemaphoreArray identityIndexOf:aSemaphore startingAt:idx.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+"Modified: 4.8.1997 / 15:19:33 / cg"
 !
 signal:aSemaphore
 "arrange for a semaphore to be triggered as soon as possible.
 The actual signalling is performed slightly delayed, when the dispatcher
 |idx "{ Class: SmallInteger }"
 wasBlocked|
 aFileDescriptor isNil ifTrue:[
-	'ProcessorScheduler [info]: no fd to select on - polling with checkBlock' infoPrintCR
+'ProcessorScheduler [info]: no fd to select on - polling with checkBlock' infoPrintCR
 ].
 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.
-	    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:[
+OperatingSystem enableIOInterruptsOn:aFileDescriptor
+].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-"Modified: 10.1.1997 / 15:09:41 / cg"
+"Modified: 4.8.1997 / 15:20:45 / cg"
 !
 signal:aSemaphore onOutput:aFileDescriptor
 "arrange for a semaphore to be triggered when output on aFileDescriptor
 is possible. (i.e. can be written without blocking).
 |idx "{ Class: SmallInteger }"
 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 (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.
-	] ifFalse:[
+] ifFalse:[
-	    writeFdArray := writeFdArray copyWith:aFileDescriptor.
+writeFdArray := writeFdArray copyWith:aFileDescriptor.
-	    writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
+writeSemaphoreArray := writeSemaphoreArray copyWith:aSemaphore.
-	]
+].
+useIOInterrupts ifTrue:[
+OperatingSystem enableIOInterruptsOn:aFileDescriptor
+].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+"Modified: 4.8.1997 / 15:21:49 / cg"
 ! !
 !ProcessorScheduler methodsFor:'timeout handling'!
 addTimedBlock:aBlock afterMilliseconds:delta
 gotIOInterrupt := true.
 interruptedProcess := activeProcess.
 self threadSwitch:scheduler
 "Modified: 21.12.1995 / 16:17:40 / stefan"
-"Modified: 18.10.1996 / 20:36:05 / cg"
+"Modified: 4.8.1997 / 14:23:08 / cg"
 !
 removeCorruptedFds
 "this is sent when select returns an error due to some invalid
 fileDescriptor. May happen, if someone does a readWait/writeWait on a
 ! !
 !ProcessorScheduler class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.136 1997-08-05 14:06:35 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.137 1997-08-05 14:07:50 cg Exp $'
 ! !
 ProcessorScheduler initialize!

changeset 2831	02f9aa61f71b
parent 2830	f82adeef20af
child 2926	182baa3a4862