IMPLEMENTATION MODULE PROCS; (************************************************************************** Environnement : Solaris 2.3 Modula-2. ------------- Programmeurs : ------------ Pierre L'Ecuyer, Michel Duclos, Nataly Giroux, Denis Alain, Gaetan Perron, Jean Belanger, Benoit Martin. ***************************************************************************) IMPORT SIM, EVENT; FROM SYSTEM IMPORT WORD, ADDRESS, ADR; FROM COROUTINES IMPORT NEWCOROUTINE, TRANSFER, COROUTINE, SELF; (* SOLARIS *) (* COROUTINE remplace PROCESS de SUN *) FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM MYINOUT IMPORT WriteString, WriteLn, WriteCard, Write; FROM NUM IMPORT WriteLR; FROM EVENT IMPORT EventType, EventNotice, CancelNotice, NoticeTime, ScheduleNotice, ScheduleNoticeNext, NoticeType, NoticeAttrib; CONST LongName = 32; TYPE ProcessType = POINTER TO RECORD (* Pointe sur un bloc d'informations *) (* associe a un type de processus *) Proc : PROC; (* Procedure associee. *) Descriptor : ARRAY [0..LongName-1] OF CHAR; (* Descripteur du type de processus *) Size : CARDINAL ; (* Dimension en octets du bloc memoire *) (* associe a chaque coroutine. *) Free : ADDRESS (* Pile de blocs memoire libres pour *) (* les coroutines de ce type. *) END; ProcessInstance = POINTER TO InfoProcessInstance; InfoProcessInstance = RECORD (* Information sur un processus. *) Type : ProcessType; (* Type de processus. *) State : ProcessState; (* Etat du processus. *) Attributes : ADDRESS; (* Attributs du processus. *) (* SOLARIS *) PRO : COROUTINE; (* Coroutine associee au processus. *) Adr : ADDRESS; (* Adresse du bloc de memoire associe *) (* a la coroutine PRO. *) (* Vaut NIL si l'etat non demarre. *) SerNumber : LONGCARD; (* Numero de serie du processus. *) Notice : EventNotice; (* Evenement qui redonnera le controle*) (* a ce processus s'il y a lieu. *) (* Vaut NIL sinon. *) Prec, Succ : ProcessInstance (* Sert a maintenir une liste des *) (* processus existants et une pile *) (* d'enregistrements inutilises. *) END; VAR GiveControl : EventType; (* Evenement associe a la procedure *) (* ProcGiveControl. *) CurrentPro : ProcessInstance; (* Le processus qui a presentement le *) (* controle. Si ce n'est pas un *) (* processus qui a le controle, *) (* vaut NIL. *) AllInstances : ProcessInstance; (* Debut de la liste de tous les *) (* processus existants. *) FreeInstances : ProcessInstance; (* Pile des processus termines. *) (* SOLARIS *) Main : COROUTINE; (* La coroutine principale, i.e. celle*) (* qui a appele SIM.Start. *) EndProcess : COROUTINE; (* S'occupe de terminer un processus. *) EspaceEP : ARRAY [1..2048] OF WORD; (* Espace utilise par EndProcess. *) NumberGenerated : LONGCARD; (* Nombre de processus generes a date.*) (* Sert a donner un no. de serie a *) (* chacun. *) (******************************************************************************) PROCEDURE Error (Number : CARDINAL); BEGIN WriteString ('***** ERROR from module PROCS, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' ***** ' ); WriteLn; CASE Number OF 0 : WriteString ("Referencing to an undefined process instance.") | 2 : WriteString ("Scheduling a process whose type has not been created.") | 8 : WriteString ("Suspend can be called only from a process.") | 10 : WriteString ("Attrib can be called only from a process.") | 11 : WriteString ("Delay can be called only from a process.") | 13 : WriteString ("Terminate can be called only from a process.") END; WriteLn; WriteLn; HALT END Error; PROCEDURE Error1 ( Number : CARDINAL; T : ProcessType ); BEGIN WriteLn; WriteString ('***** ERROR from module PROCS, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' ***** ' ); WriteLn; CASE Number OF 1 : WriteString ("Trying to schedule a process to start in the past.") | 3 : WriteString ("Calling Delay with a negative delay value.") | 4 : WriteString ("Calling ResetDelay with a negative delay value.") | 7 : WriteString ("Calling InstanceNotice or InstanceDelay"); WriteString (" for a process not delayed.") | 14 : WriteString ("Calling ResetDelay for the process in execution.") | 15 : WriteString ("Calling CancelInstanceNotice"); WriteString (" for a process not delayed.") | 16 : WriteString ("Calling InstanceDelay for a process not delayed.") END; WriteLn; WriteString ('Process type : '); WriteString (T^.Descriptor); Write ('.'); WriteLn; WriteLn; HALT END Error1; PROCEDURE Create ( VAR T : ProcessType; P : PROC; S : CARDINAL; Name : ARRAY OF CHAR ); VAR n, i : INTEGER; BEGIN NEW (T); WITH T^ DO Proc := P; Size := S; Free := NIL; n := HIGH (Name); IF n >= LongName THEN n := LongName - 1 END; FOR i := 0 TO n DO Descriptor [i] := Name [i] END; FOR i := n+1 TO LongName - 1 DO Descriptor [i] := " " END END END Create; PROCEDURE NewInstance ( T : ProcessType; Par : ADDRESS; VAR P : ProcessInstance ); (* Initialise un nouveau processus P. La memoire ne lui sera allouee *) (* que lors de son demarrage. *) BEGIN IF T = NIL THEN Error (2) END; IF FreeInstances = NIL THEN NEW (P) ELSE P := FreeInstances; FreeInstances := P^.Succ END; WITH P^ DO Type := T; State := Delayed; Attributes := Par; INC (NumberGenerated); SerNumber := NumberGenerated; Succ := AllInstances; AllInstances := P; Prec := NIL; IF Succ # NIL THEN Succ^.Prec := P END; Adr := NIL; END END NewInstance; PROCEDURE TerminateInstance ( VAR P : ProcessInstance ); (* Le processus P se termine. On l'enleve de la liste des processus *) (* existants et on recupere l'espace dans une pile. On met P a NIL. *) VAR A : POINTER TO POINTER TO ADDRESS; BEGIN WITH P^ DO IF ((ADDRESS (Notice) # NIL) AND (ADDRESS (NoticeType (Notice)) = ADDRESS (GiveControl)) AND (NoticeAttrib (Notice) = P)) THEN CancelNotice (Notice) END; IF Prec = NIL THEN AllInstances := Succ (* C'est le premier de la liste. *) ELSE Prec^.Succ := Succ END; IF Succ # NIL THEN Succ^.Prec := Prec (* Ce n'est pas le dernier. *) END; Succ := FreeInstances; FreeInstances := P; A := Adr; (**) IF A#NIL THEN (*WriteString("NIL") ; WriteLn ; *) A^ := Type^.Free; Type^.Free := A; END ; SerNumber := 0 END; P := NIL END TerminateInstance; PROCEDURE ProcEndProcess; (* Procedure associee a la coroutine EndProcess. Cette coroutine detruit *) (* le processus qui lui passe le controle, et repasse le controle a la *) (* coroutine ``Main''. *) BEGIN WHILE TRUE DO TerminateInstance (CurrentPro); TRANSFER (Main) END END ProcEndProcess; PROCEDURE ProcGiveControl; (* Execute l'evenement qui consiste a reactiver un processus. *) VAR A : POINTER TO POINTER TO ADDRESS; BEGIN CurrentPro := EVENT.Attrib (); WITH CurrentPro^ DO Notice := EventNotice (NIL); IF Adr = NIL THEN (* N'a pas encore demarre. *) WITH Type^ DO IF Free = NIL THEN ALLOCATE (Adr, Size) (* Espace pour CurrentPro. *) ELSE Adr := Free; A := Adr; Free := A^ END; NEWCOROUTINE (Proc, Adr, Size,VAL(PRIORITY,0), PRO) END END; State := Executing; TRANSFER (PRO) ; END; CurrentPro := NIL (* Retour de la coroutine au ``Main''.*) END ProcGiveControl; PROCEDURE Schedule ( T : ProcessType; D : LONGREAL; Par : ADDRESS ); VAR P : ProcessInstance; BEGIN ScheduleNamed (T, D, Par, P) END Schedule; PROCEDURE ScheduleNamed ( T : ProcessType; D : LONGREAL; Par : ADDRESS; VAR P : ProcessInstance ); BEGIN IF D < 0.0 THEN Error1 (1, T); RETURN END; NewInstance (T, Par, P); ScheduleNotice (GiveControl, D, P, P^.Notice); (* On place dans la liste des evenements l'activation du processus *) END ScheduleNamed; PROCEDURE ScheduleNext ( T : ProcessType; Par : ADDRESS ); VAR P : ProcessInstance; BEGIN ScheduleNamedNext (T, Par, P) END ScheduleNext; PROCEDURE ScheduleNamedNext ( T : ProcessType; Par : ADDRESS; VAR P : ProcessInstance ); BEGIN NewInstance (T, Par, P); ScheduleNoticeNext (GiveControl, P, P^.Notice) END ScheduleNamedNext; PROCEDURE Attrib () : ADDRESS; BEGIN IF CurrentPro = NIL THEN Error (10); RETURN NIL END; (* Ce n'est pas un processus qui a le controle. *) RETURN CurrentPro^.Attributes END Attrib; PROCEDURE Delay ( D : LONGREAL ); BEGIN IF D < 0.0 THEN Error1 (3, CurrentPro^.Type); RETURN END; IF CurrentPro = NIL THEN Error (11); RETURN END; (* Ce n'est pas un processus qui a le controle. *) WITH CurrentPro^ DO ScheduleNotice (GiveControl, D, CurrentPro, Notice); State := Delayed; TRANSFER (Main) END END Delay; PROCEDURE ResetDelay ( P : ProcessInstance; D : LONGREAL ); BEGIN IF D < 0.0 THEN Error1 (4, P^.Type); RETURN END; IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; WITH P^ DO IF State = Executing THEN Error1 (14, Type) END; IF ADDRESS (Notice) # NIL THEN CancelNotice (Notice) END; ScheduleNotice (GiveControl, D, P, Notice); State := Delayed END END ResetDelay; PROCEDURE Resume (P : ProcessInstance); BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; WITH P^ DO IF State = Delayed THEN CancelNotice (Notice) END; ScheduleNoticeNext (GiveControl, P, Notice) END END Resume; PROCEDURE CancelInstanceNotice ( P : ProcessInstance ); BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; WITH P^ DO IF State # Delayed THEN Error1 (15, P^.Type) END; CancelNotice (Notice); State := Suspended END; END CancelInstanceNotice; PROCEDURE Terminate; BEGIN IF CurrentPro = NIL THEN Error (13) END; (* Ce n'est pas un processus qui a le controle. *) TRANSFER (EndProcess) END Terminate ; PROCEDURE InstanceType ( P : ProcessInstance ) : ProcessType; BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; RETURN P^.Type END InstanceType; PROCEDURE InstanceState ( P : ProcessInstance ) : ProcessState; BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; RETURN P^.State END InstanceState; PROCEDURE InstanceAttrib ( P : ProcessInstance ) : ADDRESS; BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; RETURN P^.Attributes END InstanceAttrib; PROCEDURE InstanceNotice ( P : ProcessInstance ) : EventNotice; BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; RETURN P^.Notice END InstanceNotice; PROCEDURE InstanceDelay ( P : ProcessInstance ) : LONGREAL; BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; IF ADDRESS(P^.Notice) = NIL THEN Error1 (16, P^.Type) END; RETURN NoticeTime (P^.Notice) - SIM.Time () END InstanceDelay; PROCEDURE InstanceSerialNumber ( P : ProcessInstance ) : LONGCARD; BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; RETURN P^.SerNumber END InstanceSerialNumber; PROCEDURE Suspend; BEGIN IF CurrentPro = NIL THEN Error (8) END; CurrentPro^.State := Suspended; TRANSFER (Main) END Suspend; PROCEDURE CurrentProcess () : ProcessInstance; BEGIN RETURN CurrentPro END CurrentProcess; PROCEDURE Kill ( VAR P : ProcessInstance ); BEGIN IF (P = NIL) OR (P^.SerNumber = 0) THEN Error (0) END; WITH P^ DO IF P = CurrentPro THEN Terminate ELSE TerminateInstance (P) END END ; END Kill; PROCEDURE KillAll; VAR P1, P2 : ProcessInstance; BEGIN P1 := AllInstances; WHILE P1 # NIL DO P2 := P1^.Succ; IF P1 # CurrentPro THEN TerminateInstance (P1) END; P1 := P2 END; IF CurrentPro # NIL THEN Terminate END END KillAll; PROCEDURE DeleteType (VAR T : ProcessType); BEGIN DISPOSE (T) END DeleteType; BEGIN AllInstances := NIL; FreeInstances := NIL; CurrentPro := NIL; NumberGenerated := 0; NEWCOROUTINE (ProcEndProcess, ADR (EspaceEP), SIZE (EspaceEP), VAL(PRIORITY,0), EndProcess); Main := SELF(); EVENT.Create (GiveControl, ProcGiveControl, "A process will take control") END PROCS.