1 "

     2  COPYRIGHT (c) 1993 by Claus Gittinger

     3               All Rights Reserved

     4 

     5  This software is furnished under a license and may be used

     6  only in accordance with the terms of that license and with the

     7  inclusion of the above copyright notice.   This software may not

     8  be provided or otherwise made available to, or used by, any

     9  other person.  No title to or ownership of the software is

    10  hereby transferred.

    11 "

    12 

    13 Object subclass:#ProcessorScheduler

    14          instanceVariableNames:'runnable zombie

    15                                 currentProcess currentPriority

    16                                 fileDescriptors fileHandlers fileSelectors

    17                                 timeoutTimes timeHandlers timeSelectors'

    18          classVariableNames:'KnownProcesses KnownProcessIds'

    19          poolDictionaries:''

    20          category:'Kernel-Processes'

    21 !

    22 

    23 ProcessorScheduler comment:'

    24 

    25 COPYRIGHT (c) 1993 by Claus Gittinger

    26              All Rights Reserved

    27 

    28 %W% %E%

    29 '!

    30 

    31 Smalltalk at:#Processor put:nil!

    32 

    33 !ProcessorScheduler class methodsFor:'initialization'!

    34 

    35 initialize

    36     KnownProcesses isNil ifTrue:[

    37         KnownProcesses := ShadowArray new:5.

    38         KnownProcesses watcher:self.

    39         KnownProcessIds := OrderedCollection new.

    40 

    41         "want to get informed when returning from snapshot"

    42         ObjectMemory addDependent:self

    43     ].

    44 

    45     "create the one and only processor"

    46 

    47     Processor := self new

    48 !

    49 

    50 update:something

    51     something == #returnFromSnapshot ifTrue:[

    52         self reinstallProcesses

    53     ]

    54 !

    55 

    56 reinstallProcesses

    57     "recreate all processes after a snapShot load"

    58 

    59    KnownProcesses do:[:p |

    60         p notNil ifTrue:[

    61             "how, exactly should this be done ?"

    62 

    63             p id ~~ 0 ifTrue:[

    64                 Transcript showCr:'process restart in preparation'

    65             ]

    66         ]

    67     ]

    68 ! !

    69 

    70 !ProcessorScheduler class methodsFor:'private process primitives'!

    71 

    72 threadCreate:aBlock

    73     "physical creation of a process executing aBlock.

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

    75 %{

    76     int tid;

    77     extern int __threadCreate();

    78 

    79     tid = __threadCreate(aBlock);

    80     if (tid != 0) {

    81         RETURN ( _MKSMALLINT(tid));

    82     }

    83     RETURN (nil);

    84 %}

    85 !

    86 

    87 threadDestroy:id

    88     "physical destroy other process ...

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

    90 

    91 %{

    92     if (_isSmallInteger(id)) {

    93         __threadDestroy(_intVal(id));

    94     }

    95 %}

    96 .

    97     self primitiveFailed

    98 ! !

    99 

   100 !ProcessorScheduler class methodsFor:'instance release'!

   101 

   102 informDispose

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

   104 

   105     |id

   106      index "<SmallInteger>"

   107      sz    "<SmallInteger>"|

   108 

   109     index := 1.

   110     sz := KnownProcessIds size.

   111     [index <= sz] whileTrue:[

   112         (KnownProcesses at:index) isNil ifTrue:[

   113             id := KnownProcessIds at:index.

   114             id notNil ifTrue:[

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

   116                 self threadDestroy:id.

   117                 KnownProcessIds at:index put:nil.

   118             ]

   119         ].

   120         index := index + 1

   121     ]

   122 ! !

   123 

   124 !ProcessorScheduler class methodsFor:'instance creation'!

   125 

   126 new

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

   128 

   129     Processor notNil ifTrue:[^ Processor].

   130     ^ self basicNew initialize.

   131 ! !

   132 

   133 !ProcessorScheduler methodsFor:'constants'!

   134 

   135 minPriority

   136     ^ 1

   137 !

   138 

   139 maxPriority

   140     ^ 31

   141 !

   142 

   143 userInterruptPriority

   144     ^ 24

   145 !

   146 

   147 timingPriority

   148     ^ 16

   149 !

   150 

   151 userSchedulingPriority

   152     ^ 8

   153 !

   154 

   155 userBackgroundPriority

   156     ^ 6

   157 !

   158 

   159 systemBackgroundPriority

   160     ^ 4

   161 ! !

   162 

   163 !ProcessorScheduler methodsFor:'private initializing'!

   164 

   165 initialize

   166     "initialize the one-and-only ProcessorScheduler"

   167 

   168     |nPrios l|

   169 

   170     nPrios := self maxPriority - self minPriority + 1.

   171 

   172     runnable := Array new:nPrios.

   173 

   174     "setup the first (init-) process"

   175     currentProcess := Process new.

   176     currentProcess id:0.

   177     currentProcess state:#running.

   178     currentPriority := self userSchedulingPriority.

   179     currentProcess setPriority:currentPriority.

   180 

   181     l := LinkedList new.

   182     l add:currentProcess.

   183 

   184     runnable at:currentPriority put:l.

   185 

   186     IOInterruptHandler := self.

   187     OperatingSystem enableIOInterrupts.

   188 ! !

   189 

   190 !ProcessorScheduler methodsFor:'private'!

   191 

   192 remember:aProcess

   193     |newShadow newSize oldSize oldId

   194      index "<SmallInteger>"

   195      sz    "<SmallInteger>" |

   196 

   197     index := 1.

   198     sz := KnownProcessIds size.

   199     [index <= sz] whileTrue:[

   200         (KnownProcesses at:index) isNil ifTrue:[

   201             oldId := KnownIds at:index.

   202             oldId notNil ifTrue:[

   203                 self class terminateProcess:oldId

   204             ].

   205             KnownProcesses at:index put:aProcess.

   206             KnownProcessIds at:index put:aProcess id.

   207             ^ self

   208         ].

   209         index := index + 1

   210     ].

   211 

   212     KnownProcessIds grow:index.

   213     KnownProcessIds at:index put:aProcess id.

   214 

   215     oldSize := KnownProcesses size.

   216     (index > oldSize) ifTrue:[

   217         newShadow := ShadowArray new:(oldSize * 2).

   218         newShadow watcher:(KnownProcesses watcher).

   219         newShadow replaceFrom:1 with:KnownProcesses.

   220         KnownProcesses := newShadow

   221     ].

   222     KnownProcesses at:index put:aProcess 

   223 ! !

   224 

   225 !ProcessorScheduler methodsFor:'process creation'!

   226 

   227 newProcessFor:aBlock

   228     "create a new process executing aBlock. Return a process (or

   229      nil if fail). The new process is not scheduled. To start it 

   230      running, it needs a Process>>resume."

   231 

   232     |id p|

   233 

   234     id := self class threadCreate:aBlock.

   235     id notNil ifTrue:[

   236         p := Process new.

   237         p id:id.

   238         p startBlock:aBlock.

   239         p state:#suspended.

   240         p setPriority:currentPriority.

   241         self remember:p.

   242     ].

   243     ^ p

   244 ! !

   245 

   246 !ProcessorScheduler methodsFor:'scheduling'!

   247 

   248 switchTo:aProcess

   249     "continue execution in aProcess."

   250 

   251     |id pri|

   252 

   253     aProcess isNil ifTrue:[^ self].

   254     aProcess == currentProcess ifTrue:[^ self].

   255 

   256     id := aProcess id.

   257     pri := aProcess priority.

   258     currentProcess state:#runnable.

   259 

   260     "no interrupts now ..."

   261     currentProcess := aProcess.

   262     currentProcess state:#running.

   263     currentPriority := pri.

   264 %{

   265     __threadSwitch(__context, _intVal(id));

   266 %}

   267 .

   268     zombie notNil ifTrue:[

   269         self class threadDestroy:zombie.

   270         zombie := nil

   271     ]

   272 !

   273 

   274 reschedule

   275     "switch to the highest prio runnable process"

   276 

   277     |l|

   278 

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

   280         l := runnable at:prio.

   281         l notNil ifTrue:[

   282             ^ self switchTo:(l first)

   283         ]

   284     ].

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

   286 

   287     'wait' printNewline.

   288     self waitForNextTimeout

   289 !

   290 

   291 yield

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

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

   294      next same-prio-process."

   295 

   296     |l|

   297 

   298     l := runnable at:currentPriority.

   299     l isNil ifTrue:[

   300         'oops - nil runnable list' printNewline.

   301         ^ self

   302     ].

   303     l removeFirst.

   304     l addLast:currentProcess.

   305     self reschedule

   306 !

   307 

   308 suspend:aProcess

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

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

   311      currentProcess, reschedule."

   312 

   313     |pri l|

   314 

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

   316     pri := aProcess priority.

   317 

   318     l := runnable at:pri.

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

   320 

   321     aProcess state:#suspended.

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

   323 

   324     (aProcess == currentProcess) ifTrue:[

   325         self reschedule

   326     ]

   327 !

   328 

   329 resume:aProcess

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

   331      reschedule."

   332 

   333     |l pri|

   334 

   335     aProcess == currentProcess ifTrue:[^ self].

   336     aProcess isNil ifTrue:[^ self].

   337     pri := aProcess priority.

   338 

   339     aProcess state:#runnable.

   340     l := runnable at:pri.

   341     l isNil ifTrue:[

   342         l := LinkedList new.

   343         runnable at:pri put:l

   344     ].

   345     l addLast:aProcess.

   346 

   347     (pri > currentPriority) ifTrue:[

   348         self reschedule

   349     ]

   350 !

   351 

   352 processTermination

   353     "current process finished its startup block without termination,

   354      lay him to rest now"

   355 

   356     self terminate:currentProcess

   357 !

   358 

   359 terminate:aProcess

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

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

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

   363 

   364     |pri id l|

   365 

   366     aProcess isNil ifTrue:[^ self].

   367     id := aProcess id.

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

   369 

   370     pri := aProcess priority.

   371 

   372     "easy, if currently suspended"

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

   374          aProcess id:nil.

   375          aProcess state:#dead.

   376          aProcess startBlock:nil.

   377          self class threadDestroy:id.

   378          ^ self

   379     ].

   380 

   381     (aProcess state ~~ #runnable) ifTrue:[

   382         l := runnable at:pri.

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

   384             l remove:aProcess.

   385             aProcess state:#dead.

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

   387             aProcess == currentProcess ifFalse:[

   388                 self class threadDestroy:id.

   389             ]

   390         ].

   391         ^ self

   392     ].

   393 

   394     (aProcess state ~~ #running) ifTrue:[

   395         "hard case - its the currently running process

   396          we must have the next active process destroy this one

   397         "

   398         aProcess state:#dead.

   399         zombie := id.

   400         self reschedule

   401     ]

   402 !

   403 

   404 changePriority:newPrio for:aProcess

   405     "change the priority of aProcess"

   406 

   407     |oldList newList oldPrio s|

   408 

   409     oldPrio := aProcess priority.

   410     oldPrio == newPrio ifTrue:[^ self].

   411     aProcess setPriority:newPrio.

   412     s := aProcess state.

   413     s == #runnable ifTrue:[

   414         oldList := runnable at:oldPrio.

   415         (oldList includes:aProcess) ifTrue:[

   416             oldList remove:aProcess

   417         ].

   418 

   419         newList := runnable at:newPrio.

   420         newList isNil ifTrue:[

   421             newList := LinkedList new.

   422             runnable at:newPrio put:newList

   423         ].

   424         newList addLast:aProcess.

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

   426             self reschedule.

   427         ].

   428         ^ self

   429     ]

   430 ! !

   431 

   432 !ProcessorScheduler class methodsFor:'testing'!

   433 

   434 test1

   435     |scheduler|

   436 

   437     scheduler := ProcessorScheduler new.

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

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

   440     scheduler loop

   441 

   442     "ProcessorScheduler test1"

   443 !

   444 

   445 inputAvailable

   446     Transcript showCr:(Stdin nextLine)

   447 !

   448 

   449 xInputAvailable

   450     Transcript showCr:'x event'.

   451     Display dispatchEvent

   452 ! !

   453 

   454 !ProcessorScheduler methodsFor:'scheduling'!

   455 

   456 loop

   457     |looping nextTime waitTime fd index|

   458 

   459     looping := true.

   460     [looping] whileTrue:[

   461         "look if any timeouts are due to be evaluated"

   462 

   463         nextTime := nil.

   464         timeoutTimes notNil ifTrue:[

   465             nextTime := self evaluateTimeouts

   466         ].

   467 

   468         nextTime notNil ifTrue:[

   469             waitTime := OperatingSystem millisecondTimeDeltaBetween:nextTime

   470                                                                 and:OperatingSystem getMillisecondTime

   471         ] ifFalse:[

   472             waitTime := nil

   473         ].

   474 

   475         (fileDescriptors size == 0) ifTrue:[

   476             waitTime isNil ifTrue:[

   477                 Transcript showCr:'nothing to schedule'.

   478                 ^ self

   479             ].

   480 

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

   482             OperatingSystem millisecondDelay:waitTime

   483         ] ifFalse:[

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

   485             waitTime isNil ifTrue:[waitTime := 10000].

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

   487             fd isNil ifTrue:[

   488                 "an interrupt or timeout occured"

   489                 Transcript showCr:'interrupt or timeout'

   490             ] ifFalse:[

   491                 "notify the handler"

   492                 index := fileDescriptors identityIndexOf:fd.

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

   494             ]

   495         ]

   496     ]

   497 !

   498 

   499 evaluateTimeouts

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

   501      next pending timeout"

   502 

   503     |now thisTime index endIndex handler selector nextTime|

   504 

   505     nextTime := nil.

   506     endIndex := timeoutTimes size.

   507     (endIndex ~~ 0) ifTrue:[

   508         now := OperatingSystem getMillisecondTime.

   509         index := 1.

   510         [index <= endIndex] whileTrue:[

   511             thisTime := timeoutTimes at:index.

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

   513                 handler := timeHandlers at:index.

   514                 selector := timeSelectors at:index.

   515                 timeoutTimes at:index put:nil.

   516                 timeHandlers at:index put:nil.

   517                 timeSelectors at:index put:nil.

   518                 handler perform:selector

   519             ] ifTrue:[

   520                 nextTime isNil ifTrue:[

   521                     nextTime := thisTime

   522                 ] ifFalse:[

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

   524                         nextTime := thisTime

   525                     ]

   526                 ]

   527             ].

   528             index := index + 1

   529         ]

   530     ].

   531     ^ nextTime

   532 ! !

   533 

   534 !ProcessorScheduler methodsFor:'accessing'!

   535 

   536 currentPriority

   537     ^ currentPriority

   538 

   539     "Processor currentPriority"

   540 !

   541 

   542 currentProcess

   543     ^ currentProcess

   544 

   545     "Processor currentProcess"

   546 !

   547 

   548 addFileDescriptor:fd withHandler:handler selector:selector

   549     |index|

   550 

   551     fileDescriptors isNil ifTrue:[

   552         fileDescriptors := Array with:fd.

   553         fileHandlers := Array with:handler.

   554         fileSelectors := Array with:selector

   555     ] ifFalse:[

   556         index := fileDescriptors indexOf:nil.

   557         (index ~~ 0) ifTrue:[

   558             fileDescriptors at:index put:fd.

   559             fileHandlers at:index put:handler.

   560             fileSelectors at:index put:selector

   561         ] ifFalse:[

   562             fileDescriptors := fileDescriptors copyWith:fd.

   563             fileHandlers := fileHandlers copyWith:handler.

   564             fileSelectors := fileSelectors copyWith:selector

   565         ]

   566     ]

   567 !

   568 

   569 addTimeoutAfter:millis withHandler:handler selector:selector

   570     |index|

   571 

   572     fileDescriptors isNil ifTrue:[

   573         timeoutTimes := Array with:millis.

   574         timeHandlers := Array with:handler.

   575         timeSelectors := Array with:selector

   576     ] ifFalse:[

   577         index := timeoutTimes indexOf:nil.

   578         (index ~~ 0) ifTrue:[

   579             timeoutTimes at:index put:millis.

   580             timeHandlers at:index put:handler.

   581             timeSelectors at:index put:selector

   582         ] ifFalse:[

   583             timeoutTimes := fileDescriptors copyWith:millis.

   584             timeHandlers := fileHandlers copyWith:handler.

   585             timeSelectors := fileSelectors copyWith:selector

   586         ]

   587     ]

   588 !

   589 

   590 removeFileDescriptor:fd

   591     |index|

   592 

   593     index := fileDescriptors indexOf:nil.

   594     (index ~~ 0) ifTrue:[

   595         fileDescriptors at:index put:nil.

   596         fileHandlers at:index put:nil.

   597         fileSelectors at:index put:nil

   598     ]

   599 ! !