234 !

   235 

   236 threadInterrupt:id

   237     "make the process evaluate an interrupt. This sets a flag in the VMs

   238      threadSwitcher, to let the process perform a #interrupt when its set to

   239      run the next time. The process itself can decide how to react on this 

   240      interrupt (currently, it looks for interruptBlocks to evaluate)."

   241 

   242 %{  /* NOCONTEXT */

   243 

   244     if (__isSmallInteger(id)) {

   245 	__threadInterrupt(_intVal(id));

   246     }

   247 %}

   248 !

   249 

   250 threadsAvailable

   251     "return true, if the runtime system supports threads (i.e. processes);

   252      false otherwise."

   253 

   254 %{  /* NOCONTEXT */

   255     extern OBJ __threadsAvailable();

   256 

   257     RETURN (__threadsAvailable());

   258 %}

   259 ! !

   260 

   261 !ProcessorScheduler class methodsFor:'queries'!

   262 

   263 isPureEventDriven

   264     "this is temporary - (maybe not :-).

   265      you can run ST/X either with or without processes.

   266      Without, there is conceptionally a single process handling all

   267      outside events and timeouts. This has some negative implications

   268      (Debugger is ugly), but allows a fully portable ST/X without any

   269      assembler support - i.e. quick portability.

   270      The PureEvent flag will automatically be set if the runtime system

   271      does not support threads - otherwise, it can be set manually

   272      (from rc-file).

   273     "

   274 

   275     ^ PureEventDriven

   276 !

   277 

   278 knownProcesses

   279     "return a collection of all (living) processes in the system"

   280 

   281     ^ KnownProcesses select:[:p | p notNil]

   282 !

   283 

   284 maxNumberOfProcesses

   285     "return the limit on the number of processes;

   286      the default is nil (i.e. unlimited)."

   287 

   288     ^ MaxNumberOfProcesses

   289 !

   290 

   291 maxNumberOfProcesses:aNumber

   292     "set the limit on the number of processes.

   293      This helps if you have a program which (by error) creates countless

   294      subprocesses. Without this limit, you may have a hard time to find

   295      this error (and repairing it). If nil (the default), the number of

   296      processes is unlimited."

   297 

   298     MaxNumberOfProcesses := aNumber

   299 !

   300 

   301 processDriven

   302     "turn on process driven mode"

   303 

   304     PureEventDriven := false

   305 !

   306 

   307 pureEventDriven

   308     "turn on pure-event driven mode - no processes, single dispatch loop"

   309 

   310     PureEventDriven := true

   311 ! !

   312 

   313 !ProcessorScheduler methodsFor:'I/O event actions'!

   314 

   315 disableFd:aFileDescriptor

   316     "disable block events on aFileDescriptor.

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

   318 

   319     |idx "{Class: SmallInteger }" 

   320      wasBlocked|

   321 

   322     wasBlocked := OperatingSystem blockInterrupts.

   323     idx := readFdArray identityIndexOf:aFileDescriptor startingAt:1.

   324     idx ~~ 0 ifTrue:[

   325 	readFdArray at:idx put:nil.

   326 	readCheckArray at:idx put:nil.

   327 	readSemaphoreArray at:idx put:nil

   328     ].

   329     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

   330 !

   331 

   332 enableIOAction:aBlock onInput:aFileDescriptor

   333     "half-obsolete event support: arrange for aBlock to be

   334      evaluated when input on aFileDescriptor arrives. 

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

   336 

   337     |idx "{Class: SmallInteger }"

   338      wasBlocked|

   339 

   340     wasBlocked := OperatingSystem blockInterrupts.

   341     (readFdArray identityIndexOf:aFileDescriptor startingAt:1) == 0 ifTrue:[

   342 	idx := readFdArray identityIndexOf:nil startingAt:1.

   343 	idx ~~ 0 ifTrue:[

   344 	    readFdArray at:idx put:aFileDescriptor.

   345 	    readCheckArray at:idx put:aBlock.

   346 	    readSemaphoreArray at:idx put:nil

   347 	] ifFalse:[

   348 	    readFdArray := readFdArray copyWith:aFileDescriptor.

   349 	    readCheckArray := readCheckArray copyWith:aBlock.

   350 	    readSemaphoreArray := readSemaphoreArray copyWith:nil.

   351 	]

   352     ].

   353     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

   354 ! !

   355 

   356 !ProcessorScheduler methodsFor:'accessing'!

   357 

   358 activePriority

   359     "return the priority of the currently running process.

   360      GNU-ST & ST-80 compatibility; this is the same as currentPriority"

   361 

   362     ^ currentPriority

   363 !

   364 

   365 activeProcess

   366     "return the currently running process"

   367 

   368     ^ activeProcess

   369 

   370     "Processor activeProcess"

   371 !

   372 

   373 currentPriority

   374     "return the priority of the currently running process"

   375 

   376     ^ currentPriority

   377 

   378     "Processor currentPriority"

   379 !

   380 

   381 interruptedProcess

   382     "returns the process which was interrupted by the active one"

   383 

   384     ^ interruptedProcess

   385 ! !

   386 

   387 !ProcessorScheduler methodsFor:'background processing'!

   388 

   389 addIdleBlock:aBlock

   390     "add the argument, aBlock to the list of idle-actions.

   391      Idle blocks are evaluated whenever no other process is runnable,

   392      and no events are pending.

   393      Use of idle blocks is not recommended, use a low priority processes 

   394      instead, which has the same effect. Idle blcoks are still included

   395      to support background actions in pure-event systems, where no processes 

   396      are available.

   397      Support for idle-blocks may vanish."

   398 

   399     |wasBlocked|

   400 

   401     wasBlocked := OperatingSystem blockInterrupts.

   402     idleActions isNil ifTrue:[

   403 	idleActions := OrderedCollection new

   404     ].

   405     idleActions add:aBlock.

   406     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

   407 !

   408 

   409 removeIdleBlock:aBlock

   410     "remove the argument, aBlock from the list of idle-blocks.

   411      Support for idle-blocks may vanish - use low prio processes instead."

   412 

   413     |wasBlocked|

   414 

   415     wasBlocked := OperatingSystem blockInterrupts.

   416     idleActions notNil ifTrue:[

   417        idleActions remove:aBlock

   418     ].

   419     wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

   420 ! !

   421 

   422 !ProcessorScheduler methodsFor:'constants'!

   423 

   424 highestPriority

   425     "return the highest priority value (normal) processes can have."

   426 

   427     "must be below schedulingPriority - 

   428      otherwise scheduler could be blocked ...

   429     "

   430     ^ HighestPriority  

   431 !

   432 

   433 lowIOPriority

   434     "not currently used - for ST80 compatibility only"

   435 

   436     ^ 2 "claus: is this ok ?"

   437 !

   438 

   439 lowestPriority

   440     "return the lowest priority value"

   441 

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

   443 !

   444 

   445 schedulingPriority

   446     "return the priority at which the scheduler runs."

   447 

   448     "must be above highestPriority - 

   449      otherwise scheduler could be blocked ...

   450     "

   451     ^ SchedulingPriority

   452 !

   453 

   454 systemBackgroundPriority

   455     "return the priority, at which background system processing

   456      should take place.

   457      Not currently used - for ST80 compatibility only"

   458 

   459     ^ 4

   460 !

   461 

   462 timingPriority

   463     "return the priority, at which all timing takes place (messageTally,

   464      delay etc.)"

   465 

   466     ^ TimingPriority

   467 !

   468 

   469 userBackgroundPriority

   470     "return the priority, at which background user (non-interactive) processing

   471      should take place.

   472      Not currently used - for ST80 compatibility only"

   473 

   474     ^ 6

   475 !

   476 

   477 userInterruptPriority

   478     "return the priority, at which the event scheduler runs - i.e.

   479      all processes running at a lower priority are interruptable by Cntl-C

   480      or the timer. Processes running at higher prio will not be interrupted."

   481 

   482     ^ UserInterruptPriority

   483 !

   484 

   485 userSchedulingPriority

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

   487      takes place"

   488 

   489     ^ UserSchedulingPriority

   490 ! !

   491 

   492 !ProcessorScheduler methodsFor:'dispatching'!

   493 

   494 dispatch

   495      "It handles timeouts and switches to the highest prio runnable process"

   496 

   497     |any millis pri p nActions "{ Class: SmallInteger }" |

   498 

   499     "

   500      handle all timeout actions

   501     "

   502     anyTimeouts ifTrue:[

   503 	self evaluateTimeouts

   504     ].

   505 

   506     "first do a quick check for semaphores using checkActions - this is needed for

   507      devices like the X-connection, where some events might be in the event

   508      queue. Without these checks, a select might block even though there is work to do

   509     "

   510     any := false.

   511     nActions := readCheckArray size.

   512     1 to:nActions do:[:index |

   513 	|checkBlock sema|

   514 

   515 	checkBlock := readCheckArray at:index.

   516 	(checkBlock notNil and:[checkBlock value]) ifTrue:[

   517 	    sema := readSemaphoreArray at:index.

   518 	    sema notNil ifTrue:[

   519 		sema signalOnce.

   520 	    ].

   521 	    any := true.

   522 	]

   523     ].

   524 

   525     "now, someone might be runnable ..."

   526 

   527     p := self highestPriorityRunnableProcess.

   528     p isNil ifTrue:[

   529 	"no one runnable, hard wait for event or timeout"

   530 

   531 	self waitForEventOrTimeout.

   532 	^ self

   533     ].

   534 

   535     pri := p priority.

   536 

   537     "

   538      want to give control to the process p.

   539      If the switched-to processes priority is lower than the

   540      userSchedulingPriority, we have to make certain, that the 

   541      next input or timer will bring us back for a reschedule.

   542      This is done by enabling ioInterrupts for all file descriptors.

   543      If ioInterrupts are not available (OS does not support them), 

   544      we schedule a timer interrupt to interrupt us after 1/20s of a second

   545      - effectively polling the filedescriptors 20 times a second.

   546      (which is bad, since low prio processes will be hurt in performance)

   547      Therefore, dont let benchmarks run with low prio ...

   548 

   549      Higher prio processes must be suspended, 

   550      same prio ones must yield or suspend to get back control

   551     "

   552 

   553 "

   554  uncommenting this will make timeouts interrupt the current process

   555  (i.e. as if the interrupt runs at TimingPrio); 

   556  if left commented, they are handled at UserSchedulingPrio.

   557  this will all change, when timeouts are removed and all is process driven

   558  (a future version will have a process running to handle a timeout queue)

   559 "

   560 

   561 "

   562     pri < TimingPriority ifTrue:[

   563 	anyTimeouts ifTrue:[

   564 	    millis := self timeToNextTimeout.

   565 	    millis == 0 ifTrue:[^ self].

   566 	]

   567     ].

   568 "

   569 

   570     "

   571      if the process to run has a lower than UserInterruptPriority,

   572      arrange for an interrupt to occur on I/O.

   573      This is done by enabling IO-signals (if the OS supports them)

   574      or by installing a poll-interrupt after 50ms (if the OS does not).

   575     "

   576     pri < UserInterruptPriority ifTrue:[

   577     

   578 "comment out this if above is uncommented"

   579 	anyTimeouts ifTrue:[

   580 	    millis := self timeToNextTimeout.

   581 	    millis == 0 ifTrue:[^ self].

   582 	].

   583 "---"

   584 

   585 	useIOInterrupts ifTrue:[

   586 	    readFdArray do:[:fd |

   587 		fd notNil ifTrue:[

   588 		    OperatingSystem enableIOInterruptsOn:fd

   589 		].

   590 	    ].

   591 	] ifFalse:[

   592 	    millis notNil ifTrue:[

   593 		millis := millis min:50

   594 	    ] ifFalse:[

   595 		millis := 50

   596 	    ]

   597 	]

   598     ].

   599 

   600     millis notNil ifTrue:[

   601 	"schedule a clock interrupt after millis milliseconds"

   602 	OperatingSystem enableTimer:millis rounded.

   603     ].

   604 

   605     "

   606      now let the process run - will come back here by reschedule

   607      from ioInterrupt or timerInterrupt ... (running at max+1)

   608     "

   609     self threadSwitch:p.

   610 

   611     "... when we arrive here, we are back on stage"

   612 

   613     millis notNil ifTrue:[

   614 	OperatingSystem disableTimer.

   615 	self checkForInputWithTimeout:0.

   616     ]

   617 !

   618 

   619 dispatchLoop

   620     "central dispatch loop; the scheduler process is always staying in

   621      this method, looping forever."

   622 

   623     "avoid confusion if entered twice"

   624 

   625     dispatching == true ifTrue:[^ self].

   626     dispatching := true.

   627 

   628     "I made this an extra call to dispatch; this allows recompilation

   629      of the dispatch-handling code in the running system.

   630     "

   631     [true] whileTrue:[

   632 	AbortSignal handle:[:ex |

   633 	    ex return

   634 	] do:[

   635 	    self dispatch

   636 	]

   637     ]

   641 

   642 scheduleForInterrupt:aProcess

   643     "make aProcess evaluate its pushed interrupt block(s)"

   644 

   645     |id|

   646 

   647     aProcess isNil ifTrue:[^ self].

   648     aProcess == activeProcess ifTrue:[^ self].

   649 

   650     id := aProcess id.

   651     self class threadInterrupt:id.

   652     "

   653      and, make the process runnable

   654     "

   655     aProcess state ~~ #stopped ifTrue:[

   656 	"

   657 	 and, make the process runnable

   658 	"

   659 	aProcess resume

   660     ]

   661 !

   783 !ProcessorScheduler methodsFor:'private initializing'!

   784 

   785 initialize

   786     "initialize the one-and-only ProcessorScheduler"

   787 

   788     |nPrios "{ Class: SmallInteger }"

   789      l p|

   790 

   791     KnownProcesses isNil ifTrue:[

   792 	KnownProcesses := WeakArray new:10.

   793 	KnownProcesses watcher:self class.

   794 	KnownProcessIds := OrderedCollection new.

   795     ].

   796 

   797     "

   798      create a collection with process lists; accessed using the priority as key

   799     "

   800     nPrios := SchedulingPriority.

   801     quiescentProcessLists := Array new:nPrios.

   802     1 to:nPrios do:[:pri |

   803 	quiescentProcessLists at:pri put:(LinkedList new)

   804     ].

   805 

   806     readFdArray := Array with:nil.

   807     readCheckArray := Array with:nil.

   808     readSemaphoreArray := Array with:nil.

   809     writeFdArray := Array with:nil.

   810     writeSemaphoreArray := Array with:nil.

   811     timeoutArray := Array with:nil.

   812     timeoutSemaphoreArray := Array with:nil.

   813     timeoutActionArray := Array with:nil.

   814     timeoutProcessArray := Array with:nil.

   815     anyTimeouts := false.

   816     dispatching := false.

   817     useIOInterrupts := OperatingSystem supportsIOInterrupts.

   818 

   819     "

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

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

   822      Also, it has a prio of max+1 - thus, it comes first when looking

   823      for a runnable process.

   824     "

   825     currentPriority := SchedulingPriority.

   826     p := Process new.

   827     p setId:0 state:#run.

   828     p setPriority:currentPriority.

   829     p name:'scheduler'.

   830 

   831     scheduler := activeProcess := p.

   832 

   833     (quiescentProcessLists at:currentPriority) add:p.

   834 

   835     "

   836      let me handle IO and timer interrupts

   837     "

   838     ObjectMemory ioInterruptHandler:self.

   839     ObjectMemory timerInterruptHandler:self.

   840 !

   841 

   842 reinitialize

   843     "all previous processes (except those marked as restartable) are made dead 

   844      - each object should reinstall its process(s) upon restart;

   845      especially, windowgroups have to.

   846      In contrast to ST-80, restartable processes are restarted at the beginning

   847      NOT continued where left. This is a consequence of the portable implementation

   848      of ST/X, since in order to continue a process, we needed to know the

   849      internals of the machines (and C-compilers) stack layout.

   850      This was not done, favouring portability for process continuation.

   851      In praxis, this is not much of a problem, since in almost every case,

   852      the computation state can be saved in some object, and processing be 

   853      restarted from scratch, reinitializing things from this saved state."

   854 

   855     |processesToRestart|

   856 

   857     "

   858      lay all processes to rest, collect restartable ones

   859     "

   860     processesToRestart := OrderedCollection new.

   861     KnownProcesses do:[:p |

   862 	p notNil ifTrue:[

   863 	    "how, exactly should this be done ?"

   864 

   865 	    p isRestartable == true ifTrue:[

   866 		p nextLink:nil.

   867 		processesToRestart add:p

   868 	    ] ifFalse:[

   869 		p setId:nil state:#dead

   870 	    ]

   871 	].

   872     ].

   873     scheduler setId:nil state:#dead. 

   874 

   875     "

   876      now, start from scratch

   877     "

   878     KnownProcesses := nil.

   879     self initialize.

   880 

   881     "

   882      ... and restart those that can be.

   883     "

   884     processesToRestart do:[:p |

   885 "/        'process restart not implemented' errorPrintNL.

   886 	p restart

   887     ]

   888 ! !

   889