"

 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 gotIOInterrupt

		osChildExitActions gotChildSignalInterrupt

		exitWhenNoMoreUserProcesses suspendScheduler'

	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven

		UserSchedulingPriority UserInterruptPriority TimingPriority

		HighestPriority SchedulingPriority MaxNumberOfProcesses

		InvalidProcessSignal'

	poolDictionaries:''

	category:'Kernel-Processes'

!

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

"

!

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          <WeakArray>     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).

	MaxNumberOfProcesses                    if non-nil, no more than this

						number of processes are allowed

						(for debugging)

    most interesting 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:

    [see also:]

	Process

	Delay Semaphore SemaphoreSet SharedQueue

	WindowGroup

	(``Working with processes'': programming/processes.html)

    [author:]

	Claus Gittinger

"

! !

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

    InvalidProcessSignal isNil ifTrue:[

        InvalidProcessSignal := ErrorSignal newSignalMayProceed:true.

        InvalidProcessSignal nameClass:self message:#invalidProcessSignal.

        InvalidProcessSignal notifierString:'invalid process'.

    ].

    Processor isNil ifTrue:[

        "create the one and only processor"

        Processor := self basicNew initialize.

    ].

    "

     allow configurations without processes

     (but such configurations are no longer distributed)

    "

    PureEventDriven := self threadsAvailable not.

    PureEventDriven ifTrue:[

        'Processor [error]: no process support - running event driven' errorPrintCR

    ].

    "Modified: 23.9.1996 / 14:24:50 / stefan"

    "Modified: 10.1.1997 / 18:03:03 / cg"

! !

!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:'Signal constants'!

invalidProcessSignal

    ^ InvalidProcessSignal

    "Created: 23.9.1996 / 13:44:57 / stefan"

! !

!ProcessorScheduler class methodsFor:'instance release'!

update:something with:aParameter from:changedObject

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

    something == #ElementExpired ifTrue:[

        sz := KnownProcessIds size.

        1 to:sz do:[:index |

            "/ (KnownProcesses at:index) isNil ifTrue:[

            (KnownProcesses at:index) == 0 ifTrue:[

                id := KnownProcessIds at:index.

                id notNil ifTrue:[

                    'Processor [warning]: terminating thread ' errorPrint.

                    id errorPrint.

                    self threadDestroy:id.

                    KnownProcessIds at:index put:nil.

                ].

                KnownProcesses at:index put:nil.

            ]

        ]

    ]

    "Created: 7.1.1997 / 16:45:42 / stefan"

! !

!ProcessorScheduler class methodsFor:'primitive process primitives'!

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

    MaxNumberOfProcesses notNil ifTrue:[

	KnownProcessIds size >= MaxNumberOfProcesses ifTrue:[

	    (KnownProcessIds count:[:el | el notNil]) >= MaxNumberOfProcesses ifTrue:[

		"

		 the number of processes has reached the (soft) limit.

		 This limit prevents runaway programs from creating too many

		 processes. If you continue in the debugger, the process will be

		 created as usual. If you dont want this, abort or terminate.

		"

		self error:'too many processes'.

	    ]

	]

    ].

%{

    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));

    }

%}

!

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));

    }

%}

!

threadsAvailable

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

     false otherwise."

%{  /* NOCONTEXT */

    RETURN (__threadsAvailable());

%}

! !

!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

!

knownProcesses

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

    ^ KnownProcesses select:[:p | p notNil and:[p ~~ 0]]

!

maxNumberOfProcesses

    "return the limit on the number of processes;

     the default is nil (i.e. unlimited)."

    ^ MaxNumberOfProcesses

!

maxNumberOfProcesses:aNumber

    "set the limit on the number of processes.

     This helps if you have a program which (by error) creates countless

     subprocesses. Without this limit, you may have a hard time to find

     this error (and repairing it). If nil (the default), the number of

     processes is unlimited."

    MaxNumberOfProcesses := aNumber

!

processDriven

    "turn on process driven mode"

    PureEventDriven := false

!

pureEventDriven

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

    PureEventDriven := true

! !

!ProcessorScheduler methodsFor:'I/O event actions'!

disableFd:aFileDescriptor

    "disable block events on aFileDescriptor.

     This is a leftover support for pure-event systems and may vanish."

    |idx "{Class: SmallInteger }" 

     wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.

    idx ~~ 0 ifTrue:[

	readFdArray at:idx put:nil.

	readCheckArray at:idx put:nil.

	readSemaphoreArray at:idx put:nil

    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

!

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 "{Class: SmallInteger }"

     wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    (readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[

	idx := readFdArray identityIndexOf:nil startingAt:1.

	idx ~~ 0 ifTrue:[

	    readFdArray at:idx put:aFileDescriptor.

	    readCheckArray at:idx put:aBlock.

	    readSemaphoreArray at:idx put:nil

	] ifFalse:[

	    readFdArray := readFdArray copyWith:aFileDescriptor.

	    readCheckArray := readCheckArray copyWith:aBlock.

	    readSemaphoreArray := readSemaphoreArray copyWith:nil.

	]

    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

! !

!ProcessorScheduler methodsFor:'accessing'!

activePriority

    "return the priority of the currently running process.

     GNU-ST & ST-80 compatibility; this is the same as currentPriority"

    ^ currentPriority

!

activeProcess

    "return the currently running process"

    ^ activeProcess

    "Processor activeProcess"

!

currentPriority

    "return the priority of the currently running process"

    ^ currentPriority

    "Processor currentPriority"

!

interruptedProcess

    "returns the process which was interrupted by the active one"

    ^ interruptedProcess

! !

!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. Idle blcoks are still included

     to support background actions in pure-event systems, where no processes 

     are available.

     Support for idle-blocks may vanish."

    |wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    idleActions isNil ifTrue:[

	idleActions := OrderedCollection new

    ].

    idleActions add:aBlock.

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

!

removeIdleBlock:aBlock

    "remove the argument, aBlock from the list of idle-blocks.

     Support for idle-blocks may vanish - use low prio processes instead."

    |wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    idleActions notNil ifTrue:[

       idleActions remove:aBlock ifAbsent:[]

    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

! !

!ProcessorScheduler methodsFor:'dispatching'!

dispatch

     "It handles timeouts and switches to the highest prio runnable process"

    |any millis pri p nActions "{ Class: SmallInteger }"

     checkBlock sema|

    "

     handle all timeout actions

    "

    anyTimeouts ifTrue:[

        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. 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 notNil and:[checkBlock value]) ifTrue:[

            sema := readSemaphoreArray at:index.

            sema notNil ifTrue:[

                sema signalOnce.

            ].

            any := true.