IMPLEMENTATION MODULE BIN; (************************************************************************** Programmeurs : ------------ Pierre L'Ecuyer, Jean Belanger, Denis Alain, Gaetan Perron ***************************************************************************) FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM MYINOUT IMPORT Write, WriteString, WriteLn; FROM NUM IMPORT WriteLR; FROM PROCS IMPORT ProcessInstance, Suspend, ResetDelay, CurrentProcess, InstanceSerialNumber; FROM LIST IMPORT List, Insert, InsertOrd, Remove, View, Size, InPosition, OutPosition; FROM SYSTEM IMPORT ADDRESS; IMPORT SIM, LIST; CONST LongName = 32; (* Long max de la chaine de caracteres*) (* identifiant un Bin. *) TYPE Bin = POINTER TO InfoBin; InfoBin = RECORD (* Bloc d'info. associe a un Bin. *) BinPolicy : ServicePolicy; (* Politique de service. *) TokensInit : CARDINAL; (* Nombre de jetons a la creation. *) Available : CARDINAL; (* Nombre de jetons. *) Wait : List; (* Liste des clients en attente. *) Descriptor : ARRAY [0..LongName-1] OF CHAR END; UserDossier = POINTER TO Dossier; Dossier = RECORD (* Dossier sur un processus demandeur.*) Tokens : CARDINAL; (* Nb de jetons demandes. *) DPriority : LONGREAL; (* Indice de priorite de service, *) (* utilise si Policy = Prior. *) Pro : ProcessInstance; (* Processus demandeur. *) SerNum : LONGCARD; (* No de serie de ce processus. *) Succ : UserDossier END; VAR FreeDossiers : UserDossier; (******************************************************************************) PROCEDURE Error ( Number : CARDINAL ); BEGIN WriteLn; WriteString ('***** ERROR from module BIN, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' *****'); WriteLn; CASE Number OF 0 : WriteString ('Trying to perform an operation on a bin'); WriteString (' that has not been created.') END; WriteLn; WriteLn; HALT END Error; PROCEDURE Error1 ( Number : CARDINAL; B : Bin ); BEGIN WriteLn; WriteString ('***** ERROR from module BIN, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' ***** ' ); WriteLn; CASE Number OF 1 : WriteString ("Take and TakeWithPrior can be called only from"); WriteString (" a process.") | 2 : WriteString ("Calling Take for a Bin created"); WriteString (" with priorities.") | 3 : WriteString ("Calling TakeWithPrior for a Bin created"); WriteString (" without priorities.") END; WriteLn; WriteString ("Bin name : "); WriteString (B^.Descriptor); Write ("."); WriteLn; WriteLn; HALT END Error1; (******************************************************************************) PROCEDURE Precede ( A, B : ADDRESS ): BOOLEAN; (* Procedure servant a ordonner les dossiers dans les listes associees aux *) (* bins fonctionnant par priorites. *) (* Utilisee dans : Create. *) VAR C, D : UserDossier; BEGIN C := A; D := B; IF C^.DPriority >= D^.DPriority THEN RETURN TRUE ELSE RETURN FALSE END END Precede; (******************************************************************************) PROCEDURE StartNewCust ( B : Bin ); (* Sert, si possible, de nouvelles demandes apres que de nouveaux jetons *) (* soient devenues disponibles. *) VAR NewDossier : UserDossier; (* Nouveau dossier a servir. *) BEGIN WITH B^ DO View (NewDossier, First, Wait); WHILE (NewDossier # NIL) AND (Available > 0) DO WITH NewDossier^ DO IF SerNum # InstanceSerialNumber (Pro) THEN Remove (NewDossier, Current, Wait); Succ := FreeDossiers; FreeDossiers := NewDossier; View (NewDossier, Current, Wait) ELSIF (Tokens <= Available) THEN Remove (NewDossier, Current, Wait); ResetDelay (Pro, 0.0); Succ := FreeDossiers; FreeDossiers := NewDossier; View (NewDossier, Current, Wait); Available := Available - Tokens ELSE View (NewDossier, Next, Wait) END END END END END StartNewCust; (******************************************************************************) PROCEDURE Create ( VAR B : Bin; Policy : ServicePolicy; Name : ARRAY OF CHAR ); VAR i, n : INTEGER; BEGIN NEW (B); WITH B^ DO BinPolicy := Policy; Available := 0; n := HIGH (Name); IF n >= LongName THEN n := LongName-1 END; FOR i := 1 TO n DO Descriptor [i] := Name [i] END; FOR i := n+1 TO LongName - 1 DO Descriptor [i] := " " END; CASE Policy OF Fifo, Lifo : LIST.Create (Wait, 'WaitList') | Prior : LIST.CreateOrd (Wait, Precede, 'WaitList') END END END Create; (******************************************************************************) PROCEDURE Init ( B : Bin ); VAR E : UserDossier; BEGIN IF B = NIL THEN Error (0) END; WITH B^ DO WHILE Size (Wait) > 0 DO (* Recupere l'espace *) Remove (E, First, Wait); E^.Succ := FreeDossiers; FreeDossiers := E END; Available := 0 END END Init; (******************************************************************************) PROCEDURE Avail ( B : Bin ) : CARDINAL; BEGIN IF B = NIL THEN Error( 0 ) END; RETURN B^.Available END Avail; (******************************************************************************) PROCEDURE Take ( N : CARDINAL; B : Bin ); VAR NewDossier : UserDossier; BEGIN IF B = NIL THEN Error (0) END; IF ADDRESS (CurrentProcess ()) = NIL THEN Error1 (1, B) END; WITH B^ DO IF N <= Available THEN Available := Available - N ELSE IF FreeDossiers # NIL THEN NewDossier := FreeDossiers; FreeDossiers := NewDossier^.Succ ELSE NEW (NewDossier) (* Creer un dossier pour le processus *) END; WITH NewDossier^ DO Tokens := N; Pro := CurrentProcess (); SerNum := InstanceSerialNumber (Pro); CASE BinPolicy OF (* Selon la Policy fait l'insertion *) Fifo : Insert (NewDossier, Last, Wait) | Lifo : Insert (NewDossier, First, Wait) ELSE Error1 (2, B) (* Devrait appeler TakeWithPrior. *) END; Suspend END END END END Take; (******************************************************************************) PROCEDURE TakeWithPrior ( N : CARDINAL; B : Bin; Priority : LONGREAL ); VAR NewDossier : UserDossier; BEGIN IF B = NIL THEN Error (0) END; IF ADDRESS (CurrentProcess ()) = NIL THEN Error1 (1, B) END; WITH B^ DO IF N <= Available THEN Available := Available - N ELSE IF FreeDossiers # NIL THEN NewDossier := FreeDossiers; FreeDossiers := NewDossier^.Succ ELSE NEW (NewDossier) (* Creer un dossier pour le processus *) END; WITH NewDossier^ DO Tokens := N; Pro := CurrentProcess (); SerNum := InstanceSerialNumber (Pro); DPriority := Priority; CASE BinPolicy OF Prior : InsertOrd (NewDossier, Wait) ELSE Error1 (3, B) (* Devrait appeler Take. *) END; Suspend END END END END TakeWithPrior; (******************************************************************************) PROCEDURE Give ( N : CARDINAL; B : Bin ); BEGIN IF B = NIL THEN Error (0) END; WITH B^ DO Available := Available + N; IF Size (Wait) > 0 THEN StartNewCust (B) END END END Give; (******************************************************************************) PROCEDURE WaitList ( B : Bin ) : List; BEGIN (* Retourne la liste d'attente *) IF B = NIL THEN Error (0) END; RETURN B^.Wait END WaitList; (******************************************************************************) PROCEDURE User ( U : UserDossier ) : ProcessInstance; BEGIN (* Retourne le processus du dossier *) RETURN U^.Pro END User; (******************************************************************************) PROCEDURE NbTokens ( U : UserDossier ) : CARDINAL; BEGIN (* Retourne le nombre de jetons *) RETURN U^.Tokens END NbTokens; (******************************************************************************) PROCEDURE Delete (VAR B : Bin); VAR U : UserDossier; BEGIN WITH B^ DO WHILE Size (Wait) > 0 DO Remove (U, Current, Wait); U^.Succ := FreeDossiers; FreeDossiers := U END; LIST.Delete (Wait); DISPOSE (B); B := NIL END END Delete; BEGIN FreeDossiers := NIL END BIN.