gcc/m2/gm2-libs-coroutines/Executive.mod

   1 (* Executive.mod provides a simple multitasking executive.
   2
   3 Copyright (C) 2002-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE Executive[MAX(PROTECTION)] ;
  28
  29 FROM SYSTEM IMPORT ADDRESS, PROCESS, LISTEN, ADR,
  30                    NEWPROCESS, TRANSFER, IOTRANSFER, ListenLoop,
  31                    TurnInterrupts ;
  32
  33 FROM COROUTINES IMPORT PROTECTION ;
  34 FROM SysStorage IMPORT ALLOCATE, DEALLOCATE ;
  35 FROM StrLib IMPORT StrCopy ;
  36 FROM StrLib IMPORT StrLen ;
  37 FROM NumberIO IMPORT CardToStr ;
  38 FROM Debug IMPORT DebugString, Halt ;
  39
  40
  41 (* IMPORT gdb ; *)
  42
  43
  44 CONST
  45    MaxCharsInName = 15 ;
  46    IdleStackSize  = 16 * 1024 * 1024 ;
  47
  48 TYPE
  49    SEMAPHORE = POINTER TO Semaphore ;         (* defines dijkstra's semaphores *)
  50    Semaphore = RECORD
  51                   Value  : CARDINAL ;         (* semaphore value               *)
  52                   SemName: EntityName ;       (* semaphore name for debugging  *)
  53                   Who    : DESCRIPTOR ;       (* queue of waiting processes    *)
  54                   ExistsQ: SemQueue ;         (* list of existing semaphores   *)
  55                END ;
  56
  57    DESCRIPTOR= POINTER TO Descriptor ;        (* handle onto a process         *)
  58    Descriptor= RECORD
  59                   Volatiles  : PROCESS ;      (* process volatile environment  *)
  60                   ReadyQ     : DesQueue ;     (* queue of ready processes      *)
  61                   ExistsQ    : DesQueue ;     (* queue of existing processes   *)
  62                   SemaphoreQ : DesQueue ;     (* queue of waiting processes    *)
  63                   Which      : SEMAPHORE ;    (* which semaphore are we waiting*)
  64                   RunName    : EntityName ;   (* process name for debugging    *)
  65                   Status     : State ;        (* state of process              *)
  66                   RunPriority: Priority ;     (* runtime priority of process   *)
  67                   Size       : CARDINAL ;     (* Maximum stack size            *)
  68                   Start      : ADDRESS ;      (* Stack start                   *)
  69                   Debugged   : BOOLEAN ;      (* Does user want to debug a     *)
  70                                               (* deadlocked process?           *)
  71                END ;
  72
  73    DesQueue  = RECORD
  74                   Right,
  75                   Left : DESCRIPTOR ;
  76                END ;
  77
  78    SemQueue  = RECORD
  79                   Right,
  80                   Left : SEMAPHORE ;
  81                END ;
  82
  83    EntityName= ARRAY [0..MaxCharsInName] OF CHAR ;
  84
  85    Priority  = (idle, lo, hi) ;               (* process run priority          *)
  86
  87    State     = (Runnable, Suspended, WaitOnSem, WaitOnInt) ;
  88
  89 VAR
  90    ExistsQueue   : DESCRIPTOR ;               (* List of existing processes    *)
  91    RunQueue      : ARRAY Priority OF DESCRIPTOR ;
  92                                               (* List of runnable processes    *)
  93    CurrentProcess: DESCRIPTOR ;
  94    AllSemaphores : SEMAPHORE ;                (* List of all semaphores        *)
  95    GarbageItem   : DESCRIPTOR ;               (* Descriptor destined to free   *)
  96
  97
  98 (*
  99    Assert -
 100 *)
 101
 102 PROCEDURE Assert (c: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL;
 103                   function: ARRAY OF CHAR) ;
 104 BEGIN
 105    IF NOT c
 106    THEN
 107       Ps ;
 108       Halt ('assert failed', file, function, line)
 109    END
 110 END Assert ;
 111
 112
 113 (*
 114    InitProcess - initializes a process which is held in the suspended
 115                  state. When the process is resumed it will start executing
 116                  procedure, p. The process has a maximum stack size of,
 117                  StackSize, bytes and its textual name is, Name.
 118                  The StackSize should be at least 5000 bytes.
 119 *)
 120
 121 PROCEDURE InitProcess (p: PROC;
 122                        StackSize: CARDINAL;
 123                        Name: ARRAY OF CHAR) : DESCRIPTOR ;
 124 VAR
 125    d         : DESCRIPTOR ;
 126    ToOldState: PROTECTION ;
 127    db        : ARRAY [0..80] OF CHAR ;
 128 BEGIN
 129 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 130    NEW(d) ;
 131    WITH d^ DO
 132       Size        := StackSize ;
 133                                  (* allocate space for this processes stack *)
 134       ALLOCATE(Start, StackSize) ;
 135       NEWPROCESS(p, Start, StackSize, Volatiles) ;  (* create volatiles     *)
 136       InitQueue(ReadyQ) ;        (* not on the ready queue as suspended     *)
 137       AddToExists(d) ;           (* add process to the exists queue         *)
 138       InitQueue(SemaphoreQ) ;    (* not on a semaphore queue yet            *)
 139       Which       := NIL ;       (* not on a semaphore queue yet            *)
 140       StrCopy(Name, RunName) ;   (* copy name into descriptor for debugging *)
 141       Status      := Suspended ; (* this process will be suspended          *)
 142       RunPriority := lo ;        (* all processes start off at lo priority  *)
 143       Debugged    := FALSE ;     (* no need to debug deadlock yet!          *)
 144    END ;
 145 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 146    RETURN( d )                   (* and return a descriptor to the caller   *)
 147 END InitProcess ;
 148
 149
 150 (*
 151    KillProcess - kills the current process. Notice that if InitProcess
 152                  is called again, it might reuse the DESCRIPTOR of the
 153                  killed process. It is the responsibility of the caller
 154                  to ensure all other processes understand this process
 155                  is different.
 156 *)
 157
 158 PROCEDURE KillProcess ;
 159 VAR
 160    ToOldState: PROTECTION ;
 161 BEGIN
 162 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;    (* disable interrupts *) *)
 163    SubFromReady(CurrentProcess) ;
 164    SubFromExists(ExistsQueue, CurrentProcess) ;
 165    GarbageItem := CurrentProcess ;
 166    Reschedule ;
 167 (* ToOldState := TurnInterrupts(ToOldState)         (* restore interrupts *) *)
 168 END KillProcess ;
 169
 170
 171 (*
 172    Resume - resumes a suspended process. If all is successful then the process, p,
 173             is returned. If it fails then NIL is returned.
 174 *)
 175
 176 PROCEDURE Resume (d: DESCRIPTOR) : DESCRIPTOR ;
 177 VAR
 178    ToOldState: PROTECTION ;
 179 BEGIN
 180 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 181    WITH d^ DO
 182       IF Status=Suspended
 183       THEN
 184          (* legal state transition *)
 185          Status := Runnable ;                         (* change status      *)
 186          AddToReady(d) ;                              (* add to run queue   *)
 187          RunQueue[RunPriority] := d ;                 (* make d at top of q *)
 188          Reschedule (* check whether this process has a higher run priority *)
 189       ELSE
 190          (* we are trying to Resume a process which is *)
 191          Halt ('trying to resume a process which is not suspended',
 192                __FILE__, __FUNCTION__, __LINE__) ;
 193          RETURN( NIL )        (* not held in a Suspended state - error      *)
 194       END
 195    END ;
 196 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 197    RETURN( d )
 198 END Resume ;
 199
 200
 201 (*
 202    Suspend - suspend the calling process.
 203              The process can only continue running if another process
 204              Resumes it.
 205 *)
 206
 207 PROCEDURE Suspend ;
 208 VAR
 209    ToOldState: PROTECTION ;
 210 BEGIN
 211 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 212    WITH CurrentProcess^ DO
 213       Status := Suspended
 214    END ;
 215    SubFromReady(CurrentProcess) ;
 216    Reschedule ;
 217 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 218 END Suspend ;
 219
 220
 221 (*
 222    InitSemaphore - creates a semaphore whose initial value is, v, and
 223                    whose name is, Name.
 224 *)
 225
 226 PROCEDURE InitSemaphore (v: CARDINAL; Name: ARRAY OF CHAR) : SEMAPHORE ;
 227 VAR
 228    s         : SEMAPHORE ;
 229    ToOldState: PROTECTION ;
 230 BEGIN
 231 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 232    NEW(s) ;
 233    WITH s^ DO
 234       Value := v ;                  (* initial value of semaphore           *)
 235       StrCopy(Name, SemName) ;      (* save the name for future debugging   *)
 236       Who := NIL ;                  (* no one waiting on this semaphore yet *)
 237       AddToSemaphoreExists(s) ;     (* add semaphore to exists list         *)
 238    END ;
 239 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 240    RETURN( s )
 241 END InitSemaphore ;
 242
 243
 244 (*
 245    Wait - performs dijkstra's P operation on a semaphore.
 246           A process which calls this procedure will
 247           wait until the value of the semaphore is > 0
 248           and then it will decrement this value.
 249 *)
 250
 251 PROCEDURE Wait (s: SEMAPHORE) ;
 252 VAR
 253    ToOldState: PROTECTION ;
 254 BEGIN
 255 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 256    WITH s^ DO
 257       IF Value>0
 258       THEN
 259          DEC( Value )
 260       ELSE
 261          SubFromReady(CurrentProcess) ;               (* remove from run q  *)
 262          IF Who=CurrentProcess
 263          THEN
 264             Ps ;
 265             Halt ('we are already on sem',
 266                   __FILE__, __FUNCTION__, __LINE__)
 267          END ;
 268          AddToSemaphore(Who, CurrentProcess) ;        (* add to semaphore q *)
 269          CurrentProcess^.Status := WaitOnSem ;        (* set new status     *)
 270          CurrentProcess^.Which := s ;                 (* debugging aid      *)
 271          Reschedule                                   (* find next process  *)
 272       END
 273    END ;
 274 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 275 END Wait ;
 276
 277
 278 (*
 279    Signal - performs dijkstra's V operation on a semaphore.
 280             A process which calls the procedure will increment
 281             the semaphores value.
 282 *)
 283
 284 PROCEDURE Signal (s: SEMAPHORE) ;
 285 VAR
 286    ToOldState: PROTECTION ;
 287    d         : DESCRIPTOR ;
 288 BEGIN
 289 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 290    WITH s^ DO
 291       IF Who=NIL
 292       THEN
 293          INC( Value )                                 (* no process waiting *)
 294       ELSE
 295          d := SubFromSemaphoreTop(Who) ; (* remove process from semaphore q *)
 296          d^.Which := NIL ;              (* no longer waiting on semaphore   *)
 297          d^.Status := Runnable ;        (* set new status                   *)
 298          AddToReady(d) ;                (* add process to the run queue     *)
 299          Reschedule                     (* find out whether there is a      *)
 300                                         (* higher priority to run.          *)
 301       END
 302    END ;
 303 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 304 END Signal ;
 305
 306
 307 (*
 308    WaitForIO - waits for an interrupt to occur on vector, VectorNo.
 309 *)
 310
 311 PROCEDURE WaitForIO (VectorNo: CARDINAL) ;
 312 VAR
 313    Calling   : DESCRIPTOR ;
 314    Next      : PROCESS ;
 315    ToOldState: PROTECTION ;
 316    r         : INTEGER ;
 317 BEGIN
 318 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
 319 (*
 320    DebugString('inside WaitForIO ') ;
 321    DebugString(CurrentProcess^.RunName) ;
 322    DebugString('\n') ;
 323 *)
 324    Assert(CurrentProcess^.Status=Runnable,
 325           __FILE__, __LINE__, __FUNCTION__) ;
 326    SubFromReady(CurrentProcess) ;   (* remove process from run queue *)
 327    (*
 328       alter run priority to hi as all processes waiting for an interrupt
 329       are scheduled to run at the highest priority.
 330    *)
 331    WITH CurrentProcess^ DO
 332       Status := WaitOnInt ;   (* it will be blocked waiting for an interrupt.  *)
 333       RunPriority := hi ;     (* this (hopefully) allows it to run as soon as  *)
 334                               (* the interrupt occurs.                         *)
 335    END ;
 336    Calling := CurrentProcess ;      (* process which called WaitForIO          *)
 337    CurrentProcess := NextReady() ;  (* find next process to run while we wait  *)
 338    Next := CurrentProcess^.Volatiles ;
 339    (*
 340       This is quite complicated. We transfer control to the next process saving
 341       our volatile environment into the Calling process descriptor volatiles.
 342       When an interrupt occurs the calling process will be resumed and the
 343       interrupted process volatiles will be placed into Next.
 344    *)
 345    IOTRANSFER(Calling^.Volatiles, Next, VectorNo) ;
 346
 347    (*
 348       At this point the interrupt has just occurred and the volatiles of
 349       the interrupted process are in Next. Next is the current process
 350       and so we must save them before picking up the Calling descriptor.
 351    *)
 352
 353    CurrentProcess^.Volatiles := Next ;             (* carefully stored away *)
 354    CurrentProcess := Calling ;                     (* update CurrentProcess *)
 355 (*
 356    DebugString(CurrentProcess^.RunName) ;
 357 *)
 358    CurrentProcess^.Status := Runnable ;            (* add to run queue      *)
 359    AddToReady(CurrentProcess) ;
 360 (*
 361    DebugString(' finishing WaitForIO\n') ;
 362 *)
 363
 364 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 365 END WaitForIO ;
 366
 367
 368 (*
 369    Ps - displays a process list together with relevant their status.
 370 *)
 371
 372 PROCEDURE Ps ;
 373 VAR
 374    ToOldState: PROTECTION ;
 375    p         : DESCRIPTOR ;
 376    s         : SEMAPHORE ;
 377    a         : ARRAY [0..5] OF CHAR ;
 378 BEGIN
 379 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 380    p := ExistsQueue ;
 381    IF p#NIL
 382    THEN
 383       REPEAT
 384          DisplayProcess(p) ;
 385          p := p^.ExistsQ.Right
 386       UNTIL p=ExistsQueue
 387    END ;
 388    s := AllSemaphores ;
 389    IF s#NIL
 390    THEN
 391       REPEAT
 392          WITH s^ DO
 393             DebugString(SemName) ;
 394             WriteNSpaces(MaxCharsInName-StrLen(SemName)) ;
 395             CardToStr(Value, 0, a) ;
 396             DebugString(a) ;
 397             DebugString('\n')
 398          END ;
 399          s := s^.ExistsQ.Right
 400       UNTIL s=AllSemaphores
 401    END ;
 402 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 403 END Ps ;
 404
 405
 406 (*
 407    DisplayProcess - displays the process, p, together with its status.
 408 *)
 409
 410 PROCEDURE DisplayProcess (p: DESCRIPTOR) ;
 411 VAR
 412    a: ARRAY [0..4] OF CHAR ;
 413 BEGIN
 414    WITH p^ DO
 415       DebugString(RunName) ; WriteNSpaces(MaxCharsInName-StrLen(RunName)) ;
 416       CASE RunPriority OF
 417
 418       idle: DebugString(' idle ') |
 419       lo  : DebugString(' lo   ') |
 420       hi  : DebugString(' hi   ')
 421
 422       END ;
 423       CASE Status OF
 424
 425       Runnable : DebugString('runnable ') |
 426       Suspended: DebugString('suspended') |
 427       WaitOnSem: DebugString('waitonsem   (') ;
 428                  DebugString(Which^.SemName) ;
 429                  DebugString(')') |
 430       WaitOnInt: DebugString('waitonint')
 431
 432       END ;
 433       DebugString('\n')
 434    END
 435 END DisplayProcess ;
 436
 437
 438 (*
 439    WriteNSpaces - writes, n, spaces.
 440 *)
 441
 442 PROCEDURE WriteNSpaces (n: CARDINAL) ;
 443 BEGIN
 444    WHILE n>0 DO
 445       DebugString(' ') ;
 446       DEC(n)
 447    END
 448 END WriteNSpaces ;
 449
 450
 451 (*
 452    GetCurrentProcess - returns the descriptor of the current running
 453                        process.
 454 *)
 455
 456 PROCEDURE GetCurrentProcess () : DESCRIPTOR ;
 457 VAR
 458    ToOldState: PROTECTION ;
 459    p         : DESCRIPTOR ;
 460 BEGIN
 461 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;      (* disable interrupts *) *)
 462    p := CurrentProcess ;
 463 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 464    RETURN( p )
 465 END GetCurrentProcess ;
 466
 467
 468 (*
 469    RotateRunQueue - rotates the process run queue.
 470 *)
 471
 472 PROCEDURE RotateRunQueue ;
 473 VAR
 474    ToOldState: PROTECTION ;
 475 BEGIN
 476 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 477    (* we only need to rotate the lo priority processes as:
 478       idle - should only have one process (the idle process)
 479       hi   - are the device drivers which most of the time are performing
 480              WaitForIO
 481    *)
 482    IF RunQueue[lo]#NIL
 483    THEN
 484       RunQueue[lo] := RunQueue[lo]^.ReadyQ.Right
 485    END ;
 486 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 487 END RotateRunQueue ;
 488
 489
 490 (*
 491    ProcessName - displays the name of process, d, through
 492                  DebugString.
 493 *)
 494
 495 PROCEDURE ProcessName (d: DESCRIPTOR) ;
 496 BEGIN
 497    DebugString(d^.RunName)
 498 END ProcessName ;
 499
 500
 501 (*
 502    DebugProcess -
 503 *)
 504
 505 PROCEDURE DebugProcess (d: DESCRIPTOR) ;
 506 VAR
 507    ToOldState: PROTECTION ;
 508 BEGIN
 509 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
 510    WITH d^ DO
 511       IF Status=WaitOnSem
 512       THEN
 513          DebugString('debugging process (') ;
 514          DebugString(RunName) ;
 515          DebugString(') was waiting on semaphore (') ;
 516          DebugString(Which^.SemName) ;
 517          DebugString(')\n') ;
 518          SubFromSemaphore(Which^.Who, d) ;
 519          AddToReady(d) ;
 520          Status := Runnable ;
 521          Debugged := TRUE ;
 522          Reschedule
 523       ELSE
 524          DebugString('can only debug deadlocked processes (') ;
 525          DebugString(RunName) ;
 526          DebugString(') which are waiting on a semaphore\n')
 527       END
 528    END ;
 529 (* ToOldState := TurnInterrupts(ToOldState) *)
 530 END DebugProcess ;
 531
 532
 533 (*
 534    CheckDebugged - checks to see whether the debugged flag has
 535                    been set by the debugger.
 536                    TRUE  is returned if the process was debugged.
 537                    FALSE is returned if the process was not debugged.
 538 *)
 539
 540 PROCEDURE CheckDebugged () : BOOLEAN ;
 541 BEGIN
 542    WITH CurrentProcess^ DO
 543       IF Debugged
 544       THEN
 545          (*
 546             You will see this comment after you have enabled a
 547             deadlocked process to continue via the gdb command:
 548
 549             print Executive_DebugProcess(d)
 550
 551             debugger caused deadlocked process to continue
 552          *)
 553          (* gdb.breakpoint ; *)
 554          Debugged := FALSE ;
 555          SubFromReady(CurrentProcess) ;
 556          AddToSemaphore(Which^.Who, CurrentProcess) ;
 557                                            (* add it back to the queue sem *)
 558          Status := WaitOnSem ;
 559
 560          RETURN( TRUE )
 561       END
 562    END ;
 563    RETURN( FALSE )
 564 END CheckDebugged ;
 565
 566
 567 (*
 568    Reschedule - reschedules to the highest runnable process.
 569 *)
 570
 571 PROCEDURE Reschedule ;
 572 BEGIN
 573    (*
 574       the repeat loop allows us to debug a process even when it is
 575       technically waiting on a semaphore. We run the process into
 576       a breakpoint and then back into this schedule routine.
 577       This is really useful when trying to find out why processes have
 578       deadlocked.
 579    *)
 580    REPEAT
 581       ScheduleProcess
 582    UNTIL NOT CheckDebugged()
 583 END Reschedule ;
 584
 585
 586 (*
 587    ScheduleProcess - finds the highest priority Runnable process and
 588                      then transfers control to it.
 589 *)
 590
 591 PROCEDURE ScheduleProcess ;
 592 VAR
 593    From,
 594    Highest: DESCRIPTOR ;
 595 BEGIN
 596    Highest := NextReady() ;
 597
 598    (* rotate ready Q to ensure fairness *)
 599    RunQueue[Highest^.RunPriority] := Highest^.ReadyQ.Right ;
 600
 601    (* no need to transfer if Highest=CurrentProcess *)
 602    IF Highest#CurrentProcess
 603    THEN
 604       From := CurrentProcess ;
 605 (*
 606       DebugString('context switching from ') ; DebugString(From^.RunName) ;
 607 *)
 608       (* alter CurrentProcess before we TRANSFER *)
 609       CurrentProcess := Highest ;
 610 (*
 611       DebugString(' to ') ; DebugString(CurrentProcess^.RunName) ;
 612 *)
 613
 614       TRANSFER(From^.Volatiles, Highest^.Volatiles) ;
 615 (*
 616       ; DebugString(' (') ; DebugString(CurrentProcess^.RunName) ;
 617       DebugString(')\n') ;
 618 *)
 619       CheckGarbageCollect
 620    END
 621 END ScheduleProcess ;
 622
 623
 624 (*
 625    NextReady - returns the highest priority Runnable process.
 626 *)
 627
 628 PROCEDURE NextReady () : DESCRIPTOR ;
 629 VAR
 630    Highest: DESCRIPTOR ;
 631    Pri    : Priority ;
 632 BEGIN
 633    Highest := NIL ;
 634    FOR Pri := idle TO hi DO
 635       IF RunQueue[Pri]#NIL
 636       THEN
 637          Highest := RunQueue[Pri]
 638       END
 639    END ;
 640    Assert(Highest#NIL, __FILE__, __LINE__, __FUNCTION__) ;
 641    RETURN( Highest )
 642 END NextReady ;
 643
 644
 645 (*
 646    CheckGarbageCollect - checks to see whether GarbageItem is set
 647                          and if so it deallocates storage associated
 648                          with this descriptor.
 649 *)
 650
 651 PROCEDURE CheckGarbageCollect ;
 652 BEGIN
 653    IF GarbageItem#NIL
 654    THEN
 655       WITH GarbageItem^ DO
 656          DEALLOCATE(Start, Size)
 657       END ;
 658       DISPOSE(GarbageItem) ;
 659       GarbageItem := NIL
 660    END
 661 END CheckGarbageCollect ;
 662
 663
 664 (*
 665    AddToExists - adds item, Item, to the exists queue.
 666 *)
 667
 668 PROCEDURE AddToExists (Item: DESCRIPTOR) ;
 669 BEGIN
 670    IF ExistsQueue=NIL
 671    THEN
 672       ExistsQueue := Item ;                  (* Head is empty therefore make *)
 673       Item^.ExistsQ.Left := Item ;           (* Item the only entry on this  *)
 674       Item^.ExistsQ.Right := Item            (* queue.                       *)
 675    ELSE
 676       Item^.ExistsQ.Right := ExistsQueue ;   (* Add Item to the end of queue *)
 677       Item^.ExistsQ.Left  := ExistsQueue^.ExistsQ.Left ;
 678       ExistsQueue^.ExistsQ.Left^.ExistsQ.Right := Item ;
 679       ExistsQueue^.ExistsQ.Left := Item
 680    END
 681 END AddToExists ;
 682
 683
 684 (*
 685    SubFromExists - removes a process, Item, from the exists queue, Head.
 686 *)
 687
 688 PROCEDURE SubFromExists (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 689 BEGIN
 690    IF (Item^.ExistsQ.Right=Head) AND (Item=Head)
 691    THEN
 692       Head := NIL
 693    ELSE
 694       IF Head=Item
 695       THEN
 696          Head := Head^.ExistsQ.Right
 697       END ;
 698       Item^.ExistsQ.Left^.ExistsQ.Right := Item^.ExistsQ.Right ;
 699       Item^.ExistsQ.Right^.ExistsQ.Left := Item^.ExistsQ.Left
 700    END
 701 END SubFromExists ;
 702
 703
 704 (*
 705    AddToSemaphore - adds item, Item, to the semaphore queue defined by Head.
 706 *)
 707
 708 PROCEDURE AddToSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 709 BEGIN
 710    IF Head=NIL
 711    THEN
 712       Head := Item ;                         (* Head is empty therefore make *)
 713       Item^.SemaphoreQ.Left := Item ;        (* Item the only entry on this  *)
 714       Item^.SemaphoreQ.Right := Item         (* queue.                       *)
 715    ELSE
 716       Item^.SemaphoreQ.Right := Head ;       (* Add Item to the end of queue *)
 717       Item^.SemaphoreQ.Left  := Head^.SemaphoreQ.Left ;
 718       Head^.SemaphoreQ.Left^.SemaphoreQ.Right := Item ;
 719       Head^.SemaphoreQ.Left := Item
 720    END
 721 END AddToSemaphore ;
 722
 723
 724 (*
 725    AddToSemaphoreExists - adds item, Item, to the semaphore exists queue.
 726 *)
 727
 728 PROCEDURE AddToSemaphoreExists (Item: SEMAPHORE) ;
 729 BEGIN
 730    IF AllSemaphores=NIL
 731    THEN
 732       AllSemaphores := Item ;                (* Head is empty therefore make *)
 733       Item^.ExistsQ.Left := Item ;           (* Item the only entry on this  *)
 734       Item^.ExistsQ.Right := Item            (* queue.                       *)
 735    ELSE
 736       Item^.ExistsQ.Right := AllSemaphores ;
 737                                              (* Add Item to the end of queue *)
 738       Item^.ExistsQ.Left  := AllSemaphores^.ExistsQ.Left ;
 739       AllSemaphores^.ExistsQ.Left^.ExistsQ.Right := Item ;
 740       AllSemaphores^.ExistsQ.Left := Item
 741    END
 742 END AddToSemaphoreExists ;
 743
 744
 745 (*
 746    AddToReady - adds item, Item, to the ready queue.
 747 *)
 748
 749 PROCEDURE AddToReady (Item: DESCRIPTOR) ;
 750 BEGIN
 751    AddToReadyQ(RunQueue[Item^.RunPriority], Item)
 752 END AddToReady ;
 753
 754
 755 (*
 756    AddToReadyQ - adds item, Item, to the ready queue defined by Head.
 757 *)
 758
 759 PROCEDURE AddToReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 760 BEGIN
 761    IF Head=NIL
 762    THEN
 763       Head := Item ;                         (* Head is empty therefore make *)
 764       Item^.ReadyQ.Left := Item ;            (* Item the only entry on this  *)
 765       Item^.ReadyQ.Right := Item             (* queue.                       *)
 766    ELSE
 767       Item^.ReadyQ.Right := Head ;           (* Add Item to the end of queue *)
 768       Item^.ReadyQ.Left  := Head^.ReadyQ.Left ;
 769       Head^.ReadyQ.Left^.ReadyQ.Right := Item ;
 770       Head^.ReadyQ.Left := Item
 771    END
 772 END AddToReadyQ ;
 773
 774
 775 (*
 776    SubFromReady - subtract process descriptor, Item, from the Ready queue.
 777 *)
 778
 779 PROCEDURE SubFromReady (Item: DESCRIPTOR) ;
 780 BEGIN
 781    SubFromReadyQ(RunQueue[Item^.RunPriority], Item)
 782 END SubFromReady ;
 783
 784
 785 (*
 786    SubFromReadyQ - removes a process, Item, from a queue, Head.
 787 *)
 788
 789 PROCEDURE SubFromReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 790 BEGIN
 791    IF (Item^.ReadyQ.Right=Head) AND (Item=Head)
 792    THEN
 793       Head := NIL
 794    ELSE
 795       IF Head=Item
 796       THEN
 797          Head := Head^.ReadyQ.Right
 798       END ;
 799       Item^.ReadyQ.Left^.ReadyQ.Right := Item^.ReadyQ.Right ;
 800       Item^.ReadyQ.Right^.ReadyQ.Left := Item^.ReadyQ.Left
 801    END
 802 END SubFromReadyQ ;
 803
 804
 805 (*
 806    SubFromSemaphoreTop - returns the first descriptor in the
 807                          semaphore queue.
 808 *)
 809
 810 PROCEDURE SubFromSemaphoreTop (VAR Head: DESCRIPTOR) : DESCRIPTOR ;
 811 VAR
 812    Top: DESCRIPTOR ;
 813 BEGIN
 814    Top := Head ;
 815    SubFromSemaphore(Head, Top) ;
 816    RETURN( Top )
 817 END SubFromSemaphoreTop ;
 818
 819
 820 (*
 821    SubFromSemaphore - removes a process, Item, from a queue, Head.
 822 *)
 823
 824 PROCEDURE SubFromSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 825 BEGIN
 826    IF (Item^.SemaphoreQ.Right=Head) AND (Item=Head)
 827    THEN
 828       Head := NIL
 829    ELSE
 830       IF Head=Item
 831       THEN
 832          Head := Head^.SemaphoreQ.Right
 833       END ;
 834       Item^.SemaphoreQ.Left^.SemaphoreQ.Right := Item^.SemaphoreQ.Right ;
 835       Item^.SemaphoreQ.Right^.SemaphoreQ.Left := Item^.SemaphoreQ.Left
 836    END
 837 END SubFromSemaphore ;
 838
 839
 840 (*
 841    Idle - this process is only run whenever there is no other Runnable
 842           process. It should never be removed from the run queue.
 843 *)
 844
 845 PROCEDURE Idle ;
 846 VAR
 847    ToOldState: PROTECTION ;
 848 BEGIN
 849    ToOldState := TurnInterrupts(MIN(PROTECTION)) ;    (* enable interrupts *)
 850    LOOP
 851       (*
 852          Listen for interrupts.
 853          We could solve chess endgames here or calculate PI etc.
 854          We forever wait for an interrupt since there is nothing else
 855          to do...
 856       *)
 857       ListenLoop
 858    END
 859    (* we must NEVER exit from the above loop *)
 860 END Idle ;
 861
 862
 863 (*
 864    InitIdleProcess - creates an idle process descriptor which
 865                      is run whenever no other process is Runnable.
 866                      The Idle process should be the only process which
 867                      has the priority idle.
 868 *)
 869
 870 VAR
 871    IdleProcess: DESCRIPTOR ;              (* Idle process always runnable  *)
 872
 873 PROCEDURE InitIdleProcess ;
 874 VAR
 875    db         : ARRAY [0..80] OF CHAR ;
 876 BEGIN
 877    NEW(IdleProcess) ;
 878    WITH IdleProcess^ DO
 879       ALLOCATE(Start, IdleStackSize) ;
 880       Size := IdleStackSize ;
 881       NEWPROCESS(Idle, Start, IdleStackSize, Volatiles) ;
 882       InitQueue(SemaphoreQ) ;             (* not on a semaphore queue     *)
 883       Which      := NIL ;                 (* at all.                      *)
 884       StrCopy('Idle', RunName) ;          (* idle process's name          *)
 885       Status := Runnable ;                (* should always be idle        *)
 886       RunPriority := idle ;               (* lowest priority possible     *)
 887       Debugged    := FALSE ;              (* should never be debugging    *)
 888    END ;
 889    AddToReady(IdleProcess) ;              (* should be the only           *)
 890                                           (* process at this run priority *)
 891    AddToExists(IdleProcess)               (* process now exists..         *)
 892 END InitIdleProcess ;
 893
 894
 895 (*
 896    InitInitProcess - creates a descriptor for this running environment
 897                      so it too can be manipulated by Reschedule.
 898
 899                      This concept is important to understand.
 900                      InitInitProcess is called by the startup code to this
 901                      module. It ensures that the current stack and processor
 902                      volatiles can be "housed" in a process descriptor and
 903                      therefore it can be manipulated just like any other
 904                      process.
 905 *)
 906
 907 PROCEDURE InitInitProcess ;
 908 BEGIN
 909    NEW(CurrentProcess) ;
 910    WITH CurrentProcess^ DO
 911       Size := 0 ;              (* we dont know the size of main stack  *)
 912       Start := NIL ;           (* we don't need to know where it is.   *)
 913       InitQueue(ReadyQ) ;      (* assign queues to NIL                 *)
 914       InitQueue(ExistsQ) ;
 915       InitQueue(SemaphoreQ) ;  (* not waiting on a semaphore queue yet *)
 916       Which       := NIL ;     (* at all.                              *)
 917       StrCopy('Init', RunName) ;  (* name for debugging purposes       *)
 918       Status      := Runnable ;   (* currently running                 *)
 919       RunPriority := lo ;         (* default status                    *)
 920       Debugged    := FALSE ;      (* not deadlock debugging yet        *)
 921    END ;
 922    AddToExists(CurrentProcess) ;
 923    AddToReady(CurrentProcess)
 924 END InitInitProcess ;
 925
 926
 927 (*
 928    InitQueue - initializes a queue, q, to empty.
 929 *)
 930
 931 PROCEDURE InitQueue (VAR q: DesQueue) ;
 932 BEGIN
 933    WITH q DO
 934       Right := NIL ;
 935       Left  := NIL
 936    END
 937 END InitQueue ;
 938
 939
 940 (*
 941    Init - initializes all the global variables.
 942 *)
 943
 944 PROCEDURE Init ;
 945 BEGIN
 946    ExistsQueue := NIL ;
 947    RunQueue[lo] := NIL ;
 948    RunQueue[hi] := NIL ;
 949    RunQueue[idle] := NIL ;
 950    AllSemaphores := NIL ;
 951    GarbageItem := NIL ;
 952    InitInitProcess ;
 953    InitIdleProcess
 954 END Init ;
 955
 956
 957 BEGIN
 958    Init
 959 END Executive.