"

 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:'runnable zombie

                                currentProcess currentPriority

                                fileDescriptors fileHandlers fileSelectors

                                timeoutTimes timeHandlers timeSelectors'

         classVariableNames:'KnownProcesses KnownProcessIds'

         poolDictionaries:''

         category:'Kernel-Processes'

!

ProcessorScheduler comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

             All Rights Reserved

%W% %E%

'!

Smalltalk at:#Processor put:nil!

!ProcessorScheduler class methodsFor:'initialization'!

initialize

    KnownProcesses isNil ifTrue:[

        KnownProcesses := ShadowArray new:5.

        KnownProcesses watcher:self.

        KnownProcessIds := OrderedCollection new.

        "want to get informed when returning from snapshot"

        ObjectMemory addDependent:self

    ].

    "create the one and only processor"

    Processor := self new

!

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 in preparation'

            ]

        ]

    ]

! !

!ProcessorScheduler class methodsFor:'private process primitives'!

threadCreate:aBlock

    "physical creation of a process executing aBlock.

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

%{

    int tid;

    extern int __threadCreate();

    tid = __threadCreate(aBlock);

    if (tid != 0) {

        RETURN ( _MKSMALLINT(tid));

    }

    RETURN (nil);

%}

!

threadDestroy:id

    "physical destroy other process ...

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

%{

    if (_isSmallInteger(id)) {

        __threadDestroy(_intVal(id));

    }

%}

.

    self primitiveFailed

! !

!ProcessorScheduler class methodsFor:'instance release'!

informDispose

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

    |id

     index "<SmallInteger>"

     sz    "<SmallInteger>"|

    index := 1.

    sz := KnownProcessIds size.

    [index <= sz] whileTrue:[

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

            ]

        ].

        index := index + 1

    ]

! !

!ProcessorScheduler class methodsFor:'instance creation'!

new

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

    Processor notNil ifTrue:[^ Processor].

    ^ self basicNew initialize.

! !

!ProcessorScheduler methodsFor:'constants'!

minPriority

    ^ 1

!

maxPriority

    ^ 31

!

userInterruptPriority

    ^ 24

!

timingPriority

    ^ 16

!

userSchedulingPriority

    ^ 8

!

userBackgroundPriority

    ^ 6

!

systemBackgroundPriority

    ^ 4

! !

!ProcessorScheduler methodsFor:'private initializing'!

initialize

    "initialize the one-and-only ProcessorScheduler"

    |nPrios l|

    nPrios := self maxPriority - self minPriority + 1.

    runnable := Array new:nPrios.

    "setup the first (init-) process"

    currentProcess := Process new.

    currentProcess id:0.

    currentProcess state:#running.

    currentPriority := self userSchedulingPriority.

    currentProcess setPriority:currentPriority.

    l := LinkedList new.

    l add:currentProcess.

    runnable at:currentPriority put:l.

    IOInterruptHandler := self.

    OperatingSystem enableIOInterrupts.

! !

!ProcessorScheduler methodsFor:'private'!

remember:aProcess

    |newShadow newSize oldSize oldId

     index "<SmallInteger>"

     sz    "<SmallInteger>" |

    index := 1.

    sz := KnownProcessIds size.

    [index <= sz] whileTrue:[

        (KnownProcesses at:index) isNil ifTrue:[

            oldId := KnownIds at:index.

            oldId notNil ifTrue:[

                self class terminateProcess: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 := ShadowArray new:(oldSize * 2).

        newShadow watcher:(KnownProcesses watcher).

        newShadow replaceFrom:1 with:KnownProcesses.

        KnownProcesses := newShadow

    ].

    KnownProcesses at:index put:aProcess 

! !

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

        p := Process new.

        p id:id.

        p startBlock:aBlock.

        p state:#suspended.

        p setPriority:currentPriority.

        self remember:p.

    ].

    ^ p

! !

!ProcessorScheduler methodsFor:'scheduling'!

switchTo:aProcess

    "continue execution in aProcess."

    |id pri|

    aProcess isNil ifTrue:[^ self].

    aProcess == currentProcess ifTrue:[^ self].

    id := aProcess id.

    pri := aProcess priority.

    currentProcess state:#runnable.

    "no interrupts now ..."

    currentProcess := aProcess.

    currentProcess state:#running.

    currentPriority := pri.

%{

    __threadSwitch(__context, _intVal(id));

%}

.

    zombie notNil ifTrue:[

        self class threadDestroy:zombie.

        zombie := nil

    ]

!

reschedule

    "switch to the highest prio runnable process"

    |l|

    self maxPriority to:self minPriority by:-1 do:[:prio |

        l := runnable at:prio.

        l notNil ifTrue:[

            ^ self switchTo:(l first)

        ]

    ].

    "no process to run - wait to next time event"

    'wait' printNewline.

    self waitForNextTimeout

!

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 := runnable at:currentPriority.

    l isNil ifTrue:[

        'oops - nil runnable list' printNewline.

        ^ self

    ].

    l removeFirst.

    l addLast:currentProcess.

    self reschedule

!

suspend:aProcess

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

     and put it to the list of suspended ones. If the process is the 

     currentProcess, reschedule."

    |pri l|

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

    pri := aProcess priority.

    l := runnable at:pri.

    l isNil ifTrue:[self error:'bad suspend'. ^ self].

    aProcess state:#suspended.

    l remove:aProcess ifAbsent:[self error:'bad suspend'. ^ self].

    (aProcess == currentProcess) ifTrue:[

        self reschedule

    ]

!

resume:aProcess

    "set aProcess runnable - if its prio is higher than the currently running prio,

     reschedule."

    |l pri|

    aProcess == currentProcess ifTrue:[^ self].

    aProcess isNil ifTrue:[^ self].

    pri := aProcess priority.

    aProcess state:#runnable.

    l := runnable at:pri.

    l isNil ifTrue:[

        l := LinkedList new.

        runnable at:pri put:l

    ].

    l addLast:aProcess.

    (pri > currentPriority) ifTrue:[

        self reschedule

    ]

!

processTermination

    "current process finished its startup block without termination,

     lay him to rest now"

    self terminate:currentProcess

!

terminate:aProcess

    "terminate aProcess. If its not the current process, its simply

     removed from its list and destroyed. Otherwise, a switch is forced

     and the process is destroyed by the next running process."

    |pri id l|

    aProcess isNil ifTrue:[^ self].

    id := aProcess id.

    id isNil ifTrue:[^ self].   "already dead"

    pri := aProcess priority.

    "easy, if currently suspended"

    ((aProcess state ~~ #runnable) and:[aProcess state ~~ #running]) ifTrue:[

         aProcess id:nil.

         aProcess state:#dead.

         aProcess startBlock:nil.

         self class threadDestroy:id.

         ^ self

    ].

    (aProcess state ~~ #runnable) ifTrue:[

        l := runnable at:pri.

        (l notNil and:[l includes:aProcess]) ifTrue:[

            l remove:aProcess.

            aProcess state:#dead.

            l isEmpty ifTrue:[runnable at:pri put:nil].

            aProcess == currentProcess ifFalse:[

                self class threadDestroy:id.

            ]

        ].

        ^ self

    ].

    (aProcess state ~~ #running) ifTrue:[

        "hard case - its the currently running process

         we must have the next active process destroy this one

        "

        aProcess state:#dead.

        zombie := id.

        self reschedule

    ]

!

changePriority:newPrio for:aProcess

    "change the priority of aProcess"

    |oldList newList oldPrio s|

    oldPrio := aProcess priority.

    oldPrio == newPrio ifTrue:[^ self].

    aProcess setPriority:newPrio.

    s := aProcess state.

    s == #runnable ifTrue:[

        oldList := runnable at:oldPrio.

        (oldList includes:aProcess) ifTrue:[

            oldList remove:aProcess

        ].

        newList := runnable at:newPrio.

        newList isNil ifTrue:[

            newList := LinkedList new.

            runnable at:newPrio put:newList

        ].

        newList addLast:aProcess.

        (aProcess ~~ currentProcess and:[newPrio > currentPriority]) ifTrue:[

            self reschedule.

        ].

        ^ self

    ]

! !

!ProcessorScheduler class methodsFor:'testing'!

test1

    |scheduler|

    scheduler := ProcessorScheduler new.

    scheduler addFileDescriptor:(Stdin fileDescriptor) withHandler:self selector:#inputAvailable.

    scheduler addFileDescriptor:(Display displayFileDescriptor) withHandler:self selector:#xInputAvailable.

    scheduler loop

    "ProcessorScheduler test1"

!

inputAvailable

    Transcript showCr:(Stdin nextLine)

!

xInputAvailable

    Transcript showCr:'x event'.

    Display dispatchEvent

! !

!ProcessorScheduler methodsFor:'scheduling'!

loop

    |looping nextTime waitTime fd index|

    looping := true.

    [looping] whileTrue:[

        "look if any timeouts are due to be evaluated"

        nextTime := nil.

        timeoutTimes notNil ifTrue:[

            nextTime := self evaluateTimeouts

        ].

        nextTime notNil ifTrue:[

            waitTime := OperatingSystem millisecondTimeDeltaBetween:nextTime

                                                                and:OperatingSystem getMillisecondTime

        ] ifFalse:[

            waitTime := nil

        ].

        (fileDescriptors size == 0) ifTrue:[

            waitTime isNil ifTrue:[

                Transcript showCr:'nothing to schedule'.

                ^ self

            ].

            "no fd to wait for - hard wait till next timeout has to come"

            OperatingSystem millisecondDelay:waitTime

        ] ifFalse:[

            "wait for any fd to become ready or next timeout has to come"

            waitTime isNil ifTrue:[waitTime := 10000].

            fd := OperatingSystem selectOnAnyReadable:fileDescriptors withTimeOut:(waitTime / 1000).

            fd isNil ifTrue:[

                "an interrupt or timeout occured"

                Transcript showCr:'interrupt or timeout'

            ] ifFalse:[

                "notify the handler"

                index := fileDescriptors identityIndexOf:fd.

                (fileHandlers at:index) perform:(fileSelectors at:index)

            ]

        ]

    ]

!

evaluateTimeouts

    "evaluate all timeouts that need to be .. and return the time of the

     next pending timeout"

    |now thisTime index endIndex handler selector nextTime|

    nextTime := nil.

    endIndex := timeoutTimes size.

    (endIndex ~~ 0) ifTrue:[

        now := OperatingSystem getMillisecondTime.

        index := 1.

        [index <= endIndex] whileTrue:[

            thisTime := timeoutTimes at:index.

            (OperatingSystem millisecondTime:thisTime isAfter:now) ifFalse:[

                handler := timeHandlers at:index.

                selector := timeSelectors at:index.

                timeoutTimes at:index put:nil.

                timeHandlers at:index put:nil.

                timeSelectors at:index put:nil.

                handler perform:selector

            ] ifTrue:[

                nextTime isNil ifTrue:[

                    nextTime := thisTime

                ] ifFalse:[

                    (OperatingSystem millisecondTime:nextTime isAfter:thisTime) ifTrue:[

                        nextTime := thisTime

                    ]

                ]

            ].

            index := index + 1

        ]