(* Executive.mod provides a simple multitasking executive.
Copyright (C) 2002-2025 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE Executive[MAX(PROTECTION)] ;
FROM SYSTEM IMPORT ADDRESS, PROCESS, LISTEN, ADR,
NEWPROCESS, TRANSFER, IOTRANSFER, ListenLoop,
TurnInterrupts ;
FROM COROUTINES IMPORT PROTECTION ;
FROM SysStorage IMPORT ALLOCATE, DEALLOCATE ;
FROM StrLib IMPORT StrCopy ;
FROM StrLib IMPORT StrLen ;
FROM NumberIO IMPORT CardToStr ;
FROM Debug IMPORT DebugString, Halt ;
(* IMPORT gdb ; *)
CONST
MaxCharsInName = 15 ;
IdleStackSize = 16 * 1024 * 1024 ;
TYPE
SEMAPHORE = POINTER TO Semaphore ; (* defines dijkstra's semaphores *)
Semaphore = RECORD
Value : CARDINAL ; (* semaphore value *)
SemName: EntityName ; (* semaphore name for debugging *)
Who : DESCRIPTOR ; (* queue of waiting processes *)
ExistsQ: SemQueue ; (* list of existing semaphores *)
END ;
DESCRIPTOR= POINTER TO Descriptor ; (* handle onto a process *)
Descriptor= RECORD
Volatiles : PROCESS ; (* process volatile environment *)
ReadyQ : DesQueue ; (* queue of ready processes *)
ExistsQ : DesQueue ; (* queue of existing processes *)
SemaphoreQ : DesQueue ; (* queue of waiting processes *)
Which : SEMAPHORE ; (* which semaphore are we waiting*)
RunName : EntityName ; (* process name for debugging *)
Status : State ; (* state of process *)
RunPriority: Priority ; (* runtime priority of process *)
Size : CARDINAL ; (* Maximum stack size *)
Start : ADDRESS ; (* Stack start *)
Debugged : BOOLEAN ; (* Does user want to debug a *)
(* deadlocked process? *)
END ;
DesQueue = RECORD
Right,
Left : DESCRIPTOR ;
END ;
SemQueue = RECORD
Right,
Left : SEMAPHORE ;
END ;
EntityName= ARRAY [0..MaxCharsInName] OF CHAR ;
Priority = (idle, lo, hi) ; (* process run priority *)
State = (Runnable, Suspended, WaitOnSem, WaitOnInt) ;
VAR
ExistsQueue : DESCRIPTOR ; (* List of existing processes *)
RunQueue : ARRAY Priority OF DESCRIPTOR ;
(* List of runnable processes *)
CurrentProcess: DESCRIPTOR ;
AllSemaphores : SEMAPHORE ; (* List of all semaphores *)
GarbageItem : DESCRIPTOR ; (* Descriptor destined to free *)
(*
Assert -
*)
PROCEDURE Assert (c: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL;
function: ARRAY OF CHAR) ;
BEGIN
IF NOT c
THEN
Ps ;
Halt ('assert failed', file, function, line)
END
END Assert ;
(*
InitProcess - initializes a process which is held in the suspended
state. When the process is resumed it will start executing
procedure, p. The process has a maximum stack size of,
StackSize, bytes and its textual name is, Name.
The StackSize should be at least 5000 bytes.
*)
PROCEDURE InitProcess (p: PROC;
StackSize: CARDINAL;
Name: ARRAY OF CHAR) : DESCRIPTOR ;
VAR
d : DESCRIPTOR ;
ToOldState: PROTECTION ;
db : ARRAY [0..80] OF CHAR ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
NEW(d) ;
WITH d^ DO
Size := StackSize ;
(* allocate space for this processes stack *)
ALLOCATE(Start, StackSize) ;
NEWPROCESS(p, Start, StackSize, Volatiles) ; (* create volatiles *)
InitQueue(ReadyQ) ; (* not on the ready queue as suspended *)
AddToExists(d) ; (* add process to the exists queue *)
InitQueue(SemaphoreQ) ; (* not on a semaphore queue yet *)
Which := NIL ; (* not on a semaphore queue yet *)
StrCopy(Name, RunName) ; (* copy name into descriptor for debugging *)
Status := Suspended ; (* this process will be suspended *)
RunPriority := lo ; (* all processes start off at lo priority *)
Debugged := FALSE ; (* no need to debug deadlock yet! *)
END ;
(* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
RETURN( d ) (* and return a descriptor to the caller *)
END InitProcess ;
(*
KillProcess - kills the current process. Notice that if InitProcess
is called again, it might reuse the DESCRIPTOR of the
killed process. It is the responsibility of the caller
to ensure all other processes understand this process
is different.
*)
PROCEDURE KillProcess ;
VAR
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
SubFromReady(CurrentProcess) ;
SubFromExists(ExistsQueue, CurrentProcess) ;
GarbageItem := CurrentProcess ;
Reschedule ;
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END KillProcess ;
(*
Resume - resumes a suspended process. If all is successful then the process, p,
is returned. If it fails then NIL is returned.
*)
PROCEDURE Resume (d: DESCRIPTOR) : DESCRIPTOR ;
VAR
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
WITH d^ DO
IF Status=Suspended
THEN
(* legal state transition *)
Status := Runnable ; (* change status *)
AddToReady(d) ; (* add to run queue *)
RunQueue[RunPriority] := d ; (* make d at top of q *)
Reschedule (* check whether this process has a higher run priority *)
ELSE
(* we are trying to Resume a process which is *)
Halt ('trying to resume a process which is not suspended',
__FILE__, __FUNCTION__, __LINE__) ;
RETURN( NIL ) (* not held in a Suspended state - error *)
END
END ;
(* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
RETURN( d )
END Resume ;
(*
Suspend - suspend the calling process.
The process can only continue running if another process
Resumes it.
*)
PROCEDURE Suspend ;
VAR
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
WITH CurrentProcess^ DO
Status := Suspended
END ;
SubFromReady(CurrentProcess) ;
Reschedule ;
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END Suspend ;
(*
InitSemaphore - creates a semaphore whose initial value is, v, and
whose name is, Name.
*)
PROCEDURE InitSemaphore (v: CARDINAL; Name: ARRAY OF CHAR) : SEMAPHORE ;
VAR
s : SEMAPHORE ;
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
NEW(s) ;
WITH s^ DO
Value := v ; (* initial value of semaphore *)
StrCopy(Name, SemName) ; (* save the name for future debugging *)
Who := NIL ; (* no one waiting on this semaphore yet *)
AddToSemaphoreExists(s) ; (* add semaphore to exists list *)
END ;
(* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
RETURN( s )
END InitSemaphore ;
(*
Wait - performs dijkstra's P operation on a semaphore.
A process which calls this procedure will
wait until the value of the semaphore is > 0
and then it will decrement this value.
*)
PROCEDURE Wait (s: SEMAPHORE) ;
VAR
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
WITH s^ DO
IF Value>0
THEN
DEC( Value )
ELSE
SubFromReady(CurrentProcess) ; (* remove from run q *)
IF Who=CurrentProcess
THEN
Ps ;
Halt ('we are already on sem',
__FILE__, __FUNCTION__, __LINE__)
END ;
AddToSemaphore(Who, CurrentProcess) ; (* add to semaphore q *)
CurrentProcess^.Status := WaitOnSem ; (* set new status *)
CurrentProcess^.Which := s ; (* debugging aid *)
Reschedule (* find next process *)
END
END ;
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END Wait ;
(*
Signal - performs dijkstra's V operation on a semaphore.
A process which calls the procedure will increment
the semaphores value.
*)
PROCEDURE Signal (s: SEMAPHORE) ;
VAR
ToOldState: PROTECTION ;
d : DESCRIPTOR ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
WITH s^ DO
IF Who=NIL
THEN
INC( Value ) (* no process waiting *)
ELSE
d := SubFromSemaphoreTop(Who) ; (* remove process from semaphore q *)
d^.Which := NIL ; (* no longer waiting on semaphore *)
d^.Status := Runnable ; (* set new status *)
AddToReady(d) ; (* add process to the run queue *)
Reschedule (* find out whether there is a *)
(* higher priority to run. *)
END
END ;
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END Signal ;
(*
WaitForIO - waits for an interrupt to occur on vector, VectorNo.
*)
PROCEDURE WaitForIO (VectorNo: CARDINAL) ;
VAR
Calling : DESCRIPTOR ;
Next : PROCESS ;
ToOldState: PROTECTION ;
r : INTEGER ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
(*
DebugString('inside WaitForIO ') ;
DebugString(CurrentProcess^.RunName) ;
DebugString('\n') ;
*)
Assert(CurrentProcess^.Status=Runnable,
__FILE__, __LINE__, __FUNCTION__) ;
SubFromReady(CurrentProcess) ; (* remove process from run queue *)
(*
alter run priority to hi as all processes waiting for an interrupt
are scheduled to run at the highest priority.
*)
WITH CurrentProcess^ DO
Status := WaitOnInt ; (* it will be blocked waiting for an interrupt. *)
RunPriority := hi ; (* this (hopefully) allows it to run as soon as *)
(* the interrupt occurs. *)
END ;
Calling := CurrentProcess ; (* process which called WaitForIO *)
CurrentProcess := NextReady() ; (* find next process to run while we wait *)
Next := CurrentProcess^.Volatiles ;
(*
This is quite complicated. We transfer control to the next process saving
our volatile environment into the Calling process descriptor volatiles.
When an interrupt occurs the calling process will be resumed and the
interrupted process volatiles will be placed into Next.
*)
IOTRANSFER(Calling^.Volatiles, Next, VectorNo) ;
(*
At this point the interrupt has just occurred and the volatiles of
the interrupted process are in Next. Next is the current process
and so we must save them before picking up the Calling descriptor.
*)
CurrentProcess^.Volatiles := Next ; (* carefully stored away *)
CurrentProcess := Calling ; (* update CurrentProcess *)
(*
DebugString(CurrentProcess^.RunName) ;
*)
CurrentProcess^.Status := Runnable ; (* add to run queue *)
AddToReady(CurrentProcess) ;
(*
DebugString(' finishing WaitForIO\n') ;
*)
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END WaitForIO ;
(*
Ps - displays a process list together with relevant their status.
*)
PROCEDURE Ps ;
VAR
ToOldState: PROTECTION ;
p : DESCRIPTOR ;
s : SEMAPHORE ;
a : ARRAY [0..5] OF CHAR ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
p := ExistsQueue ;
IF p#NIL
THEN
REPEAT
DisplayProcess(p) ;
p := p^.ExistsQ.Right
UNTIL p=ExistsQueue
END ;
s := AllSemaphores ;
IF s#NIL
THEN
REPEAT
WITH s^ DO
DebugString(SemName) ;
WriteNSpaces(MaxCharsInName-StrLen(SemName)) ;
CardToStr(Value, 0, a) ;
DebugString(a) ;
DebugString('\n')
END ;
s := s^.ExistsQ.Right
UNTIL s=AllSemaphores
END ;
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END Ps ;
(*
DisplayProcess - displays the process, p, together with its status.
*)
PROCEDURE DisplayProcess (p: DESCRIPTOR) ;
VAR
a: ARRAY [0..4] OF CHAR ;
BEGIN
WITH p^ DO
DebugString(RunName) ; WriteNSpaces(MaxCharsInName-StrLen(RunName)) ;
CASE RunPriority OF
idle: DebugString(' idle ') |
lo : DebugString(' lo ') |
hi : DebugString(' hi ')
END ;
CASE Status OF
Runnable : DebugString('runnable ') |
Suspended: DebugString('suspended') |
WaitOnSem: DebugString('waitonsem (') ;
DebugString(Which^.SemName) ;
DebugString(')') |
WaitOnInt: DebugString('waitonint')
END ;
DebugString('\n')
END
END DisplayProcess ;
(*
WriteNSpaces - writes, n, spaces.
*)
PROCEDURE WriteNSpaces (n: CARDINAL) ;
BEGIN
WHILE n>0 DO
DebugString(' ') ;
DEC(n)
END
END WriteNSpaces ;
(*
GetCurrentProcess - returns the descriptor of the current running
process.
*)
PROCEDURE GetCurrentProcess () : DESCRIPTOR ;
VAR
ToOldState: PROTECTION ;
p : DESCRIPTOR ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
p := CurrentProcess ;
(* ToOldState := TurnInterrupts(ToOldState) ; (* restore interrupts *) *)
RETURN( p )
END GetCurrentProcess ;
(*
RotateRunQueue - rotates the process run queue.
*)
PROCEDURE RotateRunQueue ;
VAR
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; (* disable interrupts *) *)
(* we only need to rotate the lo priority processes as:
idle - should only have one process (the idle process)
hi - are the device drivers which most of the time are performing
WaitForIO
*)
IF RunQueue[lo]#NIL
THEN
RunQueue[lo] := RunQueue[lo]^.ReadyQ.Right
END ;
(* ToOldState := TurnInterrupts(ToOldState) (* restore interrupts *) *)
END RotateRunQueue ;
(*
ProcessName - displays the name of process, d, through
DebugString.
*)
PROCEDURE ProcessName (d: DESCRIPTOR) ;
BEGIN
DebugString(d^.RunName)
END ProcessName ;
(*
DebugProcess -
*)
PROCEDURE DebugProcess (d: DESCRIPTOR) ;
VAR
ToOldState: PROTECTION ;
BEGIN
(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
WITH d^ DO
IF Status=WaitOnSem
THEN
DebugString('debugging process (') ;
DebugString(RunName) ;
DebugString(') was waiting on semaphore (') ;
DebugString(Which^.SemName) ;
DebugString(')\n') ;
SubFromSemaphore(Which^.Who, d) ;
AddToReady(d) ;
Status := Runnable ;
Debugged := TRUE ;
Reschedule
ELSE
DebugString('can only debug deadlocked processes (') ;
DebugString(RunName) ;
DebugString(') which are waiting on a semaphore\n')
END
END ;
(* ToOldState := TurnInterrupts(ToOldState) *)
END DebugProcess ;
(*
CheckDebugged - checks to see whether the debugged flag has
been set by the debugger.
TRUE is returned if the process was debugged.
FALSE is returned if the process was not debugged.
*)
PROCEDURE CheckDebugged () : BOOLEAN ;
BEGIN
WITH CurrentProcess^ DO
IF Debugged
THEN
(*
You will see this comment after you have enabled a
deadlocked process to continue via the gdb command:
print Executive_DebugProcess(d)
debugger caused deadlocked process to continue
*)
(* gdb.breakpoint ; *)
Debugged := FALSE ;
SubFromReady(CurrentProcess) ;
AddToSemaphore(Which^.Who, CurrentProcess) ;
(* add it back to the queue sem *)
Status := WaitOnSem ;
RETURN( TRUE )
END
END ;
RETURN( FALSE )
END CheckDebugged ;
(*
Reschedule - reschedules to the highest runnable process.
*)
PROCEDURE Reschedule ;
BEGIN
(*
the repeat loop allows us to debug a process even when it is
technically waiting on a semaphore. We run the process into
a breakpoint and then back into this schedule routine.
This is really useful when trying to find out why processes have
deadlocked.
*)
REPEAT
ScheduleProcess
UNTIL NOT CheckDebugged()
END Reschedule ;
(*
ScheduleProcess - finds the highest priority Runnable process and
then transfers control to it.
*)
PROCEDURE ScheduleProcess ;
VAR
From,
Highest: DESCRIPTOR ;
BEGIN
Highest := NextReady() ;
(* rotate ready Q to ensure fairness *)
RunQueue[Highest^.RunPriority] := Highest^.ReadyQ.Right ;
(* no need to transfer if Highest=CurrentProcess *)
IF Highest#CurrentProcess
THEN
From := CurrentProcess ;
(*
DebugString('context switching from ') ; DebugString(From^.RunName) ;
*)
(* alter CurrentProcess before we TRANSFER *)
CurrentProcess := Highest ;
(*
DebugString(' to ') ; DebugString(CurrentProcess^.RunName) ;
*)
TRANSFER(From^.Volatiles, Highest^.Volatiles) ;
(*
; DebugString(' (') ; DebugString(CurrentProcess^.RunName) ;
DebugString(')\n') ;
*)
CheckGarbageCollect
END
END ScheduleProcess ;
(*
NextReady - returns the highest priority Runnable process.
*)
PROCEDURE NextReady () : DESCRIPTOR ;
VAR
Highest: DESCRIPTOR ;
Pri : Priority ;
BEGIN
Highest := NIL ;
FOR Pri := idle TO hi DO
IF RunQueue[Pri]#NIL
THEN
Highest := RunQueue[Pri]
END
END ;
Assert(Highest#NIL, __FILE__, __LINE__, __FUNCTION__) ;
RETURN( Highest )
END NextReady ;
(*
CheckGarbageCollect - checks to see whether GarbageItem is set
and if so it deallocates storage associated
with this descriptor.
*)
PROCEDURE CheckGarbageCollect ;
BEGIN
IF GarbageItem#NIL
THEN
WITH GarbageItem^ DO
DEALLOCATE(Start, Size)
END ;
DISPOSE(GarbageItem) ;
GarbageItem := NIL
END
END CheckGarbageCollect ;
(*
AddToExists - adds item, Item, to the exists queue.
*)
PROCEDURE AddToExists (Item: DESCRIPTOR) ;
BEGIN
IF ExistsQueue=NIL
THEN
ExistsQueue := Item ; (* Head is empty therefore make *)
Item^.ExistsQ.Left := Item ; (* Item the only entry on this *)
Item^.ExistsQ.Right := Item (* queue. *)
ELSE
Item^.ExistsQ.Right := ExistsQueue ; (* Add Item to the end of queue *)
Item^.ExistsQ.Left := ExistsQueue^.ExistsQ.Left ;
ExistsQueue^.ExistsQ.Left^.ExistsQ.Right := Item ;
ExistsQueue^.ExistsQ.Left := Item
END
END AddToExists ;
(*
SubFromExists - removes a process, Item, from the exists queue, Head.
*)
PROCEDURE SubFromExists (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
BEGIN
IF (Item^.ExistsQ.Right=Head) AND (Item=Head)
THEN
Head := NIL
ELSE
IF Head=Item
THEN
Head := Head^.ExistsQ.Right
END ;
Item^.ExistsQ.Left^.ExistsQ.Right := Item^.ExistsQ.Right ;
Item^.ExistsQ.Right^.ExistsQ.Left := Item^.ExistsQ.Left
END
END SubFromExists ;
(*
AddToSemaphore - adds item, Item, to the semaphore queue defined by Head.
*)
PROCEDURE AddToSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
BEGIN
IF Head=NIL
THEN
Head := Item ; (* Head is empty therefore make *)
Item^.SemaphoreQ.Left := Item ; (* Item the only entry on this *)
Item^.SemaphoreQ.Right := Item (* queue. *)
ELSE
Item^.SemaphoreQ.Right := Head ; (* Add Item to the end of queue *)
Item^.SemaphoreQ.Left := Head^.SemaphoreQ.Left ;
Head^.SemaphoreQ.Left^.SemaphoreQ.Right := Item ;
Head^.SemaphoreQ.Left := Item
END
END AddToSemaphore ;
(*
AddToSemaphoreExists - adds item, Item, to the semaphore exists queue.
*)
PROCEDURE AddToSemaphoreExists (Item: SEMAPHORE) ;
BEGIN
IF AllSemaphores=NIL
THEN
AllSemaphores := Item ; (* Head is empty therefore make *)
Item^.ExistsQ.Left := Item ; (* Item the only entry on this *)
Item^.ExistsQ.Right := Item (* queue. *)
ELSE
Item^.ExistsQ.Right := AllSemaphores ;
(* Add Item to the end of queue *)
Item^.ExistsQ.Left := AllSemaphores^.ExistsQ.Left ;
AllSemaphores^.ExistsQ.Left^.ExistsQ.Right := Item ;
AllSemaphores^.ExistsQ.Left := Item
END
END AddToSemaphoreExists ;
(*
AddToReady - adds item, Item, to the ready queue.
*)
PROCEDURE AddToReady (Item: DESCRIPTOR) ;
BEGIN
AddToReadyQ(RunQueue[Item^.RunPriority], Item)
END AddToReady ;
(*
AddToReadyQ - adds item, Item, to the ready queue defined by Head.
*)
PROCEDURE AddToReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
BEGIN
IF Head=NIL
THEN
Head := Item ; (* Head is empty therefore make *)
Item^.ReadyQ.Left := Item ; (* Item the only entry on this *)
Item^.ReadyQ.Right := Item (* queue. *)
ELSE
Item^.ReadyQ.Right := Head ; (* Add Item to the end of queue *)
Item^.ReadyQ.Left := Head^.ReadyQ.Left ;
Head^.ReadyQ.Left^.ReadyQ.Right := Item ;
Head^.ReadyQ.Left := Item
END
END AddToReadyQ ;
(*
SubFromReady - subtract process descriptor, Item, from the Ready queue.
*)
PROCEDURE SubFromReady (Item: DESCRIPTOR) ;
BEGIN
SubFromReadyQ(RunQueue[Item^.RunPriority], Item)
END SubFromReady ;
(*
SubFromReadyQ - removes a process, Item, from a queue, Head.
*)
PROCEDURE SubFromReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
BEGIN
IF (Item^.ReadyQ.Right=Head) AND (Item=Head)
THEN
Head := NIL
ELSE
IF Head=Item
THEN
Head := Head^.ReadyQ.Right
END ;
Item^.ReadyQ.Left^.ReadyQ.Right := Item^.ReadyQ.Right ;
Item^.ReadyQ.Right^.ReadyQ.Left := Item^.ReadyQ.Left
END
END SubFromReadyQ ;
(*
SubFromSemaphoreTop - returns the first descriptor in the
semaphore queue.
*)
PROCEDURE SubFromSemaphoreTop (VAR Head: DESCRIPTOR) : DESCRIPTOR ;
VAR
Top: DESCRIPTOR ;
BEGIN
Top := Head ;
SubFromSemaphore(Head, Top) ;
RETURN( Top )
END SubFromSemaphoreTop ;
(*
SubFromSemaphore - removes a process, Item, from a queue, Head.
*)
PROCEDURE SubFromSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
BEGIN
IF (Item^.SemaphoreQ.Right=Head) AND (Item=Head)
THEN
Head := NIL
ELSE
IF Head=Item
THEN
Head := Head^.SemaphoreQ.Right
END ;
Item^.SemaphoreQ.Left^.SemaphoreQ.Right := Item^.SemaphoreQ.Right ;
Item^.SemaphoreQ.Right^.SemaphoreQ.Left := Item^.SemaphoreQ.Left
END
END SubFromSemaphore ;
(*
Idle - this process is only run whenever there is no other Runnable
process. It should never be removed from the run queue.
*)
PROCEDURE Idle ;
VAR
ToOldState: PROTECTION ;
BEGIN
ToOldState := TurnInterrupts(MIN(PROTECTION)) ; (* enable interrupts *)
LOOP
(*
Listen for interrupts.
We could solve chess endgames here or calculate PI etc.
We forever wait for an interrupt since there is nothing else
to do...
*)
ListenLoop
END
(* we must NEVER exit from the above loop *)
END Idle ;
(*
InitIdleProcess - creates an idle process descriptor which
is run whenever no other process is Runnable.
The Idle process should be the only process which
has the priority idle.
*)
VAR
IdleProcess: DESCRIPTOR ; (* Idle process always runnable *)
PROCEDURE InitIdleProcess ;
VAR
db : ARRAY [0..80] OF CHAR ;
BEGIN
NEW(IdleProcess) ;
WITH IdleProcess^ DO
ALLOCATE(Start, IdleStackSize) ;
Size := IdleStackSize ;
NEWPROCESS(Idle, Start, IdleStackSize, Volatiles) ;
InitQueue(SemaphoreQ) ; (* not on a semaphore queue *)
Which := NIL ; (* at all. *)
StrCopy('Idle', RunName) ; (* idle process's name *)
Status := Runnable ; (* should always be idle *)
RunPriority := idle ; (* lowest priority possible *)
Debugged := FALSE ; (* should never be debugging *)
END ;
AddToReady(IdleProcess) ; (* should be the only *)
(* process at this run priority *)
AddToExists(IdleProcess) (* process now exists.. *)
END InitIdleProcess ;
(*
InitInitProcess - creates a descriptor for this running environment
so it too can be manipulated by Reschedule.
This concept is important to understand.
InitInitProcess is called by the startup code to this
module. It ensures that the current stack and processor
volatiles can be "housed" in a process descriptor and
therefore it can be manipulated just like any other
process.
*)
PROCEDURE InitInitProcess ;
BEGIN
NEW(CurrentProcess) ;
WITH CurrentProcess^ DO
Size := 0 ; (* we dont know the size of main stack *)
Start := NIL ; (* we don't need to know where it is. *)
InitQueue(ReadyQ) ; (* assign queues to NIL *)
InitQueue(ExistsQ) ;
InitQueue(SemaphoreQ) ; (* not waiting on a semaphore queue yet *)
Which := NIL ; (* at all. *)
StrCopy('Init', RunName) ; (* name for debugging purposes *)
Status := Runnable ; (* currently running *)
RunPriority := lo ; (* default status *)
Debugged := FALSE ; (* not deadlock debugging yet *)
END ;
AddToExists(CurrentProcess) ;
AddToReady(CurrentProcess)
END InitInitProcess ;
(*
InitQueue - initializes a queue, q, to empty.
*)
PROCEDURE InitQueue (VAR q: DesQueue) ;
BEGIN
WITH q DO
Right := NIL ;
Left := NIL
END
END InitQueue ;
(*
Init - initializes all the global variables.
*)
PROCEDURE Init ;
BEGIN
ExistsQueue := NIL ;
RunQueue[lo] := NIL ;
RunQueue[hi] := NIL ;
RunQueue[idle] := NIL ;
AllSemaphores := NIL ;
GarbageItem := NIL ;
InitInitProcess ;
InitIdleProcess
END Init ;
BEGIN
Init
END Executive.