"

 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

                                currentProcess currentPriority

                                readFds readSemaphores readChecks

                                writeFds writeSemaphores writeChecks

                                timeouts timeoutActions timeoutSemaphores

                                idleActions nTimeouts dispatching'

         classVariableNames:'KnownProcesses KnownProcessIds DefaultStackSize

                             PureEventDriven

         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.

    ].

    DefaultStackSize := 100*1024.

    UserSchedulingPriority := 8.

!

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.

    "

    ^ PureEventDriven

!

pureEventDriven

    PureEventDriven := true

!

processDriven

    PureEventDriven := false

! !

!ProcessorScheduler class methodsFor:'primitive process primitives'!

threadCreate:aBlock stack:stackSize

    "physical creation of a process executing aBlock.

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

     This may return nil, if process could not be created."

    int tid;

    extern int __threadCreate();

    if (_isSmallInteger(stackSize)) {

        tid = __threadCreate(aBlock, _intVal(stackSize));

        if (tid != 0) {

            RETURN ( _MKSMALLINT(tid));

        }

    }

%}

!

threadDestroy:id

    "physical destroy other process ...

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

    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 == currentProcess ifTrue:[^ self].

    id := aProcess id.

    pri := aProcess priority.

    "no interrupts now - currentProcess has already been changed

     (dont add any message sends here)"

    currentProcess := aProcess.

    currentPriority := pri.

%{

    __threadSwitch(__context, _intVal(id));

%}

.

    "time passes ...

     ... here again"

    zombie notNil ifTrue:[

        self class threadDestroy:zombie.

        zombie := nil

    ]

! !

!ProcessorScheduler methodsFor:'constants'!

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

!

!

schedulingPriority

    "return the priority at which the scheduler runs"

    ^ 31

!

userInterruptPriority

    ^ 24

!

timingPriority

!

userSchedulingPriority

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

     takes place"

    ^ UserSchedulingPriority

!

userBackgroundPriority

    ^ 6

!

systemBackgroundPriority

    ^ 4

! !

!ProcessorScheduler methodsFor:'private initializing'!

initialize

    "initialize the one-and-only ProcessorScheduler"

    |nPrios l|

    nPrios := 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.

    timeouts := Array with:nil.

    timeoutSemaphores := Array with:nil.

    timeoutActions := Array with:nil.

    nTimeouts := 0.

    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"

    currentProcess := Process new.

    currentPriority := self schedulingPriority.

    currentProcess setPriority:currentPriority.

    l := LinkedList new.

    l add:currentProcess.

    ObjectMemory ioInterruptHandler:self.

    ObjectMemory timerInterruptHandler:self.

!

reInitialize

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

     upon restart."

    |l|

    KnownProcesses := WeakArray new:5.

    KnownProcessIds := OrderedCollection new.

    "for now (cannot snapin processes)"

    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"

    currentProcess := Process new.

    currentPriority := self schedulingPriority.

    currentProcess setPriority:currentPriority.

    l := LinkedList new.

    l add:currentProcess.

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

    ^ self newProcessFor:aBlock stack:DefaultStackSize

!

newProcessFor:aBlock stack:stackSize

    "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 stack:stackSize.

    ].

    ^ 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 notNil ifTrue:[

            p := l first.

            p notNil ifTrue:[

                ^ self threadSwitch:p

            ].

        ]

    ].

    "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 isNil ifTrue:[

        'oops - nil runnable list' printNewline.

        ^ self

    ].

    l removeFirst.

    l addLast:currentProcess.

    self threadSwitch:(l first).

!

suspend:aProcess

    "remove the argument, aProcess from the list of runnable processes.

     If the process is the current one, reschedule."

    aProcess isNil ifTrue:[self error:'nil suspend'. ^ self].

    pri := aProcess priority.