"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      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

				zombie

				activeProcess currentPriority

				readFdArray readSemaphoreArray readCheckArray

				writeFdArray writeSemaphoreArray

				timeoutArray timeoutActionArray timeoutProcessArray timeoutSemaphoreArray

				idleActions anyTimeouts dispatching interruptedProcess

				useIOInterrupts'

	 classVariableNames:'KnownProcesses KnownProcessIds

			     PureEventDriven

			     UserSchedulingPriority 

			     UserInterruptPriority

			     TimingPriority

			     HighestPriority

	 poolDictionaries:''

	 category:'Kernel-Processes'

!

ProcessorScheduler comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

	     All Rights Reserved

'!

Smalltalk at:#Processor put:nil!

!ProcessorScheduler class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      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.

"

!

version

"

"

!

documentation

"

    This class has only one instance, which is bound to the global

    '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 VM 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 and implementation

    at the smalltalk level.

    (To answer a frequently asked question:

     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

    and is useful to quickly port ST/X to systems, where these facilities

    are either not needed (server applications), or are difficult to

    implement (threads require some assembler support functions). 

    To allow pureEvent mode, kludges are built into some places in the

    system, where either a process is forked, or a timeout is used instead 

    (for examples, see ProcessMonitor or MemoryMonitor).

    This pure-event mode may not be supported in the future 

    (actually, it is no longer maintained in places where was present, so dont

     run the system without Processes).

    class variables:

	KnownProcesses          <Collection>    all known processes

	KnownProcessIds         <Collection>    and their IDs

	PureEventDriven         <Boolean>       true, if no process support

						is available

	UserSchedulingPriority  <Integer>       the priority at which normal

						user interfaces run

	UserInterruptPriority                   the priority at which user-

						interrupts (Cntl-C) processing

						takes place. Processes with

						a greater or equal priority are

						not interruptable.

	TimingPriority                          the priority used for timing.

						Processes with a greater or

						equal priority are not interrupted

						by timers.

	HighestPriority                         The highest allowed prio for processes

	SchedulingPriority                      The priority of the scheduler (must

						me higher than any other).

    most interresting methods:

	Processor>>suspend:                  (see also Process>>suspend)

	Processor>>resume:                   (see also Process>>resume)

	Processor>>terminate:                (see also Process>>terminate)

	Processor>>yield 

	Processor>>changePriority:for:       (see also Process>>priority:

	Processor>>signal:afterSeconds:      (see also Delay>>forSeconds:)

	Processor>>signal:afterMilliseconds: (see also Delay>>forMilliseconds:)

	Processor>>signal:onInput:           (see also ExternalStream>>readWait)

	Processor>>signal:onOutput:          (see also ExternalStream>>writeWait)

	Processor>>disableSemaphore:

"

! !

!ProcessorScheduler class methodsFor:'initialization'!

initialize

    "class setup: create the one-and-only instance of myself and

     setup some priority values."

    UserSchedulingPriority := 8.

    UserInterruptPriority := 24.

    TimingPriority := 16.

    SchedulingPriority := 31.

    HighestPriority := 30.

    Processor isNil ifTrue:[

	"create the one and only processor"

	Processor := self basicNew initialize.

    ].

    "

     allow configurations without processes

    "

    PureEventDriven := self threadsAvailable not.

    PureEventDriven ifTrue:[

	'no process support - running event driven' errorPrintNL

    ].

! !

!ProcessorScheduler class methodsFor:'instance creation'!

new

    "there is (currently) only one processor ..."

    self error:'only one processor is allowed in the system'

! !

!ProcessorScheduler class methodsFor:'instance release'!

informDispose

    "some Process has been garbage collected 

     - terminate the underlying thread. 

     Usually this does not happen; instead, the process terminates itself 

     by sending #terminate."

    |id sz "{ Class: SmallInteger }"|

    sz := KnownProcessIds size.

    1 to:sz do:[:index |

	(KnownProcesses at:index) isNil ifTrue:[

	    id := KnownProcessIds at:index.

	    id notNil ifTrue:[

		'PROCESSOR: terminating thread ' errorPrint.

		id errorPrint.

		' (no longer refd)' errorPrintNL.

		self threadDestroy:id.

		KnownProcessIds at:index put:nil.

	    ]

	]

    ]

! !

!ProcessorScheduler class methodsFor:'queries'!

isPureEventDriven

    "this is temporary - (maybe not :-).

     you can run ST/X either with or without processes.

     Without, there is conceptionally a single process handling all

     outside events and timeouts. This has some negative implications

     (Debugger is ugly), but allows a fully portable ST/X without any

     assembler support - i.e. quick portability.

     The PureEvent flag will automatically be set if the runtime system

     does not support threads - otherwise, it can be set manually

     (from rc-file).

    "

    ^ PureEventDriven

!

pureEventDriven

    "turn on pure-event driven mode - no processes, single dispatch loop"

    PureEventDriven := true

!

processDriven

    "turn on process driven mode"

    PureEventDriven := false

!

knownProcesses

    "return a collection of all (living) processes in the system"

    ^ KnownProcesses select:[:p | p notNil]

! !

!ProcessorScheduler class methodsFor:'primitive process primitives'!

threadsAvailable

    "return true, if the runtime system supports threads (i.e. processes);

     false otherwise."

%{  /* NOCONTEXT */

    extern OBJ __threadsAvailable();

    RETURN (__threadsAvailable());

%}

!

threadInterrupt:id

    "make the process evaluate an interrupt. This sets a flag in the VMs

     threadSwitcher, to let the process perform a #interrupt when its set to

     run the next time. The process itself can decide how to react on this 

     interrupt (currently, it looks for interruptBlocks to evaluate)."

%{  /* NOCONTEXT */

    if (__isSmallInteger(id)) {

	__threadInterrupt(_intVal(id));

    }

%}

!

threadCreate:aProcess withId:id

    "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."

    int tid;

    extern int __threadCreate();

    tid = __threadCreate(aProcess, 

			 0   /* stackSize: no longer needed */, 

			 __isSmallInteger(id) ? _intVal(id)     /* assign id */

					      : -1              /* let VM assign one */  );

    if (tid) {

	RETURN ( _MKSMALLINT(tid));

    }

%}

.

    "

     arrive here, if creation of process in VM failed.

     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

    "physical destroy other process ...

     (warning: low level entry, no administration done)"

%{  /* NOCONTEXT */

    if (__isSmallInteger(id)) {

	__threadDestroy(_intVal(id));

    }

%}

! !

!ProcessorScheduler methodsFor:'primitive process primitives'!

threadSwitch:aProcess

    "continue execution in aProcess.

     (warning: low level entry, no administration is done here)"

    |id pri ok oldProcess oldPri p singleStep wasBlocked|

    (aProcess isNil or:[aProcess == activeProcess]) ifTrue:[^ self].

    wasBlocked := OperatingSystem blockInterrupts.

    oldProcess := activeProcess.

    oldPri := currentPriority.

    id := aProcess id.

    pri := aProcess priority.

    singleStep := aProcess isSingleStepping.

    aProcess state:#active.

    oldProcess setStateTo:#run if:#active.

    "

     no interrupts now - activeProcess has already been changed

     (dont add any message sends here)

    "

    activeProcess := aProcess.

    currentPriority := pri.

%{

    extern OBJ ___threadSwitch();

    if (__isSmallInteger(id)) {

	ok = ___threadSwitch(__context, _intVal(id), (singleStep == true) ? 1 : 0);

    } else {

	ok = false;

    }

%}.

    "time passes spent in some other process ...

     ... here again"

    p := activeProcess.

    activeProcess := oldProcess.

    ok ifFalse:[

	"

	 switch failed for some reason -

	 destroy the bad process

	"

	p id ~~ 0 ifTrue:[

	    'SCHEDULER: problem with process ' errorPrint. 

		p id errorPrint. 

		p name notNil ifTrue:[

		    ' (' errorPrint. p name errorPrint. ')' errorPrint.

		].

		'; hard-terminate it.' errorPrintNL.

	    p state:#suspended.

	    self terminateNoSignal:p.

	]

    ].

    zombie notNil ifTrue:[

	self class threadDestroy:zombie.

	zombie := nil

    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

!

scheduleForInterrupt:aProcess

    "make aProcess evaluate its pushed interrupt block(s)"

    |id|

    aProcess isNil ifTrue:[^ self].

    aProcess == activeProcess ifTrue:[^ self].

    id := aProcess id.

    self class threadInterrupt:id.

    "

     and, make the process runnable

    "

    aProcess state ~~ #stopped ifTrue:[

	"

	 and, make the process runnable

	"

	aProcess resume

    ]

! !

!ProcessorScheduler methodsFor:'constants'!

lowestPriority

    "return the lowest priority value"

    ^ 1   "do not change this - its not variable"

!

highestPriority

    "return the highest priority value (normal) processes can have."

    "must be below schedulingPriority - 

     otherwise scheduler could be blocked ...

    "

    ^ HighestPriority  

!

schedulingPriority

    "return the priority at which the scheduler runs."

    "must be above highestPriority - 

     otherwise scheduler could be blocked ...

    "

    ^ SchedulingPriority

!

userInterruptPriority

    "return the priority, at which the event scheduler runs - i.e.

     all processes running at a lower priority are interruptable by Cntl-C

     or the timer. Processes running at higher prio will not be interrupted."

    ^ UserInterruptPriority

!

timingPriority

    "return the priority, at which all timing takes place (messageTally,

     delay etc.)"

    ^ TimingPriority

!

userSchedulingPriority

    "return the priority, at which all normal user (interactive) processing

     takes place"

    ^ UserSchedulingPriority

!

userBackgroundPriority

    "return the priority, at which background user (non-interactive) processing

     should take place.

     Not currently used - for ST80 compatibility only"

    ^ 6

!

systemBackgroundPriority

    "return the priority, at which background system processing

     should take place.

     Not currently used - for ST80 compatibility only"

    ^ 4

!

lowIOPriority

    "not currently used - for ST80 compatibility only"