IMPLEMENTATION MODULE LIST; (************************************************************************** Programmeurs : ------------ Pierre L'Ecuyer, Michel Duclos, Nataly Giroux, Gaetan Perron, Denis Alain, Jean Belanger *****************************************************************************) FROM MYINOUT IMPORT WriteString, WriteLn, WriteCard, Write; FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM NUM IMPORT WriteLR; FROM SYSTEM IMPORT ADDRESS, WORD; IMPORT SIM, STAT; CONST LongName = 32; (* Long. max. de la chaine de caracteres *) (* decrivant une liste. *) TYPE RefElement = POINTER TO Element; (* Pointeur sur un element de liste. *) Element = RECORD (* Chaque element de liste correspond a *) (* un objet qui se trouve dans la liste. *) Succ : RefElement; (* Pointeur sur l'element suivant. Dans *) (* certains cas, il peut aussi pointer *) (* sur la tete de liste. L'affection est *) (* faite en utilisant une variable tampon *) (* de type ADDRESS dans la procedure *) (* InsertBeforeElem. *) Pred : RefElement; (* Pointeur sur l'element precedent. Dans *) (* certains cas, il peut aussi pointer *) (* sur la tete de liste. L'affection est *) (* faite en utilisant une variable tampon *) (* de type ADDRESS dans la procedure *) (* InsertBeforeElem. *) Content : ADDRESS; (* Pointeur sur l'objet qui correspond a *) (* cet element. *) (* Cle d'ordonnancement entiere ou reelle *) (* tout dependant du type de ce parametre.*) ArrivalTime : LONGREAL (* Instant d'arrivee de l'element dans la *) (* liste. *) END; List = POINTER TO ListHead; (* Pointeur sur une tete de liste. *) ListHead = RECORD (* Tete de liste. *) Succ : RefElement; (* Pointeur sur le premier element de *) (* la liste si celle-ci n'est pas *) (* vide. Autrement, il pointe sur la *) (* tete de liste. *) Pred : RefElement; (* Pointeur sur le dernier element de *) (* la liste si celle-ci n'est pas *) (* vide. Autrement, il pointe sur la *) (* tete de liste. *) CurrentElem : RefElement; (* Pointeur sur le dernier objet *) (* traite, insere ou reference (ou *) (* sur NIL si la liste est vide). *) Size : CARDINAL; (* Nombre d'objets dans la liste. *) GoBefore : OrdProc; (* Procedure usager *) Sorted : BOOLEAN; (* Indique si la liste est de type *) (* ordonnee ou non. *) Stats : BOOLEAN; (* TRUE si on a appele CollectStat *) TInit : LONGREAL; (* Temps de la derniere initialisation *) BlockSize : STAT.Block; (* Block Statistique sur la longueur de *) (* la liste. *) BlockSojourn : STAT.Block; (* Block Statistique sur la duree de *) (* sejour des elements dans la liste. *) Descriptor : ARRAY [0..LongName-1] OF CHAR (* Nom donne a la liste par l'usager. *) END; (**************************************************************************) (* Une liste possede une tete de liste contenant : un pointeur (Succ) *) (* sur le premier element de la liste et un autre (Pred) sur le dernier, *) (* le nombre d'objets qui sont dans la liste (Size), un descripteur *) (* permettant d'identifier la liste sous forme d'une chaine de caracteres *) (* (Descriptor), et finalement un pointeur memoire (CurrentElem) sur le *) (* dernier element de la liste qui a ete reference ou insere dans cette *) (* liste. L'objet contenu dans cet element s'appelle l'objet courant *) (* (Current). Lorsque la liste est vide, le pointeur memoire est toujours *) (* a NIL. *) (* *) (* Un element de liste comprend un pointeur sur l'element precedent, un *) (* pointeur sur le suivant, un pointeur "content" sur l'objet contenu *) (* dans cet element. Le module ignore les objets crees par l'usager qui *) (* sont dans la liste, et ignore meme leur type. Il ne fait que la *) (* gestion des pointeurs sur ces objets. A chaque objet qui se trouve *) (* dans la liste correspond un element de liste, et vice-versa. *) (* *) (* Pour chaque liste qu'il veut utiliser, l'utilisateur doit declarer *) (* une variable de type List, dont l'identificateur servira de nom a la *) (* liste, puis creer cette liste a l'aide de la procedure Create ou *) (* CreateOrd. *) (* *) (* Le diagrame suivant represente la structure d'une liste. Les champs *) (* de la tete de liste et des elements sont donnes seulement pour mieux *) (* visualiser la structure; ils ne sont pas directement accessibles a *) (* l'usager. *) (* L : List | | | \|/ Tete de Liste ---------------> ---------------------------------- | -------| Succ | Pred |------------------ | | |--------------------------------| | | | | CurrentElem | Size | | | | |--------------------------------| | | | | GoBefore | Sorted |<-----| | | | |--------------------------------| | | | | | BlockSize | BlockSojourn | | | | | |--------------------------------| | | | | | Stats | Descriptor | | | | | ---------------------------------- | | | | | | | 1 \|/ 2 n | | | --------------- --------------- --------------- | E | | Succ |---->| Succ |---........->| Succ | | l | |-------------| |-------------| |-------------| | e ---| Pred |<----| Pred |<-........---| Pred |<-- m |-------------| |-------------| |-------------| e | ArrivalTime | | ArrivalTime | | ArrivalTime | n |-------------| |-------------| |-------------| t | Content | | Content | | Content | s --------------- --------------- --------------- | | | | | | \|/ \|/ \|/ Object Object Object *****************************************************************************) VAR FreeElements : RefElement; (* Pointeur sur le dessus de la pile des *) (* RefElement qui ont ete crees et qui ne *) (* sont pas utilises presentement (liste *) (* libre ). *) (* On utilise le champs Succ des records *) (* de type Element pour placer les poin- *) (* teurs servant a implanter la pile. *) UserLists : List; (* Contient la liste des listes crees par *) (* l'usager. *) PROCEDURE Error ( Number : CARDINAL ); BEGIN WriteLn; WriteString ('***** ERROR from module LIST, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' ***** ' ); WriteLn; CASE Number OF 0 : WriteString ("Trying to perform an operation on a list"); WriteString (" which has not been created.") END; WriteLn; WriteLn; HALT END Error; PROCEDURE Error1 ( Number : CARDINAL; L : List ); BEGIN WriteLn; WriteString ('***** ERROR from module LIST, at time '); WriteLR (SIM.Time (), 10, 3, 2); WriteString (' ***** ' ); WriteLn; CASE Number OF 2 : WriteString ("Calling Insert for a sorted List.") | 3 : WriteString ("Calling InsertOrd for a non-sorted list.") | 4 : WriteString ("Calling InitStat for a list for which"); WriteString (" CollectStat has not been called.") | 5 : WriteString ("Trying to remove from a list a specific object"); WriteString (" which is not in that list.") | 6 : WriteString ("Trying to sort a list not created by CreateOrd") | 7 : WriteString ("Asking for a stat. block for a list for which"); WriteString (" CollectStat has not been called.") | 8 : WriteString ("Asking a Report for a list for which"); WriteString (" CollectStat has not been called.") END; WriteLn; WriteString ("List name : "); WriteString (L^.Descriptor); Write ("."); WriteLn; WriteLn; HALT END Error1; PROCEDURE Error2 ( Number : CARDINAL; L1, L2 : List ); BEGIN WriteLn; WriteString ("***** ERROR from module LIST, at time "); WriteLR (SIM.Time (), 10, 3, 2); WriteString (" ***** " ); WriteLn; CASE Number OF 1 : WriteString ("Calling Concatenate for a sorted list.") | 2 : WriteString ("Calling Merge for a non-sorted list.") | 3 : WriteString ("Trying to merge lists having different ordering"); WriteString (" procedures.") END; WriteLn; WriteString ("List names : "); WriteString (L1^.Descriptor); WriteString (", "); WriteString (L2^.Descriptor); Write ("."); WriteLn; WriteLn; HALT END Error2; PROCEDURE CreateSys ( VAR L : List; Name : ARRAY OF CHAR ); (* Procedure non accessible a l'usager. *) (* Appelee par : CreateOrd, Create et par l'initialisation du module. *) VAR HeadPointer : ADDRESS; n, i : INTEGER; BEGIN NEW (L); HeadPointer := L; WITH L^ DO Pred := HeadPointer; Succ := HeadPointer; Size := 0; CurrentElem := NIL; Stats := FALSE; 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 CreateSys; (******************************************************************************) PROCEDURE Create ( VAR L : List; (* Creation d'une liste par l'usager. *) Name : ARRAY OF CHAR ); BEGIN CreateSys (L, Name); L^.Sorted := FALSE; (* Liste de type non ordonnee *) Insert (L, Last, UserLists) END Create; (******************************************************************************) PROCEDURE CreateOrd ( VAR L : List; Precede : OrdProc; Name : ARRAY OF CHAR ); BEGIN CreateSys (L, Name); L^.GoBefore := Precede; L^.Sorted := TRUE; (* Liste de type ordonnee *) Insert (L, Last, UserLists) END CreateOrd; (******************************************************************************) PROCEDURE CollectStat ( L : List ); BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO Stats := TRUE; TInit := SIM.Time (); STAT.Create (BlockSize, STAT.Accumulate, 'List Size'); STAT.Create (BlockSojourn, STAT.Tally, 'List Sojourn'); InitStat (L) END END CollectStat; (******************************************************************************) PROCEDURE InsertBeforeElem ( VAR E : RefElement; (* Element a inserer. *) Elem : ADDRESS (* Elem peut parfois etre une tete de *) ); (* liste (insertion a la fin). *) (* Cette procedure locale n'est pas accessible a l'usager. Elle est *) (* utilisee par les autres procedures du module pour inserer un element *) (* dans une liste. Insere l'element E juste avant l'element Elem, dans la *) (* liste ou se trouve Elem. *) (* Appelee par : Insert, InsertOrd, Sort, Merge *) VAR EElem : RefElement; (* Variable necessaire pour ne pas avoir *) (* une incompatibilite de type *) BEGIN EElem := Elem; E^.Succ := EElem; E^.Pred := EElem^.Pred; EElem^.Pred := E; E^.Pred^.Succ := E END InsertBeforeElem; (******************************************************************************) PROCEDURE Insert ( P : ADDRESS; Where : InPosition; L : List ); VAR E : RefElement; (* Element de List associe a l'objet P *) BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Sorted THEN Error1 (2, L) END; IF FreeElements = NIL THEN NEW (E) ELSE E := FreeElements; FreeElements := E^.Succ END; E^.Content := P; E^.ArrivalTime := SIM.Time (); IF Size = 0 THEN Where := Last END; CASE Where OF Last : InsertBeforeElem( E, L ) | (* On insere l'element E avant la tete *) (* de liste. *) First : InsertBeforeElem( E, Succ ) | (* Insertion au debut de la liste. *) Next : InsertBeforeElem( E, CurrentElem^.Succ ) | (* La liste contenait deja au moins un *) (* element et L^.CurrentElem <> NIL. *) Previous : InsertBeforeElem( E, CurrentElem ) (* La liste contenait deja au moins un *) (* element et L^.CurrentElem <> NIL. *) END; INC (Size); CurrentElem := E; IF Stats THEN STAT.Update (BlockSize, LFLOAT (Size)) END END END Insert; (******************************************************************************) PROCEDURE InsertOrd ( P : ADDRESS; L : List ); VAR E, (* Element de liste qui contiendra P. *) Head, (* Pointera sur la tete de liste L. *) (* Necessaire pour la compatibilite de *) (* types dans le WHILE. *) Pointer : RefElement; (* Sert a parcourir la liste. *) BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF NOT Sorted THEN Error1 (3, L) END; IF FreeElements = NIL THEN NEW (E) ELSE E := FreeElements; FreeElements := E^.Succ END; E^.Content := P; E^.ArrivalTime := SIM.Time (); Pointer := Succ; (* Pointe le premier de la liste. *) Head := Pointer^.Pred; (* Pointe la tete de la liste. *) WHILE (Pointer <> Head) AND (GoBefore (Pointer^.Content, P)) DO (* Cherche sequentiellement la position de E dans la liste. *) Pointer := Pointer^.Succ END; (* E va juste avant l'element vise par Pointer. *) InsertBeforeElem (E, Pointer); INC (Size); CurrentElem := E; IF Stats THEN STAT.Update (BlockSize, LFLOAT (Size)) END END END InsertOrd; (******************************************************************************) PROCEDURE Belongs ( P : ADDRESS; L : List ) : BOOLEAN; VAR Pointer, (* Sert a parcourir la liste. *) Head : RefElement; (* Pointe sur la tete de liste L. *) (* Necessaire pour la compatibilite de *) (* types dans la condition du WHILE. *) BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Size # 0 THEN (* La liste est non vide. *) IF CurrentElem^.Content = P THEN RETURN TRUE (* On regarde si P est l'objet courant. *) ELSE (* Sinon on parcourt la liste. *) Head := Pred^.Succ; Pointer := Succ; (* Pointe sur le premier element de L. *) WHILE (Pointer # Head) DO IF Pointer^.Content = P THEN CurrentElem := Pointer; RETURN TRUE ELSE (* On n'a pas trouve P, regarde prochain *) Pointer := Pointer^.Succ END END END END END; RETURN FALSE (* On ne l'a pas trouve. *) END Belongs; (******************************************************************************) PROCEDURE View ( VAR P : ADDRESS; Which : OutPosition; L : List ); BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Size = 0 THEN (* La liste est vide. *) P := NIL ELSE (* La liste L n'est pas vide. *) CASE Which OF (* On met-a-jour CurrentElem et on met *) (* dans P l'objet correspondant. *) Next : IF (CurrentElem # Pred) THEN CurrentElem := CurrentElem^.Succ; P := CurrentElem^.Content ELSE (* View apres le dernier de la liste *) P := NIL END | First : CurrentElem := Succ; P := CurrentElem^.Content | Last : CurrentElem := Pred; P := CurrentElem^.Content | Previous : IF (CurrentElem # Succ) THEN CurrentElem := CurrentElem^.Pred; P := CurrentElem^.Content ELSE (* View avant le premier de la liste *) P := NIL END | Current : P := CurrentElem^.Content END END END END View; (******************************************************************************) PROCEDURE Remove ( VAR P : ADDRESS; Where : OutPosition; L : List ); VAR E : RefElement; (* Element de liste qui correspond a *) (* l'objet a retirer. *) BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Size = 0 THEN P := NIL; RETURN END; (* L est vide. *) CASE Where OF First : E := Succ | Last : E := Pred | Current : E := CurrentElem | Next : IF CurrentElem # Pred THEN E := CurrentElem^.Succ ELSE (* On essai d'enlever apres le dernier *) P := NIL; RETURN END | Previous : IF CurrentElem # Succ THEN E := CurrentElem^.Pred ELSE (* On essai d'enlever avant le premier *) P := NIL; RETURN END END; DEC (Size); IF Stats THEN STAT.Update (BlockSize, LFLOAT (Size)); STAT.Update (BlockSojourn, SIM.Time () - E^.ArrivalTime) END; IF Size = 0 THEN (* Mise-a-jour de l'element courant. *) CurrentElem := NIL ELSE IF (E = CurrentElem) AND (E # Pred) THEN CurrentElem := E^.Succ ELSIF (E = CurrentElem) AND (E = Pred) THEN CurrentElem := E^.Pred END END END; WITH E^ DO (* Retire E de la liste. *) Pred^.Succ := Succ; Succ^.Pred := Pred; P := Content; Succ := FreeElements; FreeElements := E END END Remove; (******************************************************************************) PROCEDURE RemoveObject ( P : ADDRESS; L : List ); VAR Keep : RefElement; (* Sauve la valeur de CurrentElem car *) (* Belongs altere CurrentElem. *) BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Size = 0 THEN Error1 (5, L) END; IF CurrentElem^.Content = P THEN Remove (P, Current, L) ELSE Keep := CurrentElem; IF Belongs (P, L) THEN Remove (P, Current, L); (* P est dans CurrentElem. *) CurrentElem := Keep ELSE Error1 (5, L) (* P n'est pas dans la liste. *) END END END END RemoveObject; (******************************************************************************) PROCEDURE Size (* Retourne la taille de la liste L *) ( L : List ) : CARDINAL; BEGIN IF L = NIL THEN Error (0) END; RETURN L^.Size END Size; (******************************************************************************) PROCEDURE Concatenate ( VAR L1 : List; VAR L2 : List ); BEGIN IF ((L1 = NIL) OR (L2 = NIL)) THEN Error (0) END; WITH L1^ DO IF Sorted OR L2^.Sorted THEN (* Erreur il y a une liste ordonnee *) Error2 (1, L1, L2) END; IF L2^.Size # 0 THEN (* Si L2 est pas vide on concatene *) L2^.Succ^.Pred := Pred; L2^.Pred^.Succ := Pred^.Succ; Pred^.Succ := L2^.Succ; Pred := L2^.Pred; Size := Size + L2^.Size END; RemoveObject (L2, UserLists); DISPOSE (L2); L2 := NIL; IF Stats THEN InitStat (L1) END END END Concatenate; (******************************************************************************) PROCEDURE Sort ( L : List; Precede : OrdProc ); PROCEDURE Quicksort ( VAR L : List ); (* Procedure de tri recursive (tres inefficace...). *) VAR SuccessorList : List; (* Liste temporaire qui contiendra les*) (* elements qui vont apres le pivot. *) Next, (* Prochain element a etre traite. *) Head, (* Variable de type RefElement qui *) (* pointera sur la tete de liste (=L).*) (* Necessaire pour la compatibilite de*) (* types dans la condition WHILE. *) Pivot, (* Element qui sert de pivot. *) Pointer : RefElement; (* Element en traitement. *) BEGIN WITH L^ DO CreateSys (SuccessorList, ''); (* Creation d'une liste temporaire *) Pivot := Succ; (* On retire le pivot de la liste L. *) (* On reorganise les pointeurs les *) (* de la liste L. *) Pivot^.Pred^.Succ := Pivot^.Succ; Pivot^.Succ^.Pred := Pivot^.Pred; DEC ( Size ); (* Remise a jour de la taille de la *) (* liste L. *) Head := Succ^.Pred; (* Pointe la tete de la liste L *) Pointer := Succ; (* Premier element a etre traite *) WHILE ( Pointer # Head ) DO Next := Pointer^.Succ; (* Conserve le prochain element a *) (* etre traite. *) IF Precede( Pivot^.Content, Pointer^.Content ) THEN (* On a trouve un element devant *) (* aller dans la liste des succces- *) (* seurs du pivot, on le retire de la *) (* liste L. On rearrange les poin- *) (* teurs de la liste L. *) Pointer^.Pred^.Succ := Pointer^.Succ; Pointer^.Succ^.Pred := Pointer^.Pred; DEC ( Size ); (* Met-a-jour la taille de la liste L.*) InsertBeforeElem( Pointer, SuccessorList ); (* Ajouter l'objet devant suivre le *) (* pivot dans la liste des succes- *) (* seurs du pivot. *) INC ( SuccessorList^.Size ) END; Pointer := Next END; IF Size > 1 THEN Quicksort( L ) END; IF SuccessorList^.Size > 1 THEN Quicksort( SuccessorList ) END; IF Size # 0 THEN (* On s'assure qu'aucune liste n'est *) (* vide en lui ajoutant possiblement *) (* la valeur du pivot. *) InsertBeforeElem( Pivot, SuccessorList^.Succ ); INC ( SuccessorList^.Size ) (* Le pivot est insere avant la liste *) (* de ses successeurs. *) ELSE InsertBeforeElem( Pivot, L ); INC ( Size ) END; (* Le pivot est insere apres la liste *) (* ses predecesseurs. *) (* Concatene les deux listes. *) SuccessorList^.Succ^.Pred := Pred; SuccessorList^.Pred^.Succ := Pred^.Succ; Pred^.Succ := SuccessorList^.Succ; Pred :=SuccessorList^.Pred; Size := Size + SuccessorList^.Size; (* Detruit la liste temporaire. *) DISPOSE( SuccessorList ); SuccessorList := NIL END END Quicksort; BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF NOT Sorted THEN Error1 (6, L) END; IF Size > 1 THEN Quicksort( L ) END; GoBefore := Precede (* Nouvelle procedure usager *) END END Sort; (******************************************************************************) PROCEDURE Merge ( VAR L1, L2 : List ); VAR P1, P2, HeadP1, HeadP2, Pointer : RefElement; PROCEDURE Equal (A,B : WORD) : BOOLEAN ; BEGIN RETURN INTEGER (A) = INTEGER (B) END Equal; BEGIN IF ((L1 = NIL) OR (L2 = NIL)) THEN Error (0) END; WITH L1^ DO IF NOT (Sorted AND L2^.Sorted) THEN Error2 (2, L1, L2) END; IF ADDRESS (GoBefore) # ADDRESS (L2^.GoBefore) THEN Error2 (3, L1, L2) END; P1 := Succ; P2 := L2^.Succ; HeadP1 := Succ^.Pred; HeadP2 := L2^.Succ^.Pred; WHILE (P1 # HeadP1) AND (P2 # HeadP2) DO IF GoBefore (P1^.Content, P2^.Content) THEN P1 := P1^.Succ ELSE Pointer := P2^.Succ; InsertBeforeElem (P2, P1); P2 := Pointer END END; WHILE (P2 # HeadP2) DO (* Ajoute la fin de L2. *) Pointer := P2^.Succ; InsertBeforeElem (P2, P1); P2 := Pointer END; Size := Size + L2^.Size; Remove (L2, Current, UserLists); DISPOSE (L2); L2 := NIL; IF Stats THEN InitStat (L1) END END END Merge; (******************************************************************************) PROCEDURE Split ( VAR L, L1, L2 : List; Name1, Name2 : ARRAY OF CHAR ); VAR Pointer : RefElement; (* Parcourt L2 determine sa longueur *) n, i : INTEGER; BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Sorted THEN (* Cree L2 avec les memes caracteris- *) (* ques que L. *) CreateOrd (L2, L^.GoBefore, Name2) ELSE Create (L2, Name2) END; IF Size > 0 THEN (* Si L non vide alors divise *) L2^.Pred := Pred; L2^.Pred^.Succ := L2^.Succ; Pred := CurrentElem^.Pred; Pred^.Succ := Succ^.Pred; CurrentElem^.Pred := L2^.Succ; L2^.Succ := CurrentElem; L2^.CurrentElem := CurrentElem; Pointer := L2^.CurrentElem; (* Ajuste les longueurs de L et L2 *) WHILE (Pointer # L2^.Succ^.Pred) DO INC (L2^.Size); Pointer := Pointer^.Succ END; Size := Size - L2^.Size; IF Size > 0 THEN CurrentElem := Succ ELSE CurrentElem := NIL END END; n := HIGH (Name1); IF n >= LongName THEN n := LongName - 1 END; FOR i := 0 TO n DO Descriptor [i] := Name1 [i] END; IF Stats THEN InitStat (L1); CollectStat (L2) END END; L1 := L; (* L1 prend la place de L *) L := NIL END Split; (******************************************************************************) PROCEDURE FindFirstSuchThat ( L : List; VAR P : ADDRESS; Cond : CondProc ); BEGIN View (P, Current, L); WHILE P # NIL DO IF Cond (P) THEN RETURN END; View (P, Next, L) END END FindFirstSuchThat; (*****************************************************************************) PROCEDURE ForEachInListDo ( L : List; Action : ActionProc ); VAR P : ADDRESS; BEGIN View (P, Current, L); WHILE P # NIL DO Action (P); View (P, Next, L) END END ForEachInListDo; (*****************************************************************************) PROCEDURE InitStat ( L : List ); BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Stats THEN TInit := SIM.Time (); STAT.Init (BlockSize); STAT.Init (BlockSojourn); STAT.Update (BlockSize, LFLOAT (Size)) ELSE Error1 (4, L) END END END InitStat; (******************************************************************************) PROCEDURE StatSize ( L : List ) : STAT.Block; BEGIN IF L = NIL THEN Error (0) END; IF L^.Stats THEN RETURN L^.BlockSize ELSE Error1 (7, L) END END StatSize; (******************************************************************************) PROCEDURE StatSojourn ( L : List ) :STAT.Block; BEGIN IF L = NIL THEN Error (0) END; IF L^.Stats THEN RETURN L^.BlockSojourn ELSE Error1 (7, L) END END StatSojourn; (******************************************************************************) PROCEDURE Report ( L : List ); BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Stats THEN WriteLn; WriteString( 'REPORT ON LIST : ' ); WriteString( Descriptor ); WriteLn; WriteString( ' From time ' ); WriteLR ( TInit, 7, 2, 2); WriteString( ' to time ' ); WriteLR ( SIM.Time (), 10, 2, 2); WriteLn; WriteString( ' min max average '); WriteString( 'standard dev. nb. Obs.' ); WriteLn; WriteString( ' Size '); WriteCard ( TRUNC (0.5 + STAT.Minimum ( BlockSize )), 9 ); WriteCard ( TRUNC (0.5 + STAT.Maximum ( BlockSize )), 11 ); WriteLR ( STAT.Average ( BlockSize ), 14, 3, 2); WriteLn; WriteString( ' Sojourn '); WriteLR ( STAT.Minimum ( BlockSojourn ), 12, 3, 2); WriteString( ' ' ); WriteLR ( STAT.Maximum ( BlockSojourn ), 10, 3, 2); WriteString( ' ' ); WriteLR ( STAT.Average ( BlockSojourn ), 10, 3, 2); WriteString( ' ' ); WriteLR ( STAT.StandardDev ( BlockSojourn ), 10, 3, 2); WriteCard ( STAT.NumberObs ( BlockSojourn ), 11 ); WriteLn ELSE Error1 (8, L) END END END Report; (******************************************************************************) PROCEDURE Vide ( L : List ); (* Met la liste sur la pile des elements libres et met a jour la longueur *) (* et les pointeurs Succ, Pred et CurrentElem de la tete de liste. *) (* Note: la longueur de la liste doit etre differente de 0. *) (* Appelee par : Delete, Init. *) (* Procedure non disponible pour l'usager. *) BEGIN WITH L^ DO Pred^.Succ := FreeElements; FreeElements := Succ; Size := 0; Succ := Succ^.Pred; Pred := Succ; CurrentElem := NIL END END Vide; (******************************************************************************) PROCEDURE Init ( L : List ); BEGIN IF L = NIL THEN Error (0) END; WITH L^ DO IF Size # 0 THEN Vide (L) END; IF Stats THEN InitStat (L) END END END Init; (******************************************************************************) PROCEDURE Delete ( VAR L : List ); BEGIN WITH L^ DO IF Stats THEN STAT.Delete (BlockSize); STAT.Delete (BlockSojourn) END; IF Size > 0 THEN Vide (L) END; DISPOSE (L); L := NIL END END Delete; (******************************************************************************) BEGIN CreateSys (UserLists, 'List of lists'); (* La liste des listes de l'usager. *) UserLists^.Sorted := FALSE; (* Liste de type non ordonnee. *) FreeElements := NIL (* Init. la pile des elements libres. *) END LIST.