hg/stx-libbasic: comparison ProcSched.st

equal deleted inserted replaced

-:be947d4e7fb2
+:514c749165c3
 "
 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
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
 Object subclass:#ProcessorScheduler
-instanceVariableNames:'quiescentProcessLists scheduler
+	 instanceVariableNames:'quiescentProcessLists scheduler
-zombie
+				zombie
-activeProcess currentPriority
+				activeProcess currentPriority
-readFds readSemaphores readChecks
+				readFds readSemaphores readChecks
-writeFds writeSemaphores
+				writeFds writeSemaphores
-timeouts timeoutActions timeoutProcesses timeoutSemaphores
+				timeouts timeoutActions timeoutProcesses timeoutSemaphores
-idleActions anyTimeouts dispatching'
+				idleActions anyTimeouts dispatching'
-classVariableNames:'KnownProcesses KnownProcessIds
+	 classVariableNames:'KnownProcesses KnownProcessIds
-PureEventDriven
+			     PureEventDriven
-UserSchedulingPriority
+			     UserSchedulingPriority
-UserInterruptPriority
+			     UserInterruptPriority
-TimingPriority
+			     TimingPriority
-SchedulingPriority'
+			     SchedulingPriority'
-poolDictionaries:''
+	 poolDictionaries:''
-category:'Kernel-Processes'
+	 category:'Kernel-Processes'
 !
 ProcessorScheduler comment:'
 COPYRIGHT (c) 1993 by Claus Gittinger
-All Rights Reserved
+	     All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.20 1994-08-23 23:11:00 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.21 1994-10-10 00:27:28 claus Exp $
 '!
 Smalltalk at:#Processor put:nil!
 !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
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.20 1994-08-23 23:11:00 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.21 1994-10-10 00:27:28 claus Exp $
 "
 !
 documentation
 "
 'Processor'. It is responsible for scheduling among the smalltalk
 processes (threads; not to confuse with heavy weight unix processes).
 Scheduling is fully done in smalltalk (the always runnable scheduler-
 process, running at highest priority does this).
-The main primitive support is used in threadSwitch, which passes
+The main primitive to support this is found in threadSwitch, which passes
 control to another process (usually selected by the scheduler).
-Thus it is possible to modify the schedulers policy.
+Thus it is possible to modify the schedulers policy and implementation
+at the smalltalk level.
 (To answer a frequently asked question:
-dont add preemtive round-robin here; this can be implemented without
+dont add preemptive round-robin here; this can be implemented without
 any need to change the scheduler. See goodies/timeslicing.st for how
 this is done in a very elegant way).
 Notice: Smalltalk/X can (still) be compiled & configured without
 process support. This non-process mode is called 'pureEventDriven' mode
 This pure-event mode may not be supported in the future.
 class variables:
-KnownProcesses          <Collection>    all known processes
+	KnownProcesses          <Collection>    all known processes
-KnownProcessIds         <Collection>    and their IDs
+	KnownProcessIds         <Collection>    and their IDs
-PureEventDriven         <Boolean>       true, if no process support
+	PureEventDriven         <Boolean>       true, if no process support
-is available
+						is available
-UserSchedulingPriority  <Integer>       the priority at which normal
+	UserSchedulingPriority  <Integer>       the priority at which normal
-user interfaces run
+						user interfaces run
-UserInterruptPriority                   the priority at which user-
+	UserInterruptPriority                   the priority at which user-
-interrupts (Cntl-C) processing
+						interrupts (Cntl-C) processing
-takes place. Processes with
+						takes place. Processes with
-a greater or equal priority are
+						a greater or equal priority are
-not interruptable.
+						not interruptable.
-TimingPriority                          the priority used for timing.
+	TimingPriority                          the priority used for timing.
-Processes with a greater or
+						Processes with a greater or
-equal priority are not interrupted
+						equal priority are not interrupted
-by timers.
+						by timers.
-SchedulingPriority                      The priority of the scheduler (must
+	SchedulingPriority                      The priority of the scheduler (must
-me higher than any other).
+						me higher than any other).
 most interresting methods:
-Processor>>suspend:                  (see also Process>>suspend)
+	Processor>>suspend:                  (see also Process>>suspend)
-Processor>>resume:                   (see also Process>>resume)
+	Processor>>resume:                   (see also Process>>resume)
-Processor>>terminate:                (see also Process>>terminate)
+	Processor>>terminate:                (see also Process>>terminate)
-Processor>>yield
+	Processor>>yield
-Processor>>changePriority:for:       (see also Process>>priority:
+	Processor>>changePriority:for:       (see also Process>>priority:
-Processor>>signal:afterSeconds:      (see also Delay>>forSeconds:)
+	Processor>>signal:afterSeconds:      (see also Delay>>forSeconds:)
-Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
+	Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)
-Processor>>signal:onInput:           (see also ExternalStream>>readWait)
+	Processor>>signal:onInput:           (see also ExternalStream>>readWait)
-Processor>>signal:onOutput:          (see also ExternalStream>>writeWait)
+	Processor>>signal:onOutput:          (see also ExternalStream>>writeWait)
-Processor>>disableSemaphore:
+	Processor>>disableSemaphore:
 "
 ! !
 !ProcessorScheduler class methodsFor:'initialization'!
 UserSchedulingPriority := 8.
 UserInterruptPriority := 24.
 TimingPriority := 16.
 SchedulingPriority := 31.
-KnownProcesses isNil ifTrue:[
-KnownProcesses := WeakArray new:10.
-KnownProcesses watcher:self.
-KnownProcessIds := OrderedCollection new.
-"want to get informed when returning from snapshot"
-ObjectMemory addDependent:self
-].
 Processor isNil ifTrue:[
-"create the one and only processor"
+	"create the one and only processor"
-Processor := self new.
+	Processor := self basicNew initialize.
 ].
 "
 allow configurations without processes
 "
 PureEventDriven := self threadsAvailable not.
 PureEventDriven ifTrue:[
-'no process support - running event driven' errorPrintNL
+	'no process support - running event driven' errorPrintNL
 ].
-!
-update:something
-"being a dependent of the ObjectMemory, this is the notification
-that something happened"
-something == #restarted ifTrue:[
-self reinstallProcesses
-]
-!
-reinstallProcesses
-"recreate all processes after a snapShot load.
-This is currently not implemented (and might never be).
-All we could do is to restart the processes. Time will show."
-KnownProcesses do:[:p |
-p notNil ifTrue:[
-"how, exactly should this be done ?"
-p id ~~ 0 ifTrue:[
-'process restart not implemented' errorPrintNL
-]
-]
-]
 ! !
 !ProcessorScheduler class methodsFor:'instance creation'!
 new
 "there is (currently) only one processor ..."
-Processor isNil ifTrue:[
+self error:'only one processor is allowed in the system'
-Processor := self basicNew initialize
-].
-^ Processor.
 ! !
 !ProcessorScheduler class methodsFor:'instance release'!
 informDispose
-"some Process has been collected - terminate the underlying thread"
+"some Process has been garbage collected
+- terminate the underlying thread. Usually this does not happen,
+but the thread terminates itself by using #terminate."
 |id sz "{ Class: SmallInteger }"|
 sz := KnownProcessIds size.
 1 to:sz do:[:index |
-(KnownProcesses at:index) isNil ifTrue:[
+	(KnownProcesses at:index) isNil ifTrue:[
-id := KnownProcessIds at:index.
+	    id := KnownProcessIds at:index.
-id notNil ifTrue:[
+	    id notNil ifTrue:[
-Transcript showCr:('terminate thread ',
+		'PROCESSOR: terminating thread ' errorPrint.
-id printString,
+		id errorPrint.
-' (no longer refd)').
+		' (no longer refd)' errorPrintNL.
-self threadDestroy:id.
-KnownProcessIds at:index put:nil.
+		self threadDestroy:id.
-]
+		KnownProcessIds at:index put:nil.
-]
+	    ]
+	]
 ]
 ! !
 !ProcessorScheduler class methodsFor:'queries'!
 "make the process evaluate an interrupt"
 %{  /* NOCONTEXT */
 if (_isSmallInteger(id)) {
-__threadInterrupt(_intVal(id));
+	__threadInterrupt(_intVal(id));
 }
 %}
 !
-threadCreate:aBlock
+threadCreate:aProcess
-"physical creation of a process executing aBlock.
+"physical creation of a process.
 (warning: low level entry, no administration done).
 This may return nil, if process could not be created."
 %{  /* NOCONTEXT */
 int tid;
 extern int __threadCreate();
-tid = __threadCreate(aBlock, 0 /* stackSize no longer needed */);
+tid = __threadCreate(aProcess, 0 /* stackSize no longer needed */);
 if (tid != 0) {
-RETURN ( _MKSMALLINT(tid));
+	RETURN ( _MKSMALLINT(tid));
 }
 %}
 .
 "
 arrive here, if creation of process in VM failed.
-(no memory for process)
+This may happen, if the VM does not support more processes,
+or if it ran out of memory, when allocating internal data
+structures.
 "
 ^ ObjectMemory allocationFailureSignal raise.
 !
 threadDestroy:id
 (warning: low level entry, no administration done)"
 %{  /* NOCONTEXT */
 if (_isSmallInteger(id)) {
-__threadDestroy(_intVal(id));
+	__threadDestroy(_intVal(id));
 }
 %}
 ! !
 !ProcessorScheduler methodsFor:'primitive process primitives'!
 "continue execution in aProcess.
 (warning: low level entry, no administration is done here)"
 |id pri ok oldProcess oldPri p singleStep wasBlocked|
-aProcess isNil ifTrue:[^ self].
+(aProcess isNil or:[aProcess == activeProcess]) ifTrue:[^ self].
-aProcess == activeProcess ifTrue:[^ self].
 wasBlocked := OperatingSystem blockInterrupts.
 oldProcess := activeProcess.
 oldPri := currentPriority.
 id := aProcess id.
 pri := aProcess priority.
 singleStep := aProcess isSingleStepping.
 aProcess state:#active.
-oldProcess state == #active ifTrue:[
+oldProcess setStateTo:#run if:#active.
-oldProcess state:#run.
-].
 "no interrupts now - activeProcess has already been changed
 (dont add any message sends here)"
 activeProcess := aProcess.
 currentPriority := pri.
 %{
 extern OBJ __threadSwitch(), __threadSwitchWithSingleStep();
 if (singleStep == true)
-ok = __threadSwitchWithSingleStep(__context, _intVal(id));
+	ok = __threadSwitchWithSingleStep(__context, _intVal(id));
 else
-ok = __threadSwitch(__context, _intVal(id));
+	ok = __threadSwitch(__context, _intVal(id));
 %}.
 "time passes ...
 ... here again"
 ok ifFalse:[
-"
+	"
-switch failed for some reason -
+	 switch failed for some reason -
-destroy the bad process
+	 destroy the bad process
-"
+	"
-p := activeProcess.
+	p := activeProcess.
-activeProcess := oldProcess.
+	activeProcess := oldProcess.
-currentPriority := oldPri.
+	currentPriority := oldPri.
-p id ~~ 0 ifTrue:[
+	p id ~~ 0 ifTrue:[
-p state:#suspended.
+	    'process switch failed' errorPrintNL.
-p terminate.
+	    p state:#suspended.
-]
+	    self terminateNoSignal:p.
+	]
 ].
 zombie notNil ifTrue:[
-self class threadDestroy:zombie.
+	self class threadDestroy:zombie.
-zombie := nil
+	zombie := nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 scheduleForInterrupt:aProcess
 initialize
 "initialize the one-and-only ProcessorScheduler"
 |nPrios l p|
+KnownProcesses isNil ifTrue:[
+	KnownProcesses := WeakArray new:10.
+	KnownProcesses watcher:self class.
+	KnownProcessIds := OrderedCollection new.
+].
 nPrios := SchedulingPriority.
 quiescentProcessLists := Array new:nPrios.
 readFds := Array with:nil.
 for a runnable process.
 "
 currentPriority := SchedulingPriority.
 p := Process new.
-p setId:0.
+p setId:0 state:#run.
+p setPriority:currentPriority.
 p name:'scheduler'.
-p state:#run.
-p setPriority:currentPriority.
 l := LinkedList new.
 l add:p.
 scheduler := activeProcess := p.
 ObjectMemory ioInterruptHandler:self.
 ObjectMemory timerInterruptHandler:self.
 !
-reInitialize
+reinitialize
-"all previous stuff is obsolete - each object should reinstall itself
+"all previous processes are dead - each object should reinstall its
-upon restart."
+process(s) upon restart - especially, windowgroups have to."
-KnownProcesses := WeakArray new:5.
+KnownProcesses do:[:p |
-KnownProcesses watcher:self class.
+	p notNil ifTrue:[
-KnownProcessIds := OrderedCollection new.
+	    "how, exactly should this be done ?"
+	    'process restart not implemented' errorPrintNL.
+	    p setId:nil state:#dead
+	].
+	scheduler setId:nil state:#dead
+].
+"
+now, start from scratch
+"
+KnownProcesses := nil.
 self initialize
 ! !
 !ProcessorScheduler methodsFor:'private'!
 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 watcher:self class.
+	newShadow watcher: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].
 !
 |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'!
-newProcessFor:aBlock
+newProcessFor:aProcess
-"create a new process executing aBlock.
+"create a physical (VM-) process for aProcess.
-Return a process (or nil if fail). The new process is not scheduled.
+Return true if ok, false if something went wrong.
-To start it running, it needs a Process>>resume."
+The process is not scheduled; to start it running, it needs a Process>>resume."
-|id p|
+|id|
-id := self class threadCreate:aBlock.
+id := self class threadCreate:aProcess.
-id isNil ifTrue:[
+id isNil ifTrue:[^ false].
-"
-this may happen, if the VM does not support more processes,
+aProcess setId:id state:#light.   "meaning: has no stack yet"
-or if it ran out of memory, when allocating internal data
+self remember:aProcess.
-structures
+^ true
-"
-self error:'cannot create new Process'.
-^ nil
-].
-p := Process new.
-p setId:id.
-p startBlock:aBlock.
-p state:#light.  "meaning: has no stack yet"
-p setPriority:currentPriority.
-"
-give it a user-friendly name
-"
-activeProcess name notNil ifTrue:[
-p name:(activeProcess name , ' (sub)')
-].
-self remember:p.
-^ p
 ! !
 !ProcessorScheduler methodsFor:'scheduling'!
 reschedule
-"switch to the highest prio runnable process
+"switch to the highest prio runnable process.
-The scheduler itself is always runnable, so there is always a switch.
+The scheduler itself is always runnable, so we can do an unconditional switch
-(if you want to implement your own scheduler stuff, uncomment below)"
+to that one. This method is a historical left-over and will vanish."
 ^ self threadSwitch:scheduler
-"/    |l p maxPri "{ Class: SmallInteger }"|
-"/
-"/    maxPri := SchedulingPriority.
-"/    maxPri to:1 by:-1 do:[:prio |
-"/        l := quiescentProcessLists at:prio.
-"/        l notNil ifTrue:[
-"/            p := l first.
-"/            p notNil ifTrue:[
-"/                activeProcess state == #active ifTrue:[
-"/                    activeProcess state:#run.
-"/                ].
-"/                ^ self threadSwitch:p
-"/            ].
-"/            quiescentProcessLists at:prio put:nil
-"/        ]
-"/    ].
-"/    "
-"/     no process to run - this 'cannot' happen
-"/     (well, not quite: it may happen if the scheduler process is
-"/      suspended - which btw. should be avoided, since noone is there
-"/      to schedule processes then)
-"/    "
-"/
-"/    MiniDebugger enterWithMessage:'fatal dispatcher should never be suspended'.
-"/
-"/    "try to repair by just resuming ..."
-"/    activeProcess resume
 !
 yield
 "move the currently running process to the end of the currentList
 and reschedule to the first in the list, thus switching to the
 "
 debugging consistency checks - will be removed later
 "
 l isNil ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-'oops - nil runnable list' errorPrintNL.
+	'oops - nil runnable list' errorPrintNL.
-^ self
+	^ self
 ].
 l isEmpty ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-'oops - empty runnable list' errorPrintNL.
+	'oops - empty runnable list' errorPrintNL.
-^ self
+	^ self
 ].
 l size == 1 ifTrue:[
-"
+	"
-the running one is the only one
+	 the running one is the only one
-"
+	"
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	^ self
 ].
 "
 bring running process to the end
 "
 "
 some debugging stuff
 "
 aProcess isNil ifTrue:[
-MiniDebugger enterWithMessage:'nil suspend'.
+	MiniDebugger enterWithMessage:'nil suspend'.
-^ self
+	^ self
 ].
 aProcess id isNil ifTrue:[
-MiniDebugger enterWithMessage:'bad suspend: already dead'.
+	MiniDebugger enterWithMessage:'bad suspend: already dead'.
-	self reschedule.
+	self threadSwitch:scheduler.
-^ self
+	^ self
 ].
 aProcess == scheduler ifTrue:[
-MiniDebugger enterWithMessage:'scheduler should never be suspended'.
+	'scheduler should never be suspended' printNL.
-^ self
+	"/ MiniDebugger enterWithMessage:'scheduler should never be suspended'.
+	^ self
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 pri := aProcess priority.
 "
 debugging consisteny checks - will be removed later
 "
 l isNil ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-'bad suspend: empty run list' printNL.
+	'bad suspend: empty run list' printNL.
-"/ MiniDebugger enterWithMessage:'bad suspend: empty run list'.
+	"/ MiniDebugger enterWithMessage:'bad suspend: empty run list'.
-self reschedule.
+	self threadSwitch:scheduler.
-^ self
+	^ self
 ].
 l remove:aProcess ifAbsent:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-MiniDebugger enterWithMessage:'bad suspend: not on run list'.
+	'bad suspend: not on run list' printNL.
-^ self
+	"/ MiniDebugger enterWithMessage:'bad suspend: not on run list'.
+	self threadSwitch:scheduler.
+	^ self
 ].
 l isEmpty ifTrue:[
-quiescentProcessLists at:pri put:nil.
+	quiescentProcessLists at:pri put:nil.
-l := nil
+	l := nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "
 this is a bit of a kludge: allow someone else to
-set the state to something like ioWait etc.
+set the state to something like #ioWait etc.
-In this case, do not set to suspend.
+In this case, do not set to #suspend.
 All of this to enhance the output of the process monitor ...
 "
-s := aProcess state.
+aProcess setStateTo:#suspended if:#active or:#run.
-((s == #active) or:[s == #run]) ifTrue:[
-aProcess state:#suspended.
-].
 (aProcess == activeProcess) ifTrue:[
-"we can immediately switch sometimes"
+	"we can immediately switch sometimes"
-l notNil ifTrue:[
+	l notNil ifTrue:[
-p := l first
+	    p := l first
-] ifFalse:[
+	] ifFalse:[
-p := scheduler
+	    p := scheduler
-].
+	].
-self threadSwitch:p
+	self threadSwitch:p
-"/            self reschedule
 ].
 !
 resume:aProcess
 "set aProcess runnable -
 pri := aProcess priority.
 l := quiescentProcessLists at:pri.
 l isNil ifTrue:[
-l := LinkedList new.
+	l := LinkedList new.
-quiescentProcessLists at:pri put:l
+	quiescentProcessLists at:pri put:l
 ] ifFalse:[
-"if already running, ignore"
+	"if already running, ignore"
-(l includes:aProcess) ifTrue:[
+	(l includes:aProcess) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	    ^ self
-]
+	]
 ].
 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
 ]
 !
 resumeForSingleSend:aProcess
 "like resume, but let the process execute a single send only.
 pri := aProcess priority.
 l := quiescentProcessLists at:pri.
 l isNil ifTrue:[
-l := LinkedList new.
+	l := LinkedList new.
-quiescentProcessLists at:pri put:l
+	quiescentProcessLists at:pri put:l
 ] ifFalse:[
-"if already running, ignore"
+	"if already running, ignore"
-(l includes:aProcess) ifTrue:[
+	(l includes:aProcess) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	    ^ self
-]
+	]
 ].
 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
-"
+	"
 "/        activeProcess state:#run.
-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:#suspended
+	aProcess state:#suspended
 ]
 !
-terminate:aProcess
+terminateNoSignal:aProcess
-"terminate aProcess. If its not the current process, its simply
+"hard terminate aProcess without sending the terminate signal, thus
-removed from its list and destroyed. Otherwise, a switch is forced
+no unwind blocks or exitAction are performed in the process..
-and the process is destroyed by the next running process."
+If its not the current process, it is simply removed from its list
+and physically destroyed. Otherwise (since we can't take away the chair
+we are sitting on), a switch is forced and the process
+will be physically destroyed by the next running process.
+(see zombie handling)"
 |pri id l wasBlocked|
 aProcess isNil ifTrue:[^ self].
 id := aProcess id.
 id isNil ifTrue:[^ self].   "already dead"
-aProcess setId:nil.
+aProcess setId:nil state:#dead.
-aProcess startBlock:nil.
+"/    aProcess setStartBlock:nil.
 wasBlocked := OperatingSystem blockInterrupts.
 "remove the process from the runnable list"
 pri := aProcess priority.
 l := quiescentProcessLists at:pri.
 (l notNil and:[l includes:aProcess]) ifTrue:[
-l remove:aProcess.
+	l remove:aProcess.
-l isEmpty ifTrue:[quiescentProcessLists at:pri put:nil].
+	l isEmpty ifTrue:[quiescentProcessLists at:pri put:nil].
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-aProcess exitAction notNil ifTrue:[
-aProcess exitAction value.
-aProcess exitAction:nil
-].
-aProcess state:#dead.
 aProcess == activeProcess ifTrue:[
-"
+	"
-hard case - its the currently running process
+	 hard case - its the currently running process
-we must have the next active process destroy this one
+	 we must have the next active process destroy this one
-(we cannot destroy the chair we are sitting on ... :-)
+	 (we cannot destroy the chair we are sitting on ... :-)
-"
+	"
-zombie := id.
+	zombie := id.
-self unRemember:aProcess.
+	self unRemember:aProcess.
-self threadSwitch:scheduler.
+	self threadSwitch:scheduler.
-"/        self reschedule.
+	"not reached"
-^ self
+	^ self
 ].
 self class threadDestroy:id.
 self unRemember:aProcess.
 ^ self
 !
+terminateActiveNoSignal
+"hard terminate the active process, without sending any
+terminate signal thus no unwind blocks are evaluated."
+self terminateNoSignal:activeProcess
+!
 processTermination
-"current process finished its startup block without termination,
+"sent by VM if the current process finished its startup block
-lay him to rest now."
+without proper process termination, lay him to rest now.
+This can only happen, if something went wrong in Block>>newProcess,
-self terminate:activeProcess.
+since the block defined there always terminates itself."
+self terminateNoSignal:activeProcess.
 self threadSwitch:scheduler
-"/    self reschedule
+!
+terminate:aProcess
+"terminate aProcess. This is deon by sending aProcess the terminateSignal,
+which will evaluate any unwind blocks and finally do a hard terminate."
+aProcess terminate
 !
 terminateActive
-"terminate the current process
+"terminate the current process (i.e. the currently running process kills itself).
-(i.e. the currently running process kills itself)"
+The active process is sent the terminateSignal so it will evaluate any
+unwind blocks."
-self terminate:activeProcess
+activeProcess terminate
 !
 interruptActive
 "interrupt the current process (i.e. myself)"
 "
 check for valid argument
 "
 newPrio := prio.
 newPrio < 1 ifTrue:[
-newPrio := 1.
+	newPrio := 1.
 ] ifFalse:[
-newPrio >= SchedulingPriority ifTrue:[
+	newPrio >= SchedulingPriority ifTrue:[
-newPrio := SchedulingPriority - 1
+	    newPrio := SchedulingPriority - 1
-]
+	]
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 aProcess setPriority:newPrio.
 oldList := quiescentProcessLists at:oldPrio.
 (oldList isNil or:[(oldList includes:aProcess) not]) ifTrue:[
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	^ self
 ].
 oldList remove:aProcess.
 oldList isEmpty ifTrue:[quiescentProcessLists at:oldPrio put:nil].
 newList := quiescentProcessLists at:newPrio.
 newList isNil ifTrue:[
-newList := LinkedList new.
+	newList := LinkedList new.
-quiescentProcessLists at:newPrio put:newList
+	quiescentProcessLists at:newPrio put:newList
 ].
 newList addLast:aProcess.
 "if its the current process lowering its prio
 or another one raising, we have to reschedule"
 aProcess == activeProcess ifTrue:[
-currentPriority := newPrio.
+	currentPriority := newPrio.
-newPrio < oldPrio ifTrue:[
+	newPrio < oldPrio ifTrue:[
-self threadSwitch:scheduler.
+	    self threadSwitch:scheduler.
-"/            self reschedule.
+	]
-]
 ] ifFalse:[
-newPrio > currentPriority ifTrue:[
+	newPrio > currentPriority ifTrue:[
 "/            activeProcess state:#run.
-self threadSwitch:aProcess.
+	    self threadSwitch:aProcess.
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
 !ProcessorScheduler methodsFor:'accessing'!
 "Processor currentPriority"
 !
 activePriority
 "return the priority of the currently running process.
-GNU-ST compatibility; this is the same as currentPriority"
+GNU-ST & ST-80 compatibility; this is the same as currentPriority"
 ^ currentPriority
 !
 activeProcess
 |l p maxPri "{ Class: SmallInteger }" |
 maxPri := self highestPriority.
 maxPri to:1 by:-1 do:[:prio |
-l := quiescentProcessLists at:prio.
+	l := quiescentProcessLists at:prio.
-l notNil ifTrue:[
+	l notNil ifTrue:[
-l isEmpty ifTrue:[
+	    l isEmpty ifTrue:[
-"
+		"
-on the fly clear out empty lists
+		 on the fly clear out empty lists
-"
+		"
-quiescentProcessLists at:prio put:nil
+		quiescentProcessLists at:prio put:nil
-] ifFalse:[
+	    ] 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:[
-'process with nil id removed' printNL.
+		    'process with nil id removed' printNL.
-l removeFirst.
+		    l removeFirst.
-^ nil.
+		    ^ nil.
-].
+		].
-^ p
+		^ p
-].
+	    ].
-]
+	]
 ].
 ^ nil
 ! !
 !ProcessorScheduler methodsFor:'dispatching'!
 "I made this an extra call to dispatch; this allows recompilation
 of the dispatch-handling code in the running system.
 "
 [true] whileTrue:[
-self dispatch
+	self dispatch
 ]
 !
 dispatch
 "It handles timeouts and switches to the highest prio runnable process"
 "
 handle all timeout actions
 "
 anyTimeouts ifTrue:[
-self evaluateTimeouts
+	self evaluateTimeouts
 ].
 "first do a quick check using checkActions - this is needed for
 devices like X-connection, where some events might be in the event
 queue, so a select does not always help
 "
 any := false.
 nActions := readChecks size.
 1 to:nActions do:[:index |
-|checkBlock sema action|
+	|checkBlock sema action|
-checkBlock := readChecks at:index.
+	checkBlock := readChecks at:index.
-(checkBlock notNil and:[checkBlock value]) ifTrue:[
+	(checkBlock notNil and:[checkBlock value]) ifTrue:[
-sema := readSemaphores at:index.
+	    sema := readSemaphores 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.
-^ self
+	^ self
 ].
 pri := p priority.
 "want to give control to another process p.
 this will all change, when timeouts are removed and all is process driven
 "
 "
 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].
-].
+	].
 "---"
-OperatingSystem supportsIOInterrupts ifTrue:[
+	OperatingSystem supportsIOInterrupts ifTrue:[
-readFds do:[:fd |
+	    readFds do:[:fd |
-fd notNil ifTrue:[
+		fd notNil ifTrue:[
-OperatingSystem enableIOInterruptsOn:fd
+		    OperatingSystem enableIOInterruptsOn:fd
-].
+		].
-].
+	    ].
-] ifFalse:[
+	] ifFalse:[
-millis notNil ifTrue:[
+	    millis notNil ifTrue:[
-millis := millis min:50
+		millis := millis min:50
-] ifFalse:[
+	    ] ifFalse:[
-millis := 50
+		millis := 50
-]
+	    ]
-]
+	]
 ].
 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"
 millis notNil ifTrue:[
-OperatingSystem disableTimer.
+	OperatingSystem disableTimer.
-self checkForInputWithTimeout:0.
+	self checkForInputWithTimeout:0.
 ]
 ! !
 !ProcessorScheduler methodsFor:'waiting'!
 ioInterrupt
-"data arrived while waiting - reschedule to bring dispatcher into play"
+"data arrived while waiting - switch to scheduler process which will decide
+what to do now."
 self threadSwitch:scheduler
-"/    self reschedule
 !
 timerInterrupt
-"timer expired while waiting - reschedule to bring dispatcher into play"
+"timer expired while waiting - switch to scheduler process which will decide
+what to do now."
 self threadSwitch:scheduler
-"/    self reschedule
 !
 timeToNextTimeout
 "return the delta-T (in millis) to next timeout, or nil if
 there is none"
 If there where many, the list should be kept sorted ... keeping deltas
 to next (as in Unix kernel)"
 n := timeouts size.
 1 to:n do:[:index |
-aTime := timeouts at:index.
+	aTime := timeouts at:index.
-aTime notNil ifTrue:[
+	aTime notNil ifTrue:[
-minDelta isNil ifTrue:[
+	    minDelta isNil ifTrue:[
-now := OperatingSystem getMillisecondTime.
+		now := OperatingSystem getMillisecondTime.
-(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0].
+		(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0].
-minDelta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now.
+		minDelta := OperatingSystem millisecondTimeDeltaBetween:aTime and:now.
-] ifFalse:[
+	    ] ifFalse:[
-(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0].
+		(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[^ 0].
-minDelta := minDelta min:(OperatingSystem millisecondTimeDeltaBetween:aTime and:now)
+		minDelta := minDelta min:(OperatingSystem millisecondTimeDeltaBetween:aTime and:now)
-]
+	    ]
-]
+	]
 ].
 ^ minDelta
 !
 |millis limit doingGC|
 doingGC := true.
 [doingGC] whileTrue:[
-anyTimeouts ifTrue:[
+	anyTimeouts ifTrue:[
-millis := self timeToNextTimeout.
+	    millis := self timeToNextTimeout.
-(millis notNil and:[millis <= 0]) ifTrue:[
+	    (millis notNil and:[millis <= 0]) ifTrue:[
-^ self    "oops - hurry up checking"
+		^ self    "oops - hurry up checking"
-].
+	    ].
-].
+	].
-"if its worth doing, collect a bit of garbage"
+	"if its worth doing, collect a bit of garbage"
-limit := ObjectMemory incrementalGCLimit.
+	limit := ObjectMemory incrementalGCLimit.
-doingGC := limit notNil and:[ObjectMemory oldSpaceAllocatedSinceLastGC > limit].
+	doingGC := limit notNil and:[ObjectMemory oldSpaceAllocatedSinceLastGC > limit].
-doingGC ifTrue:[
+	doingGC ifTrue:[
-ObjectMemory gcStep.
+	    ObjectMemory gcStep.
-].
+	].
-"then do idle actions"
+	"then do idle actions"
-(idleActions size ~~ 0) ifTrue:[
+	(idleActions size ~~ 0) ifTrue:[
-idleActions do:[:aBlock |
+	    idleActions do:[:aBlock |
-aBlock value.
+		aBlock value.
-].
+	    ].
-^ self   "go back checking"
+	    ^ self   "go back checking"
-].
+	].
-doingGC ifTrue:[
+	doingGC ifTrue:[
-(self checkForInputWithTimeout:0) ifTrue:[
+	    (self checkForInputWithTimeout:0) ifTrue:[
-^ self  "go back checking"
+		^ self  "go back checking"
-]
+	    ]
-]
+	]
 ].
 (self checkForInputWithTimeout:0) ifTrue:[
-^ self  "go back checking"
+	^ self  "go back checking"
 ].
 "no, really nothing to do - simply wait"
 OperatingSystem supportsSelect ifFalse:[
-"SCO instant ShitStation has a bug here,
+	"SCO instant ShitStation has a bug here,
-waiting always 1 sec in the select - therefore we delay a bit and
+	 waiting always 1 sec in the select - therefore we delay a bit and
-return - effectively polling in 50ms cycles
+	 return - effectively polling in 50ms cycles
-"
+	"
-OperatingSystem millisecondDelay:50.
+	OperatingSystem millisecondDelay:50.
-^ self
+	^ self
 ].
 millis isNil ifTrue:[
-millis := 9999.
+	millis := 9999.
 ] ifFalse:[
-millis := millis rounded
+	millis := millis rounded
 ].
 self checkForInputWithTimeout:millis
 !
 checkForInputWithTimeout:millis
 hard wait for either input to arrive or a timeout to occur."
 |fd index sema action|
 fd := OperatingSystem
-selectOnAnyReadable:readFds
+	      selectOnAnyReadable:readFds
-writable:writeFds
+			 writable:writeFds
-exception:nil
+			exception:nil
-withTimeOut:millis.
+		      withTimeOut:millis.
 fd notNil ifTrue:[
-index := readFds indexOf:fd.
+	index := readFds indexOf:fd.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-sema := readSemaphores at:index.
+	    sema := readSemaphores at:index.
-sema notNil ifTrue:[
+	    sema notNil ifTrue:[
-sema signalOnce.
+		sema signalOnce.
-^ true
+		^ true
-] ifFalse:[
+	    ] ifFalse:[
-action := readChecks at:index.
+		action := readChecks at:index.
-action notNil ifTrue:[
+		action notNil ifTrue:[
-action value.
+		    action value.
-^ true
+		     ^ true
-]
+		]
-]
+	    ]
-]
+	]
 ].
 ^ false
-!
-evaluateTimeouts
-"walk through timeouts and evaluate blocks or signal semas that need to be .."
-|sema now aTime block blocksToEvaluate
-processes n "{ Class: SmallInteger }"|
-anyTimeouts ifFalse:[ ^ self].
-"have to collect the blocks first, then evaluate them. This avoids
-problems due to newly inserted blocks."
-now := OperatingSystem getMillisecondTime.
-blocksToEvaluate := nil.
-n := timeouts size.
-anyTimeouts := false.
-1 to:n do:[:index |
-aTime := timeouts at:index.
-aTime notNil ifTrue:[
-(OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
-"this one should be triggered"
-sema := timeoutSemaphores at:index.
-sema notNil ifTrue:[
-sema signalOnce.
-timeoutSemaphores at:index put:nil
-] ifFalse:[
-"to support pure-events"
-block := timeoutActions at:index.
-block notNil ifTrue:[
-blocksToEvaluate isNil ifTrue:[
-blocksToEvaluate := OrderedCollection new:10.
-processes := OrderedCollection new:10.
-].
-blocksToEvaluate add:block.
-processes add:(timeoutProcesses at:index).
-timeoutActions at:index put:nil.
-timeoutProcesses at:index put:nil.
-]
-].
-timeouts at:index put:nil.
-] ifTrue:[
-anyTimeouts := true
-]
-]
-].
-blocksToEvaluate notNil ifTrue:[
-1 to:blocksToEvaluate size do:[:index |
-PureEventDriven ifTrue:[
-(blocksToEvaluate at:index) value
-] ifFalse:[
-(processes at:index) interruptWith:(blocksToEvaluate at:index)
-]
-]
-]
 ! !
 !ProcessorScheduler methodsFor:'semaphore signalling'!
 signal:aSemaphore onInput:aFileDescriptor
 |idx wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 (readFds includes:aFileDescriptor) ifFalse:[
-idx := readFds indexOf:nil.
+	idx := readFds indexOf:nil.
-idx ~~ 0 ifTrue:[
+	idx ~~ 0 ifTrue:[
-readFds at:idx put:aFileDescriptor.
+	    readFds at:idx put:aFileDescriptor.
-readSemaphores at:idx put:aSemaphore.
+	    readSemaphores at:idx put:aSemaphore.
-readChecks at:idx put:aBlock
+	    readChecks at:idx put:aBlock
-] ifFalse:[
+	] ifFalse:[
-readFds := readFds copyWith:aFileDescriptor.
+	    readFds := readFds copyWith:aFileDescriptor.
-readSemaphores := readSemaphores copyWith:aSemaphore.
+	    readSemaphores := readSemaphores copyWith:aSemaphore.
-readChecks := readChecks copyWith:aBlock.
+	    readChecks := readChecks copyWith:aBlock.
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 signal:aSemaphore onOutput:aFileDescriptor
 |idx wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 (writeFds includes:aFileDescriptor) ifFalse:[
-idx := writeFds indexOf:nil.
+	idx := writeFds indexOf:nil.
-idx ~~ 0 ifTrue:[
+	idx ~~ 0 ifTrue:[
-writeFds at:idx put:aFileDescriptor.
+	    writeFds at:idx put:aFileDescriptor.
-writeSemaphores at:idx put:aSemaphore.
+	    writeSemaphores at:idx put:aSemaphore.
-] ifFalse:[
+	] ifFalse:[
-writeFds := writeFds copyWith:aFileDescriptor.
+	    writeFds := writeFds copyWith:aFileDescriptor.
-writeSemaphores := writeSemaphores copyWith:aSemaphore.
+	    writeSemaphores := writeSemaphores copyWith:aSemaphore.
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 signal:aSemaphore afterSeconds:seconds
 |index wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 index := timeoutSemaphores identityIndexOf:aSemaphore.
 index ~~ 0 ifTrue:[
-timeouts at:index put:aMillisecondTime
+	timeouts at:index put:aMillisecondTime
 ] ifFalse:[
-index := timeouts indexOf:nil.
+	index := timeouts indexOf:nil.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-timeoutSemaphores at:index put:aSemaphore.
+	    timeoutSemaphores at:index put:aSemaphore.
-timeouts at:index put:aMillisecondTime.
+	    timeouts at:index put:aMillisecondTime.
-timeoutActions at:index put:nil.
+	    timeoutActions at:index put:nil.
-timeoutProcesses at:index put:nil
+	    timeoutProcesses at:index put:nil
-] ifFalse:[
+	] ifFalse:[
-timeoutSemaphores := timeoutSemaphores copyWith:aSemaphore.
+	    timeoutSemaphores := timeoutSemaphores copyWith:aSemaphore.
-timeouts := timeouts copyWith:aMillisecondTime.
+	    timeouts := timeouts copyWith:aMillisecondTime.
-timeoutActions := timeoutActions copyWith:nil.
+	    timeoutActions := timeoutActions copyWith:nil.
-timeoutProcesses := timeoutProcesses copyWith:nil
+	    timeoutProcesses := timeoutProcesses copyWith:nil
-].
+	].
 ].
 anyTimeouts := true.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 |idx wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 idx := readSemaphores identityIndexOf:aSemaphore.
 idx ~~ 0 ifTrue:[
-readFds at:idx put:nil.
+	readFds at:idx put:nil.
-readSemaphores at:idx put:nil.
+	readSemaphores at:idx put:nil.
-readChecks at:idx put:nil
+	readChecks at:idx put:nil
+].
+idx := writeSemaphores identityIndexOf:aSemaphore.
+idx ~~ 0 ifTrue:[
+	writeFds at:idx put:nil.
+	writeSemaphores at:idx put:nil.
 ].
 idx := timeoutSemaphores identityIndexOf:aSemaphore.
 idx ~~ 0 ifTrue:[
-timeouts at:idx put:nil.
+	timeouts at:idx put:nil.
-timeoutSemaphores at:idx put:nil.
+	timeoutSemaphores at:idx put:nil.
-timeoutActions at:idx put:nil.
+	timeoutActions at:idx put:nil.
-timeoutProcesses at:idx put:nil.
+	timeoutProcesses at:idx put:nil.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
 !ProcessorScheduler methodsFor:'background processing'!
 addIdleBlock:aBlock
 "add the argument, aBlock to the list of idle-actions.
 Idle blocks are evaluated whenever no other process is runnable,
 and no events are pending.
 Use of idle blocks is not recommended, use a low priority processes
-instead, which has the same effect. They have been implemented to support
+instead, which has the same effect. Idle blcoks are still included
-background actions in pure-event systems, where no processes are
+to support background actions in pure-event systems, where no processes
-available.
+are available.
 Support for idle-blocks may vanish."
 |wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 idleActions isNil ifTrue:[
-idleActions := OrderedCollection new
+	idleActions := OrderedCollection new
 ].
 idleActions add:aBlock.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
 !ProcessorScheduler methodsFor:'I/O event actions'!
-enableIOAction:aBlock on:aFileDescriptor
+enableIOAction:aBlock onInput:aFileDescriptor
 "half-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 wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 (readFds includes:aFileDescriptor) ifFalse:[
-idx := readFds indexOf:nil.
+	idx := readFds indexOf:nil.
-idx ~~ 0 ifTrue:[
+	idx ~~ 0 ifTrue:[
-readFds at:idx put:aFileDescriptor.
+	    readFds at:idx put:aFileDescriptor.
-readChecks at:idx put:aBlock.
+	    readChecks at:idx put:aBlock.
-readSemaphores at:idx put:nil
+	    readSemaphores at:idx put:nil
-] ifFalse:[
+	] ifFalse:[
-readFds := readFds copyWith:aFileDescriptor.
+	    readFds := readFds copyWith:aFileDescriptor.
-readChecks := readChecks copyWith:aBlock.
+	    readChecks := readChecks copyWith:aBlock.
-readSemaphores := readSemaphores copyWith:nil.
+	    readSemaphores := readSemaphores copyWith:nil.
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 disableFd:aFileDescriptor
 |idx wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 idx := readFds indexOf:aFileDescriptor.
 idx ~~ 0 ifTrue:[
-readFds at:idx put:nil.
+	readFds at:idx put:nil.
-readChecks at:idx put:nil.
+	readChecks at:idx put:nil.
-readSemaphores at:idx put:nil
+	readSemaphores at:idx put:nil
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ! !
-!ProcessorScheduler methodsFor:'timed block'!
+!ProcessorScheduler methodsFor:'timeout handling'!
 addTimedBlock:aBlock afterSeconds:delta
 "add the argument, aBlock to the list of time-scheduled-blocks.
 to be evaluated after delta seconds. The process which installs this timed
 block will be interrupted for execution of the block.
 (if it is running, the interrupt will occur in whatever method it is
-executing; if it is suspended, it will be resumed for the execution).
+executing; if it is suspended, it will be resumed).
 The block will be removed from the timed-block list after evaluation
 (i.e. it will trigger only once)."
 self addTimedBlock:aBlock for:activeProcess afterMilliseconds:(delta * 1000) rounded
 !
 addTimedBlock:aBlock for:aProcess afterSeconds:delta
 "add the argument, aBlock to the list of time-scheduled-blocks.
 to be evaluated after delta seconds. aProcess will be interrupted for
 execution of the block.
 (if it is running, the interrupt will occur in whatever method it is
-executing; if it is suspended, it will be resumed for the execution).
+executing; if it is suspended, it will be resumed).
+If aProcess is nil, the block will be evaluated by the scheduler itself
+(which is dangerous - the block should not raise any error conditions).
 The block will be removed from the timed-block list after evaluation
 (i.e. it will trigger only once)."
 self addTimedBlock:aBlock for:aProcess afterMilliseconds:(delta * 1000) rounded
 !
 addTimedBlock:aBlock afterMilliseconds:delta
 "add the argument, aBlock to the list of time-scheduled-blocks; to be
 evaluated after delta milliseconds. The process which installs this timed
 block will be interrupted for execution of the block.
 (if it is running, the interrupt will occur in whatever method it is
-executing; if it is suspended, it will be resumed for the execution).
+executing; if it is suspended, it will be resumed).
 The block will be removed from the timed-block list after evaluation
 (i.e. it will trigger only once)."
 ^ self addTimedBlock:aBlock for:activeProcess afterMilliseconds:delta
 !
 addTimedBlock:aBlock for:aProcess afterMilliseconds:delta
 "add the argument, aBlock to the list of time-scheduled-blocks; to be
-evaluated after delta milliseconds. aProcess will be interrupted for
+evaluated after delta milliseconds. The process specified by the argument,
-execution of the block.
+aProcess will be interrupted for execution of the block.
 (if it is running, the interrupt will occur in whatever method it is
-executing; if it is suspended, it will be resumed for the execution).
+executing; if it is suspended, it will be resumed).
+If aProcess is nil, the block will be evaluated by the scheduler itself
+(which is dangerous - the block should not raise any error conditions).
 The block will be removed from the timed-block list after evaluation
 (i.e. it will trigger only once)."
 |now then wasBlocked|
 "add the argument, aBlock to the list of time-scheduled-blocks; to be
 evaluated when the millisecondClock value passes aMillisecondTime.
 The process which installs this timed block will be interrupted for
 execution of the block.
 (if it is running, the interrupt will occur in whatever method it is
-executing; if it is suspended, it will be resumed for the execution).
+executing; if it is suspended, it will be resumed).
 The block will be removed from the timed-block list after evaluation
 (i.e. it will trigger only once)."
 self addTimedBlock:aBlock for:activeProcess atMilliseconds:aMillisecondTime
 !
 addTimedBlock:aBlock for:aProcess atMilliseconds:aMillisecondTime
 "add the argument, aBlock to the list of time-scheduled-blocks; to be
 evaluated by aProcess when the millisecondClock value passes
-aMillisecondTime.
+aMillisecondTime. The process specified by the argument,
-aProcess will be interrupted for execution of the block.
+aProcess will be interrupted for execution of the block. If
+aProcess is nil, the block will be evaluated by the scheduler itself
+(which is dangerous - the block should not raise any error conditions).
 (if it is running, the interrupt will occur in whatever method it is
-executing; if it is suspended, it will be resumed for the execution).
+executing; if it is suspended, it will be resumed).
 The block will be removed from the timed-block list after evaluation
 (i.e. it will trigger only once)."
 |index wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 index := timeoutActions identityIndexOf:aBlock.
 index ~~ 0 ifTrue:[
-timeouts at:index put:aMillisecondTime
+	timeouts at:index put:aMillisecondTime
 ] ifFalse:[
-index := timeouts indexOf:nil.
+	index := timeouts indexOf:nil.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-timeouts at:index put:aMillisecondTime.
+	    timeouts at:index put:aMillisecondTime.
-timeoutActions at:index put:aBlock.
+	    timeoutActions at:index put:aBlock.
-timeoutSemaphores at:index put:nil.
+	    timeoutSemaphores at:index put:nil.
-timeoutProcesses at:index put:aProcess
+	    timeoutProcesses at:index put:aProcess
-] ifFalse:[
+	] ifFalse:[
-timeouts := timeouts copyWith:aMillisecondTime.
+	    timeouts := timeouts copyWith:aMillisecondTime.
-timeoutActions := timeoutActions copyWith:aBlock.
+	    timeoutActions := timeoutActions copyWith:aBlock.
-timeoutSemaphores := timeoutSemaphores copyWith:nil.
+	    timeoutSemaphores := timeoutSemaphores copyWith:nil.
-timeoutProcesses := timeoutProcesses copyWith:aProcess.
+	    timeoutProcesses := timeoutProcesses copyWith:aProcess.
-].
+	].
 ].
 anyTimeouts := true.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 !
 |index wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 index := timeoutActions identityIndexOf:aBlock.
 (index ~~ 0) ifTrue:[
-timeouts at:index put:nil.
+	timeouts at:index put:nil.
-timeoutActions at:index put:nil.
+	timeoutActions at:index put:nil.
-timeoutSemaphores at:index put:nil.
+	timeoutSemaphores at:index put:nil.
-timeoutProcesses at:index put:nil.
+	timeoutProcesses at:index put:nil.
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-! !
+!
+evaluateTimeouts
+"walk through timeouts and evaluate blocks or signal semas that need to be .."
+|sema now aTime block blocksToEvaluate
+processes n "{ Class: SmallInteger }"|
+anyTimeouts ifFalse:[ ^ self].
+"have to collect the blocks first, then evaluate them. This avoids
+problems due to newly inserted blocks."
+now := OperatingSystem getMillisecondTime.
+blocksToEvaluate := nil.
+n := timeouts size.
+anyTimeouts := false.
+1 to:n do:[:index |
+	aTime := timeouts at:index.
+	aTime notNil ifTrue:[
+	    (OperatingSystem millisecondTime:aTime isAfter:now) ifFalse:[
+		"this one should be triggered"
+		sema := timeoutSemaphores at:index.
+		sema notNil ifTrue:[
+		    sema signalOnce.
+		    timeoutSemaphores at:index put:nil
+		] ifFalse:[
+		    "to support pure-events"
+		    block := timeoutActions at:index.
+		    block notNil ifTrue:[
+			blocksToEvaluate isNil ifTrue:[
+			    blocksToEvaluate := OrderedCollection new:10.
+			    processes := OrderedCollection new:10.
+			].
+			blocksToEvaluate add:block.
+			processes add:(timeoutProcesses at:index).
+			timeoutActions at:index put:nil.
+			timeoutProcesses at:index put:nil.
+		    ]
+		].
+		timeouts at:index put:nil.
+	    ] ifTrue:[
+		anyTimeouts := true
+	    ]
+	]
+].
+blocksToEvaluate notNil ifTrue:[
+	blocksToEvaluate keysAndValuesDo:[:index :block |
+	    |p|
+	    p := processes at:index.
+	    (p isNil or:[PureEventDriven]) ifTrue:[
+		block value
+	    ] ifFalse:[
+		p interruptWith:block
+	    ]
+	]
+]
+! !

changeset 159	514c749165c3
parent 144	dcea1d2b93bc
child 161	ed36169f354d