"

 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.

"

"{ Package: 'stx:libbasic' }"

Object subclass:#ProcessorScheduler

	instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess

		activeProcessId currentPriority readFdArray readSemaphoreArray

		readCheckArray writeFdArray writeSemaphoreArray writeCheckArray

		timeoutArray timeoutActionArray timeoutProcessArray

		timeoutSemaphoreArray idleActions anyTimeouts dispatching

		interruptedProcess useIOInterrupts gotIOInterrupt

		osChildExitActions gotChildSignalInterrupt

		exitWhenNoMoreUserProcesses suspendScheduler timeSliceProcess

		supportDynamicPriorities timeSliceNeededSemaphore

		scheduledProcesses preWaitActions timeoutHandlerProcess'

	classVariableNames:'KnownProcesses KnownProcessIds PureEventDriven

		UserSchedulingPriority UserInterruptPriority TimingPriority

		HighestPriority SchedulingPriority MaxNumberOfProcesses

		InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval

		EventPollingInterval'

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

    [instance variables:]

	quiescentProcessLists           - list of waiting processes

	scheduler                       - the scheduler process itself

	zombie                          - internal temporary (recently died process)

	activeProcess                   - the current process

	activeProcessId                 - the current processes id

	currentPriority                 - the current processes priority

	readFdArray                     - fd-sema-checkBlock triple-association

	readSemaphoreArray                (stupid historic 3-separate arrays for hi-speed-optimization reasons)

	readCheckArray

	writeFdArray                    - fd-sema-checkBlock triple-association

	writeSemaphoreArray               (stupid historic 3-separate arrays for hi-speed-optimization reasons)

	writeCheckArray

	timeoutArray                    - time-action-process-sema quadruple-association

	timeoutActionArray                (stupid historic 3-separate arrays for hi-speed-optimization reasons)

	timeoutProcessArray

	timeoutSemaphoreArray

	idleActions                     - actions to be executed when idle

	preWaitActions                  - actions to be executed BEFORE going into an OS-wait

	anyTimeouts                     - flag if any timeouts are pending

	dispatching                     - flag if dispatch process is running (i.e. NOT initializing)

	interruptedProcess              - the currently interrupted process.

	useIOInterrupts                 - flag if the OS supports I/O interrupts and if they are used (to get me out of an OS wait)

	gotIOInterrupt                  - flag if I came out of a wait due to an I/O interrupt

	osChildExitActions              - OS chid process actions

	gotChildSignalInterrupt         - flag if I came out of a wait due to an OS child interrupt

	exitWhenNoMoreUserProcesses     - flag which controls if ST/X should exit when the last process dies (for standalone apps)

	suspendScheduler                - internal use

	timeSliceProcess                - the timeSlicer process

	supportDynamicPriorities        - flag if dynamic priorities should be supported by the timeSlicer

	scheduledProcesses              - list of scheduled processes for the timeSlicers dynamic prio handling

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

	EventPollingInterval                    for systems which do not support select on

						a fileDescriptor: the polling interval in millis.

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

    A higher prio process may become runnable either by a programmatic action

    (i.e. signalling a semaphore), by a timer or by IO availability.

    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 which is 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 has being investigated for such possible trouble spots

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

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

	We found that many existing public domain programs are not prepared for

	being interrupted by a same-prio process and therefore may corrupt their

	data. If in doubt, disable this fefature.

    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.

    To demonstrate the effect of timeSlicing, do the following:

	- disable timeSlicing (in the launchers misc-settings menu)

	- open a workSpace

	- in the workspace, evaluate:

		[true] whileTrue:[1000 factorial]

    now, (since the workSpace runs at the same prio as other window-processes),

    other views do no longer react - all CPU is used up by the workSpace.

    However, CTRL-C in the workspace is still possible to stop the endless loop,

    since that is handled by the (higher prio) event dispatcher process.

    Now, stop the factorial-loop, enable timeSlicing, and try again.

    You will notice, that other windows react - although possibly a bit slower,

    since the CPU is now divided equally among the runnable processes (timeSliced).

"

! !

!ProcessorScheduler class methodsFor:'initialization'!

initialize

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

     setup some priority values."

    TimeSliceInterval := 50.

    EventPollingInterval := 20.

    UserSchedulingPriority := 8.

    UserInterruptPriority := 24.

    TimingPriority := 16.

    TimeSlicingPriorityLimit := 26.

    HighestPriority := 30.

    SchedulingPriority := 31.

    InvalidProcessSignal isNil ifTrue:[

	InvalidProcessSignal := Error 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 ( __mkSmallInteger(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());

%}.

    ^ true

! !

!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

    "obsolete event support: disable block events on aFileDescriptor.

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

    |idx "{Class: SmallInteger }"

     wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    useIOInterrupts ifTrue:[

	OperatingSystem disableIOInterruptsOn:aFileDescriptor

    ].

    idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.

    idx ~~ 0 ifTrue:[

	readFdArray at:idx put:nil.

	readCheckArray at:idx put:nil.

	readSemaphoreArray at:idx put:nil

    ].

    idx := writeFdArray identityIndexOf:aFileDescriptor startingAt:1.

    idx ~~ 0 ifTrue:[