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

   1 (* Executive.mod provides a simple multitasking executive.
   2
   3 Copyright (C) 2002-2022 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(file, line, function, 'assert failed')
 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
 182    (* your code needs to go here *)
 183    WITH d^ DO                                                                  (* remove for student *)
 184       IF Status=Suspended                                                      (* remove for student *)
 185       THEN                                                                     (* remove for student *)
 186          (* legal state transition *)                                          (* remove for student *)
 187          Status := Runnable ;                         (* change status      *) (* remove for student *)
 188          AddToReady(d) ;                              (* add to run queue   *) (* remove for student *)
 189          RunQueue[RunPriority] := d ;                 (* make d at top of q *) (* remove for student *)
 190          Reschedule (* check whether this process has a higher run priority *) (* remove for student *)
 191       ELSE                                                                     (* remove for student *)
 192          (* we are trying to Resume a process which is *)                      (* remove for student *)
 193          Halt(__FILE__, __LINE__, __FUNCTION__,                                (* remove for student *)
 194               'trying to resume a process which is not suspended') ;           (* remove for student *)
 195          RETURN( NIL )        (* not held in a Suspended state - error      *) (* remove for student *)
 196       END                                                                      (* remove for student *)
 197    END ;                                                                       (* remove for student *)
 198 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 199    RETURN( d )
 200 END Resume ;
 201
 202
 203 (*
 204    Suspend - suspend the calling process.
 205              The process can only continue running if another process
 206              Resumes it.
 207 *)
 208
 209 PROCEDURE Suspend ;
 210 VAR
 211    ToOldState: PROTECTION ;
 212 BEGIN
 213 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 214    WITH CurrentProcess^ DO
 215       Status := Suspended
 216    END ;
 217    SubFromReady(CurrentProcess) ;
 218    Reschedule ;
 219 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 220 END Suspend ;
 221
 222
 223 (*
 224    InitSemaphore - creates a semaphore whose initial value is, v, and
 225                    whose name is, Name.
 226 *)
 227
 228 PROCEDURE InitSemaphore (v: CARDINAL; Name: ARRAY OF CHAR) : SEMAPHORE ;
 229 VAR
 230    s         : SEMAPHORE ;
 231    ToOldState: PROTECTION ;
 232 BEGIN
 233 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 234    NEW(s) ;
 235    WITH s^ DO
 236       Value := v ;                  (* initial value of semaphore           *)
 237       StrCopy(Name, SemName) ;      (* save the name for future debugging   *)
 238       Who := NIL ;                  (* no one waiting on this semaphore yet *)
 239       AddToSemaphoreExists(s) ;     (* add semaphore to exists list         *)
 240    END ;
 241 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 242    RETURN( s )
 243 END InitSemaphore ;
 244
 245
 246 (*
 247    Wait - performs dijkstra's P operation on a semaphore.
 248           A process which calls this procedure will
 249           wait until the value of the semaphore is > 0
 250           and then it will decrement this value.
 251 *)
 252
 253 PROCEDURE Wait (s: SEMAPHORE) ;
 254 VAR
 255    ToOldState: PROTECTION ;
 256 BEGIN
 257 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 258
 259    (* your code needs to go here *)
 260    WITH s^ DO                                                                  (* remove for student *)
 261       IF Value>0                                                               (* remove for student *)
 262       THEN                                                                     (* remove for student *)
 263          DEC( Value )                                                          (* remove for student *)
 264       ELSE                                                                     (* remove for student *)
 265          SubFromReady(CurrentProcess) ;               (* remove from run q  *) (* remove for student *)
 266          IF Who=CurrentProcess
 267          THEN
 268             Ps ;
 269             Halt(__FILE__, __LINE__, __FUNCTION__, 'we are already on sem')
 270          END ;
 271          AddToSemaphore(Who, CurrentProcess) ;        (* add to semaphore q *) (* remove for student *)
 272          CurrentProcess^.Status := WaitOnSem ;        (* set new status     *) (* remove for student *)
 273          CurrentProcess^.Which := s ;                 (* debugging aid      *) (* remove for student *)
 274          Reschedule                                   (* find next process  *) (* remove for student *)
 275       END                                                                      (* remove for student *)
 276    END ;                                                                       (* remove for student *)
 277 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 278 END Wait ;
 279
 280
 281 (*
 282    Signal - performs dijkstra's V operation on a semaphore.
 283             A process which calls the procedure will increment
 284             the semaphores value.
 285 *)
 286
 287 PROCEDURE Signal (s: SEMAPHORE) ;
 288 VAR
 289    ToOldState: PROTECTION ;
 290    d         : DESCRIPTOR ;
 291 BEGIN
 292 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 293    WITH s^ DO
 294       IF Who=NIL
 295       THEN
 296          INC( Value )                                 (* no process waiting *)
 297       ELSE
 298          d := SubFromSemaphoreTop(Who) ; (* remove process from semaphore q *)
 299          d^.Which := NIL ;              (* no longer waiting on semaphore   *)
 300          d^.Status := Runnable ;        (* set new status                   *)
 301          AddToReady(d) ;                (* add process to the run queue     *)
 302          Reschedule                     (* find out whether there is a      *)
 303                                         (* higher priority to run.          *)
 304       END
 305    END ;
 306 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 307 END Signal ;
 308
 309
 310 (*
 311    WaitForIO - waits for an interrupt to occur on vector, VectorNo.
 312 *)
 313
 314 PROCEDURE WaitForIO (VectorNo: CARDINAL) ;
 315 VAR
 316    Calling   : DESCRIPTOR ;
 317    Next      : PROCESS ;
 318    ToOldState: PROTECTION ;
 319    r         : INTEGER ;
 320 BEGIN
 321 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
 322 (*
 323    DebugString('inside WaitForIO ') ;
 324    DebugString(CurrentProcess^.RunName) ;
 325    DebugString('\n') ;
 326 *)
 327    Assert(CurrentProcess^.Status=Runnable,
 328           __FILE__, __LINE__, __FUNCTION__) ;
 329    SubFromReady(CurrentProcess) ;   (* remove process from run queue *)
 330    (*
 331       alter run priority to hi as all processes waiting for an interrupt
 332       are scheduled to run at the highest priority.
 333    *)
 334    WITH CurrentProcess^ DO
 335       Status := WaitOnInt ;   (* it will be blocked waiting for an interrupt.  *)
 336       RunPriority := hi ;     (* this (hopefully) allows it to run as soon as  *)
 337                               (* the interrupt occurs.                         *)
 338    END ;
 339    Calling := CurrentProcess ;      (* process which called WaitForIO          *)
 340    CurrentProcess := NextReady() ;  (* find next process to run while we wait  *)
 341    Next := CurrentProcess^.Volatiles ;
 342    (*
 343       This is quite complicated. We transfer control to the next process saving
 344       our volatile environment into the Calling process descriptor volatiles.
 345       When an interrupt occurs the calling process will be resumed and the
 346       interrupted process volatiles will be placed into Next.
 347    *)
 348    IOTRANSFER(Calling^.Volatiles, Next, VectorNo) ;
 349
 350    (*
 351       At this point the interrupt has just occurred and the volatiles of
 352       the interrupted process are in Next. Next is the current process
 353       and so we must save them before picking up the Calling descriptor.
 354    *)
 355
 356    CurrentProcess^.Volatiles := Next ;             (* carefully stored away *)
 357    CurrentProcess := Calling ;                     (* update CurrentProcess *)
 358 (*
 359    DebugString(CurrentProcess^.RunName) ;
 360 *)
 361    CurrentProcess^.Status := Runnable ;            (* add to run queue      *)
 362    AddToReady(CurrentProcess) ;
 363 (*
 364    DebugString(' finishing WaitForIO\n') ;
 365 *)
 366
 367 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 368 END WaitForIO ;
 369
 370
 371 (*
 372    Ps - displays a process list together with relevant their status.
 373 *)
 374
 375 PROCEDURE Ps ;
 376 VAR
 377    ToOldState: PROTECTION ;
 378    p         : DESCRIPTOR ;
 379    s         : SEMAPHORE ;
 380    a         : ARRAY [0..5] OF CHAR ;
 381 BEGIN
 382 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 383    p := ExistsQueue ;
 384    IF p#NIL
 385    THEN
 386       REPEAT
 387          DisplayProcess(p) ;
 388          p := p^.ExistsQ.Right
 389       UNTIL p=ExistsQueue
 390    END ;
 391    s := AllSemaphores ;
 392    IF s#NIL
 393    THEN
 394       REPEAT
 395          WITH s^ DO
 396             DebugString(SemName) ;
 397             WriteNSpaces(MaxCharsInName-StrLen(SemName)) ;
 398             CardToStr(Value, 0, a) ;
 399             DebugString(a) ;
 400             DebugString('\n')
 401          END ;
 402          s := s^.ExistsQ.Right
 403       UNTIL s=AllSemaphores
 404    END ;
 405 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 406 END Ps ;
 407
 408
 409 (*
 410    DisplayProcess - displays the process, p, together with its status.
 411 *)
 412
 413 PROCEDURE DisplayProcess (p: DESCRIPTOR) ;
 414 VAR
 415    a: ARRAY [0..4] OF CHAR ;
 416 BEGIN
 417    WITH p^ DO
 418       DebugString(RunName) ; WriteNSpaces(MaxCharsInName-StrLen(RunName)) ;
 419       CASE RunPriority OF
 420
 421       idle: DebugString(' idle ') |
 422       lo  : DebugString(' lo   ') |
 423       hi  : DebugString(' hi   ')
 424
 425       END ;
 426       CASE Status OF
 427
 428       Runnable : DebugString('runnable ') |
 429       Suspended: DebugString('suspended') |
 430       WaitOnSem: DebugString('waitonsem   (') ;
 431                  DebugString(Which^.SemName) ;
 432                  DebugString(')') |
 433       WaitOnInt: DebugString('waitonint')
 434
 435       END ;
 436       DebugString('\n')
 437    END
 438 END DisplayProcess ;
 439
 440
 441 (*
 442    WriteNSpaces - writes, n, spaces.
 443 *)
 444
 445 PROCEDURE WriteNSpaces (n: CARDINAL) ;
 446 BEGIN
 447    WHILE n>0 DO
 448       DebugString(' ') ;
 449       DEC(n)
 450    END
 451 END WriteNSpaces ;
 452
 453
 454 (*
 455    GetCurrentProcess - returns the descriptor of the current running
 456                        process.
 457 *)
 458
 459 PROCEDURE GetCurrentProcess () : DESCRIPTOR ;
 460 VAR
 461    ToOldState: PROTECTION ;
 462    p         : DESCRIPTOR ;
 463 BEGIN
 464 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;      (* disable interrupts *) *)
 465    p := CurrentProcess ;
 466 (* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
 467    RETURN( p )
 468 END GetCurrentProcess ;
 469
 470
 471 (*
 472    RotateRunQueue - rotates the process run queue.
 473 *)
 474
 475 PROCEDURE RotateRunQueue ;
 476 VAR
 477    ToOldState: PROTECTION ;
 478 BEGIN
 479 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
 480    (* we only need to rotate the lo priority processes as:
 481       idle - should only have one process (the idle process)
 482       hi   - are the device drivers which most of the time are performing
 483              WaitForIO
 484    *)
 485    IF RunQueue[lo]#NIL
 486    THEN
 487       RunQueue[lo] := RunQueue[lo]^.ReadyQ.Right
 488    END ;
 489 (* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
 490 END RotateRunQueue ;
 491
 492
 493 (*
 494    ProcessName - displays the name of process, d, through
 495                  DebugString.
 496 *)
 497
 498 PROCEDURE ProcessName (d: DESCRIPTOR) ;
 499 BEGIN
 500    DebugString(d^.RunName)
 501 END ProcessName ;
 502
 503
 504 (*
 505    DebugProcess -
 506 *)
 507
 508 PROCEDURE DebugProcess (d: DESCRIPTOR) ;
 509 VAR
 510    ToOldState: PROTECTION ;
 511 BEGIN
 512 (* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
 513    WITH d^ DO
 514       IF Status=WaitOnSem
 515       THEN
 516          DebugString('debugging process (') ;
 517          DebugString(RunName) ;
 518          DebugString(') was waiting on semaphore (') ;
 519          DebugString(Which^.SemName) ;
 520          DebugString(')\n') ;
 521          SubFromSemaphore(Which^.Who, d) ;
 522          AddToReady(d) ;
 523          Status := Runnable ;
 524          Debugged := TRUE ;
 525          Reschedule
 526       ELSE
 527          DebugString('can only debug deadlocked processes (') ;
 528          DebugString(RunName) ;
 529          DebugString(') which are waiting on a semaphore\n')
 530       END
 531    END ;
 532 (* ToOldState := TurnInterrupts(ToOldState) *)
 533 END DebugProcess ;
 534
 535
 536 (*
 537    CheckDebugged - checks to see whether the debugged flag has
 538                    been set by the debugger.
 539                    TRUE  is returned if the process was debugged.
 540                    FALSE is returned if the process was not debugged.
 541 *)
 542
 543 PROCEDURE CheckDebugged () : BOOLEAN ;
 544 BEGIN
 545    WITH CurrentProcess^ DO
 546       IF Debugged
 547       THEN
 548          (*
 549             You will see this comment after you have enabled a
 550             deadlocked process to continue via the gdb command:
 551
 552             print Executive_DebugProcess(d)
 553
 554             debugger caused deadlocked process to continue
 555          *)
 556          (* gdb.breakpoint ; *)
 557          Debugged := FALSE ;
 558          SubFromReady(CurrentProcess) ;
 559          AddToSemaphore(Which^.Who, CurrentProcess) ;
 560                                            (* add it back to the queue sem *)
 561          Status := WaitOnSem ;
 562
 563          RETURN( TRUE )
 564       END
 565    END ;
 566    RETURN( FALSE )
 567 END CheckDebugged ;
 568
 569
 570 (*
 571    Reschedule - reschedules to the highest runnable process.
 572 *)
 573
 574 PROCEDURE Reschedule ;
 575 BEGIN
 576    (*
 577       the repeat loop allows us to debug a process even when it is
 578       technically waiting on a semaphore. We run the process into
 579       a breakpoint and then back into this schedule routine.
 580       This is really useful when trying to find out why processes have
 581       deadlocked.
 582    *)
 583    REPEAT
 584       ScheduleProcess
 585    UNTIL NOT CheckDebugged()
 586 END Reschedule ;
 587
 588
 589 (*
 590    ScheduleProcess - finds the highest priority Runnable process and
 591                      then transfers control to it.
 592 *)
 593
 594 PROCEDURE ScheduleProcess ;
 595 VAR
 596    From,
 597    Highest: DESCRIPTOR ;
 598 BEGIN
 599    Highest := NextReady() ;
 600
 601    (* rotate ready Q to ensure fairness *)
 602    RunQueue[Highest^.RunPriority] := Highest^.ReadyQ.Right ;
 603
 604    (* no need to transfer if Highest=CurrentProcess *)
 605    IF Highest#CurrentProcess
 606    THEN
 607       From := CurrentProcess ;
 608 (*
 609       DebugString('context switching from ') ; DebugString(From^.RunName) ;
 610 *)
 611       (* alter CurrentProcess before we TRANSFER *)
 612       CurrentProcess := Highest ;
 613 (*
 614       DebugString(' to ') ; DebugString(CurrentProcess^.RunName) ;
 615 *)
 616
 617       TRANSFER(From^.Volatiles, Highest^.Volatiles) ;
 618 (*
 619       ; DebugString(' (') ; DebugString(CurrentProcess^.RunName) ;
 620       DebugString(')\n') ;
 621 *)
 622       CheckGarbageCollect
 623    END
 624 END ScheduleProcess ;
 625
 626
 627 (*
 628    NextReady - returns the highest priority Runnable process.
 629 *)
 630
 631 PROCEDURE NextReady () : DESCRIPTOR ;
 632 VAR
 633    Highest: DESCRIPTOR ;
 634    Pri    : Priority ;
 635 BEGIN
 636    Highest := NIL ;
 637    FOR Pri := idle TO hi DO
 638       IF RunQueue[Pri]#NIL
 639       THEN
 640          Highest := RunQueue[Pri]
 641       END
 642    END ;
 643    Assert(Highest#NIL, __FILE__, __LINE__, __FUNCTION__) ;
 644    RETURN( Highest )
 645 END NextReady ;
 646
 647
 648 (*
 649    CheckGarbageCollect - checks to see whether GarbageItem is set
 650                          and if so it deallocates storage associated
 651                          with this descriptor.
 652 *)
 653
 654 PROCEDURE CheckGarbageCollect ;
 655 BEGIN
 656    IF GarbageItem#NIL
 657    THEN
 658       WITH GarbageItem^ DO
 659          DEALLOCATE(Start, Size)
 660       END ;
 661       DISPOSE(GarbageItem) ;
 662       GarbageItem := NIL
 663    END
 664 END CheckGarbageCollect ;
 665
 666
 667 (*
 668    AddToExists - adds item, Item, to the exists queue.
 669 *)
 670
 671 PROCEDURE AddToExists (Item: DESCRIPTOR) ;
 672 BEGIN
 673    IF ExistsQueue=NIL
 674    THEN
 675       ExistsQueue := Item ;                  (* Head is empty therefore make *)
 676       Item^.ExistsQ.Left := Item ;           (* Item the only entry on this  *)
 677       Item^.ExistsQ.Right := Item            (* queue.                       *)
 678    ELSE
 679       Item^.ExistsQ.Right := ExistsQueue ;   (* Add Item to the end of queue *)
 680       Item^.ExistsQ.Left  := ExistsQueue^.ExistsQ.Left ;
 681       ExistsQueue^.ExistsQ.Left^.ExistsQ.Right := Item ;
 682       ExistsQueue^.ExistsQ.Left := Item
 683    END
 684 END AddToExists ;
 685
 686
 687 (*
 688    SubFromExists - removes a process, Item, from the exists queue, Head.
 689 *)
 690
 691 PROCEDURE SubFromExists (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 692 BEGIN
 693    IF (Item^.ExistsQ.Right=Head) AND (Item=Head)
 694    THEN
 695       Head := NIL
 696    ELSE
 697       IF Head=Item
 698       THEN
 699          Head := Head^.ExistsQ.Right
 700       END ;
 701       Item^.ExistsQ.Left^.ExistsQ.Right := Item^.ExistsQ.Right ;
 702       Item^.ExistsQ.Right^.ExistsQ.Left := Item^.ExistsQ.Left
 703    END
 704 END SubFromExists ;
 705
 706
 707 (*
 708    AddToSemaphore - adds item, Item, to the semaphore queue defined by Head.
 709 *)
 710
 711 PROCEDURE AddToSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 712 BEGIN
 713    IF Head=NIL
 714    THEN
 715       Head := Item ;                         (* Head is empty therefore make *)
 716       Item^.SemaphoreQ.Left := Item ;        (* Item the only entry on this  *)
 717       Item^.SemaphoreQ.Right := Item         (* queue.                       *)
 718    ELSE
 719       Item^.SemaphoreQ.Right := Head ;       (* Add Item to the end of queue *)
 720       Item^.SemaphoreQ.Left  := Head^.SemaphoreQ.Left ;
 721       Head^.SemaphoreQ.Left^.SemaphoreQ.Right := Item ;
 722       Head^.SemaphoreQ.Left := Item
 723    END
 724 END AddToSemaphore ;
 725
 726
 727 (*
 728    AddToSemaphoreExists - adds item, Item, to the semaphore exists queue.
 729 *)
 730
 731 PROCEDURE AddToSemaphoreExists (Item: SEMAPHORE) ;
 732 BEGIN
 733    IF AllSemaphores=NIL
 734    THEN
 735       AllSemaphores := Item ;                (* Head is empty therefore make *)
 736       Item^.ExistsQ.Left := Item ;           (* Item the only entry on this  *)
 737       Item^.ExistsQ.Right := Item            (* queue.                       *)
 738    ELSE
 739       Item^.ExistsQ.Right := AllSemaphores ;
 740                                              (* Add Item to the end of queue *)
 741       Item^.ExistsQ.Left  := AllSemaphores^.ExistsQ.Left ;
 742       AllSemaphores^.ExistsQ.Left^.ExistsQ.Right := Item ;
 743       AllSemaphores^.ExistsQ.Left := Item
 744    END
 745 END AddToSemaphoreExists ;
 746
 747
 748 (*
 749    AddToReady - adds item, Item, to the ready queue.
 750 *)
 751
 752 PROCEDURE AddToReady (Item: DESCRIPTOR) ;
 753 BEGIN
 754    AddToReadyQ(RunQueue[Item^.RunPriority], Item)
 755 END AddToReady ;
 756
 757
 758 (*
 759    AddToReadyQ - adds item, Item, to the ready queue defined by Head.
 760 *)
 761
 762 PROCEDURE AddToReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 763 BEGIN
 764    IF Head=NIL
 765    THEN
 766       Head := Item ;                         (* Head is empty therefore make *)
 767       Item^.ReadyQ.Left := Item ;            (* Item the only entry on this  *)
 768       Item^.ReadyQ.Right := Item             (* queue.                       *)
 769    ELSE
 770       Item^.ReadyQ.Right := Head ;           (* Add Item to the end of queue *)
 771       Item^.ReadyQ.Left  := Head^.ReadyQ.Left ;
 772       Head^.ReadyQ.Left^.ReadyQ.Right := Item ;
 773       Head^.ReadyQ.Left := Item
 774    END
 775 END AddToReadyQ ;
 776
 777
 778 (*
 779    SubFromReady - subtract process descriptor, Item, from the Ready queue.
 780 *)
 781
 782 PROCEDURE SubFromReady (Item: DESCRIPTOR) ;
 783 BEGIN
 784    SubFromReadyQ(RunQueue[Item^.RunPriority], Item)
 785 END SubFromReady ;
 786
 787
 788 (*
 789    SubFromReadyQ - removes a process, Item, from a queue, Head.
 790 *)
 791
 792 PROCEDURE SubFromReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 793 BEGIN
 794    IF (Item^.ReadyQ.Right=Head) AND (Item=Head)
 795    THEN
 796       Head := NIL
 797    ELSE
 798       IF Head=Item
 799       THEN
 800          Head := Head^.ReadyQ.Right
 801       END ;
 802       Item^.ReadyQ.Left^.ReadyQ.Right := Item^.ReadyQ.Right ;
 803       Item^.ReadyQ.Right^.ReadyQ.Left := Item^.ReadyQ.Left
 804    END
 805 END SubFromReadyQ ;
 806
 807
 808 (*
 809    SubFromSemaphoreTop - returns the first descriptor in the
 810                          semaphore queue.
 811 *)
 812
 813 PROCEDURE SubFromSemaphoreTop (VAR Head: DESCRIPTOR) : DESCRIPTOR ;
 814 VAR
 815    Top: DESCRIPTOR ;
 816 BEGIN
 817    Top := Head ;
 818    SubFromSemaphore(Head, Top) ;
 819    RETURN( Top )
 820 END SubFromSemaphoreTop ;
 821
 822
 823 (*
 824    SubFromSemaphore - removes a process, Item, from a queue, Head.
 825 *)
 826
 827 PROCEDURE SubFromSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
 828 BEGIN
 829    IF (Item^.SemaphoreQ.Right=Head) AND (Item=Head)
 830    THEN
 831       Head := NIL
 832    ELSE
 833       IF Head=Item
 834       THEN
 835          Head := Head^.SemaphoreQ.Right
 836       END ;
 837       Item^.SemaphoreQ.Left^.SemaphoreQ.Right := Item^.SemaphoreQ.Right ;
 838       Item^.SemaphoreQ.Right^.SemaphoreQ.Left := Item^.SemaphoreQ.Left
 839    END
 840 END SubFromSemaphore ;
 841
 842
 843 (*
 844    Idle - this process is only run whenever there is no other Runnable
 845           process. It should never be removed from the run queue.
 846 *)
 847
 848 PROCEDURE Idle ;
 849 VAR
 850    ToOldState: PROTECTION ;
 851 BEGIN
 852    ToOldState := TurnInterrupts(MIN(PROTECTION)) ;    (* enable interrupts *)
 853    LOOP
 854       (*
 855          Listen for interrupts.
 856          We could solve chess endgames here or calculate PI etc.
 857          We forever wait for an interrupt since there is nothing else
 858          to do...
 859       *)
 860       ListenLoop
 861    END
 862    (* we must NEVER exit from the above loop *)
 863 END Idle ;
 864
 865
 866 (*
 867    InitIdleProcess - creates an idle process descriptor which
 868                      is run whenever no other process is Runnable.
 869                      The Idle process should be the only process which
 870                      has the priority idle.
 871 *)
 872
 873 VAR
 874    IdleProcess: DESCRIPTOR ;              (* Idle process always runnable  *)
 875
 876 PROCEDURE InitIdleProcess ;
 877 VAR
 878    db         : ARRAY [0..80] OF CHAR ;
 879 BEGIN
 880    NEW(IdleProcess) ;
 881    WITH IdleProcess^ DO
 882       ALLOCATE(Start, IdleStackSize) ;
 883       Size := IdleStackSize ;
 884       NEWPROCESS(Idle, Start, IdleStackSize, Volatiles) ;
 885       InitQueue(SemaphoreQ) ;             (* not on a semaphore queue     *)
 886       Which      := NIL ;                 (* at all.                      *)
 887       StrCopy('Idle', RunName) ;          (* idle process's name          *)
 888       Status := Runnable ;                (* should always be idle        *)
 889       RunPriority := idle ;               (* lowest priority possible     *)
 890       Debugged    := FALSE ;              (* should never be debugging    *)
 891    END ;
 892    AddToReady(IdleProcess) ;              (* should be the only           *)
 893                                           (* process at this run priority *)
 894    AddToExists(IdleProcess)               (* process now exists..         *)
 895 END InitIdleProcess ;
 896
 897
 898 (*
 899    InitInitProcess - creates a descriptor for this running environment
 900                      so it too can be manipulated by Reschedule.
 901
 902                      This concept is important to understand.
 903                      InitInitProcess is called by the startup code to this
 904                      module. It ensures that the current stack and processor
 905                      volatiles can be "housed" in a process descriptor and
 906                      therefore it can be manipulated just like any other
 907                      process.
 908 *)
 909
 910 PROCEDURE InitInitProcess ;
 911 BEGIN
 912    NEW(CurrentProcess) ;
 913    WITH CurrentProcess^ DO
 914       Size := 0 ;              (* we dont know the size of main stack  *)
 915       Start := NIL ;           (* we don't need to know where it is.   *)
 916       InitQueue(ReadyQ) ;      (* assign queues to NIL                 *)
 917       InitQueue(ExistsQ) ;
 918       InitQueue(SemaphoreQ) ;  (* not waiting on a semaphore queue yet *)
 919       Which       := NIL ;     (* at all.                              *)
 920       StrCopy('Init', RunName) ;  (* name for debugging purposes       *)
 921       Status      := Runnable ;   (* currently running                 *)
 922       RunPriority := lo ;         (* default status                    *)
 923       Debugged    := FALSE ;      (* not deadlock debugging yet        *)
 924    END ;
 925    AddToExists(CurrentProcess) ;
 926    AddToReady(CurrentProcess)
 927 END InitInitProcess ;
 928
 929
 930 (*
 931    InitQueue - initializes a queue, q, to empty.
 932 *)
 933
 934 PROCEDURE InitQueue (VAR q: DesQueue) ;
 935 BEGIN
 936    WITH q DO
 937       Right := NIL ;
 938       Left  := NIL
 939    END
 940 END InitQueue ;
 941
 942
 943 (*
 944    Init - initializes all the global variables.
 945 *)
 946
 947 PROCEDURE Init ;
 948 BEGIN
 949    ExistsQueue := NIL ;
 950    RunQueue[lo] := NIL ;
 951    RunQueue[hi] := NIL ;
 952    RunQueue[idle] := NIL ;
 953    AllSemaphores := NIL ;
 954    GarbageItem := NIL ;
 955    InitInitProcess ;
 956    InitIdleProcess
 957 END Init ;
 958
 959
 960 BEGIN
 961    Init
 962 END Executive.