"

 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

                                zombie

                                activeProcess currentPriority

                                readFds readSemaphores readChecks

                                writeFds writeSemaphores writeChecks

                                timeouts timeoutActions timeoutSemaphores

         classVariableNames:'KnownProcesses KnownProcessIds

                             PureEventDriven

                             UserSchedulingPriority TimingPriority'

         poolDictionaries:''

         category:'Kernel-Processes'

!

ProcessorScheduler comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

             All Rights Reserved

'!

Smalltalk at:#Processor put:nil!

!ProcessorScheduler class methodsFor:'initialization'!

initialize

    KnownProcesses isNil ifTrue:[

        KnownProcesses := WeakArray new:5.

        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"

        Processor := self new.

    ].

    PureEventDriven := self threadsAvailable not.

    PureEventDriven ifTrue:[

        'no process support - running event driven' printNewline

    ].

    UserSchedulingPriority := 8.

    TimingPriority := 16.

!

update:something

    something == #returnFromSnapshot ifTrue:[

        self reinstallProcesses

    ]

!

reinstallProcesses

    "recreate all processes after a snapShot load"

    KnownProcesses do:[:p |

        p notNil ifTrue:[

            "how, exactly should this be done ?"

            p id ~~ 0 ifTrue:[

                Transcript showCr:'process restart not implemented'

            ]

        ]

    ]

! !

!ProcessorScheduler class methodsFor:'instance creation'!

new

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

    Processor isNil ifTrue:[

        Processor := self basicNew initialize

    ].

    ^ Processor.

! !

!ProcessorScheduler class methodsFor:'instance release'!

informDispose

    "some Process has been collected - terminate the underlying thread"

    |id sz "{ Class: SmallInteger }"|

    sz := KnownProcessIds size.

    1 to:sz do:[:index |

        (KnownProcesses at:index) isNil ifTrue:[

            id := KnownProcessIds at:index.

            id notNil ifTrue:[

                Transcript showCr:('terminate thread (no longer refd) ', id printString).

                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

! !

!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 with:aBlock

    "make the process evaluate aBlock when it awakes the next time"

%{  /* NOCONTEXT */

    if (_isSmallInteger(id) && _isBlock(aBlock)) {

        __threadInterrupt(_intVal(id), aBlock);

    }

%}

!

threadCreate:aBlock

    "physical creation of a process executing aBlock.

     (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 */);

    if (tid != 0) {

        RETURN ( _MKSMALLINT(tid));

    }

%}

.

    ^ nil

!

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|

    aProcess isNil ifTrue:[^ self].

    aProcess == activeProcess ifTrue:[^ self].

    id := aProcess id.

    pri := aProcess priority.

    aProcess state:#active.

    "no interrupts now - activeProcess has already been changed

     (dont add any message sends here)"

    activeProcess := aProcess.

    currentPriority := pri.

%{

    __threadSwitch(__context, _intVal(id));

%}

.

    "time passes ...

     ... here again"

    zombie notNil ifTrue:[

        self class threadDestroy:zombie.

        zombie := nil

    ]

!

scheduleForInterrupt:aProcess

    "make aProcess evaluate its pushedInterrupt block(s)"

    |id pri|

    aProcess isNil ifTrue:[^ self].

    aProcess == activeProcess ifTrue:[^ self].

    id := aProcess id.

    self class threadInterrupt:id with:[aProcess interrupt].

    "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 processes can have"

    "must be below schedulingPriority - otherwise scheduler

     could be blocked ..."

    ^ 30  

!

schedulingPriority

    "return the priority at which the scheduler runs"

    "must be above highestPriority - otherwise scheduler

     could be blocked ..."

    ^ 31

!

userInterruptPriority

    "not currently used - for ST80 compatibility only"

    ^ 24

!

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

    "not currently used - for ST80 compatibility only"

    ^ 6

!

systemBackgroundPriority

    "not currently used - for ST80 compatibility only"

    ^ 4

! !

!ProcessorScheduler methodsFor:'private initializing'!

initialize

    "initialize the one-and-only ProcessorScheduler"

    |nPrios l|

    nPrios := self schedulingPriority.

    quiescentProcessLists := Array new:nPrios.

    readFds := Array with:nil.

    readChecks := Array with:nil.

    readSemaphores := Array with:nil.

    writeFds := Array with:nil.

    writeChecks := Array with:nil.

    writeSemaphores := Array with:nil.

    timeouts := Array with:nil.

    timeoutSemaphores := Array with:nil.

    timeoutActions := Array with:nil.

    dispatching := false.

    "handcraft the first (dispatcher-) process - this one will never

     block, but go into a select if there is nothing to do.

     Also it has a prio of max+1"

    activeProcess := Process new.

    activeProcess setId:0.

    activeProcess name:'scheduler'.

    activeProcess state:#run.

    currentPriority := self schedulingPriority.

    activeProcess setPriority:currentPriority.

    l := LinkedList new.

    l add:activeProcess.

    quiescentProcessLists at:currentPriority put:l.

    ObjectMemory ioInterruptHandler:self.

    ObjectMemory timerInterruptHandler:self.

!

reInitialize

    "all previous stuff is obsolete - each object should reinstall itself

     upon restart."

    |l|

    KnownProcesses := WeakArray new:5.

    KnownProcesses watcher:self class.

    KnownProcessIds := OrderedCollection new.

    "for now (cannot snapin processes)"

    quiescentProcessLists := Array new:self schedulingPriority.

    readFds := Array with:nil.

    readChecks := Array with:nil.

    readSemaphores := Array with:nil.

    writeFds := Array with:nil.

    writeChecks := Array with:nil.

    writeSemaphores := Array with:nil.

    dispatching := false.

    "handcraft the first (dispatcher-) process - this one will never

     block, but go into a select if there is nothing to do.

     Also it has a prio of max+1"

    activeProcess := Process new.

    activeProcess setId:0.

    activeProcess name:'scheduler'.

    activeProcess state:#run.

    currentPriority := self schedulingPriority.

    activeProcess setPriority:currentPriority.

    l := LinkedList new.

    l add:activeProcess.

    quiescentProcessLists at:currentPriority put:l.

    ObjectMemory ioInterruptHandler:self.

    ObjectMemory timerInterruptHandler:self.

! !

!ProcessorScheduler methodsFor:'private'!

remember:aProcess

    |newShadow oldSize oldId

     index "{ Class: SmallInteger }"

     sz    "{ Class: SmallInteger }" |

    index := 1.

    sz := KnownProcessIds size.

    [index <= sz] whileTrue:[

        (KnownProcesses at:index) isNil ifTrue:[

            oldId := KnownProcessIds at:index.

            oldId notNil ifTrue:[

                self class threadDestroy:oldId.

            ].

            KnownProcesses at:index put:aProcess.

            KnownProcessIds at:index put:aProcess id.

            ^ self

        ].

        index := index + 1

    ].

    KnownProcessIds grow:index.

    KnownProcessIds at:index put:aProcess id.

    oldSize := KnownProcesses size.

    (index > oldSize) ifTrue:[

        newShadow := WeakArray new:(oldSize * 2).

        newShadow watcher:self class.

        newShadow replaceFrom:1 with:KnownProcesses.

        KnownProcesses := newShadow

    ].

    KnownProcesses at:index put:aProcess 

!

unRemember:aProcess

    |index|

    index := KnownProcesses identityIndexOf:aProcess.

    index ~~ 0 ifTrue:[

        KnownProcessIds at:index put:nil.

        KnownProcesses at:index put:nil.

    ]

! !

!ProcessorScheduler methodsFor:'process creation'!

newProcessFor:aBlock

    "create a new process executing aBlock. 

     Return a process (or nil if fail). The new process is not scheduled. 

     To start it running, it needs a Process>>resume."

    |id p|

    id := self class threadCreate:aBlock.

    id isNil ifTrue:[

        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.

    self remember:p.

    ^ p

! !

!ProcessorScheduler methodsFor:'scheduling'!

reschedule

    "switch to the highest prio runnable process

     The scheduler itself is always runnable, so there is always a switch."

    |l p|

    (self schedulingPriority) 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"

    self halt

!

yield

    "move the currently running process to the end of the currentList

     and reschedule to the first in the list, thus switching to the 

     next same-prio-process."

    |l|

    l := quiescentProcessLists at:currentPriority.

    l isNil ifTrue:[

        'oops - nil runnable list' printNewline.

        ^ self

    ].

    l removeFirst.

    l isEmpty ifTrue:[

        l addLast:activeProcess.

        ^ self

    ].

    l addLast:activeProcess.

    activeProcess state:#run.

    self threadSwitch:(l first).