"

 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

		currentPriority readFdArray readSemaphoreArray readCheckArray

		writeFdArray writeSemaphoreArray timeoutArray timeoutActionArray

		timeoutProcessArray timeoutSemaphoreArray idleActions anyTimeouts

		dispatching interruptedProcess useIOInterrupts gotIOInterrupt

		osChildExitActions gotChildSignalInterrupt

		exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess'

	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven

		UserSchedulingPriority UserInterruptPriority TimingPriority

		HighestPriority SchedulingPriority MaxNumberOfProcesses

		InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval'

	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' (well, on future multiprocessor systems, things may look

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

    See the 'scheduling' documentation.

    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.

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

	TimeSliceInterval			for preemptive priority scheduling only:

						the time interval in millis, at which processes

						are timesliced

	TimeSlicingPriorityLimit		for preemptive priority scheduling only:

						processes are only timesliced, if running 

						at or below this priority.

    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

"

!

scheduling

"

    By default, the scheduler does 'non preemptive priority scheduling'; 

    this means, that the highest priority runnable process 

    is choosen and allowed to run, until it either gives back the CPU (via #yield),

    or suspends (i.e. waiting for I/O, the time or a semaphore),

    or a higher priority process becomes runnable..

    If another process is runnable at the same priority, it will not

    be given CPU-time, unless one of the above happens.

    The consequence is, that a user process running at (say) priority 8,

    may block other user processes at the same priority, if it does heavy

    processing, or loops.

    (the event handling responsible to care for userInterrupts, is running at

     a much higher priority, so that interrupting the process should always be possible).

    The scheduler also supports 'timesliced priority scheduling', which is enabled

    via the #startTimeSlicing message (and disabled by #stopTimeSlicing).

    In this mode, the highest priority running process is suspended in regular intervals

    (the TimeSliceInterval) IFF there is another runnable process with the same priority.

    I.e. the top highest priority processes are timeshared.

    In this mode, the other processes will also get a chance to make some progress - however,

    lower priority process will only run, IFF all higher prio processes are waiting for an

    event.

    Timeslicing will not be done for processes running above TimeSlicingPriorityLimit, which

    allows for critical processes to run unaffected to completion.

    WARNING:

	timesliced priority scheduling is an experimental feature. There is no warranty,

        (at the moment), that the system runs reliable in this mode.

	The problem is, that shared collections may now be easily modified by other

	processes, running at the same time. 

	The class library is currently being investigated for such possible trouble spots 

	(we have already eliminated many weak spots, and added critical regions at many places,

	 but cannot guarantee that all of them have been found so far ...)

    We think, that the timeSlicer is a useful add-on and that the system is fit enough

    for it to be evaluated, therefore, its included. 

    However, use it at your own risk.

"

! !

!ProcessorScheduler class methodsFor:'initialization'!

initialize

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

     setup some priority values."

    TimeSliceInterval := 50.

    UserSchedulingPriority := 8.

    UserInterruptPriority := 24.

    TimingPriority := 16.

    TimeSlicingPriorityLimit := 26.

    HighestPriority := 30.

    SchedulingPriority := 31.

    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.

                    ' (no longer refd)' errorPrintCR.

                    self threadDestroy:id.

                    KnownProcessIds at:index put:nil.

                ].

                KnownProcesses at:index put:nil.

            ]

        ]

    ]

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

    "Modified: 10.1.1997 / 19:10:48 / cg"

! !

!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