program bank22;

  UNIT PRIORITYQUEUE: CLASS;
  (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)



    UNIT QUEUEHEAD: CLASS;
        (* HEAP ACCESING MODULE *)
             VAR LAST,ROOT:NODE;

             UNIT MIN: FUNCTION: ELEM;
                  BEGIN
                IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
                 END MIN;

             UNIT INSERT: PROCEDURE(R:ELEM);
               (* INSERTION INTO HEAP *)
                   VAR X,Z:NODE;
                 BEGIN
                       X:= R.LAB;
                       IF LAST=NONE THEN
                         ROOT:=X;
                         ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
                       ELSE
                         IF LAST.NS=0 THEN
                           LAST.NS:=1;
                           Z:=LAST.LEFT;
                           LAST.LEFT:=X;
                           X.UP:=LAST;
                           X.LEFT:=Z;
                           Z.RIGHT:=X;
                         ELSE
                           LAST.NS:=2;
                           Z:=LAST.RIGHT;
                           LAST.RIGHT:=X;
                           X.RIGHT:=Z;
                           X.UP:=LAST;
                           Z.LEFT:=X;
                           LAST.LEFT.RIGHT:=X;
                           X.LEFT:=LAST.LEFT;
                           LAST:=Z;
                         FI
                       FI;
                       CALL CORRECT(R,FALSE)
                       END INSERT;

      UNIT DELETE: PROCEDURE(R: ELEM);
      VAR X,Y,Z:NODE;
      BEGIN
        X:=R.LAB;
        Z:=LAST.LEFT;
        IF LAST.NS =0 THEN
           Y:= Z.UP;
           Y.RIGHT:= LAST;
           LAST.LEFT:=Y;
           LAST:=Y;
                   ELSE
           Y:= Z.LEFT;
           Y.RIGHT:= LAST;
            LAST.LEFT:= Y;
                    FI;
        Z.EL.LAB:=X;
        X.EL:= Z.EL;
        LAST.NS:= LAST.NS-1;
        R.LAB:=Z;
        Z.EL:=R;
        IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
                       ELSE CALL CORRECT(X.EL,TRUE) FI;
     END DELETE;

     UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);
     (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)
     VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;
     BEGIN
     Z:=R.LAB;
     IF DOWN THEN
          WHILE NOT FIN DO
                 IF Z.NS =0 THEN FIN:=TRUE ELSE
                      IF Z.NS=1 THEN X:=Z.LEFT ELSE
                      IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT
                       FI; FI;
                      IF Z.LESS(X) THEN FIN:=TRUE ELSE
                            T:=X.EL;
                            X.EL:=Z.EL;
                            Z.EL:=T;
                            Z.EL.LAB:=Z;
                           X.EL.LAB:=X
                      FI; FI;
                 Z:=X;
                       OD
              ELSE
     X:=Z.UP;
     IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
     WHILE NOT LOG DO
          T:=Z.EL;
          Z.EL:=X.EL;
           X.EL:=T;
          X.EL.LAB:=X;
          Z.EL.LAB:=Z;
          Z:=X;
          X:=Z.UP;
           IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
            FI;
                OD
     FI;
     END CORRECT;

    END QUEUEHEAD;


    UNIT NODE: CLASS (EL:ELEM);
    (* ELEMENT OF THE HEAP *)
      VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;
      UNIT LESS: FUNCTION(X:NODE): BOOLEAN;
          BEGIN
          IF X= NONE THEN RESULT:=FALSE
                    ELSE RESULT:=EL.LESS(X.EL) FI;
          END LESS;
    END NODE;

 
    UNIT ELEM: CLASS(PRIOR:REAL);
    (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
    VAR LAB: NODE;
      UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
            BEGIN
            IF X=NONE THEN RESULT:= FALSE ELSE
                           RESULT:= PRIOR< X.PRIOR FI;
            END LESS;
      BEGIN
      LAB:= NEW NODE(THIS ELEM);
    END ELEM;


  END PRIORITYQUEUE;


 
  UNIT SIMULATION: PRIORITYQUEUE CLASS;
  (* THE LANGUAGE FOR SIMULATION PURPOSES *)
 
  VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)
      PQ:QUEUEHEAD,  (* THE TIME AXIS *)
       MAINPR: MAINPROGRAM;


      UNIT SIMPROCESS: COROUTINE;
        (* USER PROCESS PREFIX *)
             VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)
                 EVENTAUX: EVENTNOTICE,
                 (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
                 (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)
                 FINISH: BOOLEAN;
 
             UNIT IDLE: FUNCTION: BOOLEAN;
                   BEGIN
                   RESULT:= EVENT= NONE;
                   END IDLE;

             UNIT TERMINATED: FUNCTION :BOOLEAN;
                   BEGIN
                  RESULT:= FINISH;
                   END TERMINATED;

             UNIT EVTIME: FUNCTION: REAL;
             (* TIME OF ACTIVATION *)
                  BEGIN
                  IF IDLE THEN CALL ERROR1;
                                           FI;
                  RESULT:= EVENT.EVENTTIME;
                  END EVTIME;

    UNIT ERROR1:PROCEDURE;
                BEGIN
                ATTACH(MAIN);
                WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
                END ERROR1;

     UNIT ERROR2:PROCEDURE;
                 BEGIN
                 ATTACH(MAIN);
                 WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
                 END ERROR2;
             BEGIN

             RETURN;
             INNER;
             FINISH:=TRUE;
              CALL PASSIVATE;
             CALL ERROR2;
          END SIMPROCESS;


    UNIT EVENTNOTICE: ELEM CLASS;
    (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)
      VAR EVENTTIME: REAL, PROC: SIMPROCESS;

      UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
       (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
                  BEGIN
                  IF X=NONE THEN RESULT:= FALSE ELSE
                  RESULT:= EVENTTIME< X.EVENTTIME OR
                  (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;

               END LESS;
    END EVENTNOTICE;
 

    UNIT MAINPROGRAM: SIMPROCESS CLASS;
    (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
      BEGIN
      DO ATTACH(MAIN) OD;
    END MAINPROGRAM;
 
    UNIT TIME:FUNCTION:REAL;
    (* CURRENT VALUE OF SIMULATION TIME *)
     BEGIN
     RESULT:=CURRENT.EVTIME
    END TIME;

    UNIT CURRENT: FUNCTION: SIMPROCESS;
    (* THE FIRST PROCESS ON THE TIME AXIS *)
     BEGIN
     RESULT:=CURR;
    END CURRENT;
 
    UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
   (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)
   (* WITHIN TIME MOMENT T                                                  *)
      BEGIN
      IF T<TIME THEN T:= TIME FI;
      IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
      IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
                P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
                P.EVENT.PROC:= P;
                                      ELSE
       IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
               P.EVENT:= P.EVENTAUX;
               P.EVENT.PRIOR:=RANDOM;
                                          ELSE
     (* NEW SCHEDULING *)
               P.EVENT.PRIOR:=RANDOM;
               CALL PQ.DELETE(P.EVENT)
                                FI; FI;
      P.EVENT.EVENTTIME:= T;
      CALL PQ.INSERT(P.EVENT) FI;
    END SCHEDULE;

    UNIT HOLD:PROCEDURE(T:REAL);
    (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
    (* REDEFINE PRIOR                                  *)
     BEGIN
     CALL PQ.DELETE(CURRENT.EVENT);
     CURRENT.EVENT.PRIOR:=RANDOM;
     IF T<0 THEN T:=0; FI;
      CURRENT.EVENT.EVENTTIME:=TIME+T;
     CALL PQ.INSERT(CURRENT.EVENT);
     CALL CHOICEPROCESS;
    END HOLD;
 
    UNIT PASSIVATE: PROCEDURE;
    (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
     BEGIN
      CALL PQ.DELETE(CURRENT.EVENT);
      CURRENT.EVENT:=NONE;
      CALL CHOICEPROCESS
    END PASSIVATE;

    UNIT RUN: PROCEDURE(P:SIMPROCESS);
    (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
    (* PRIOR                                                              *)
     BEGIN
     CURRENT.EVENT.PRIOR:=RANDOM;
     IF NOT P.IDLE THEN
            P.EVENT.PRIOR:=0;
            P.EVENT.EVENTTIME:=TIME;
            CALL PQ.CORRECT(P.EVENT,FALSE)
                    ELSE
      IF P.EVENTAUX=NONE THEN
            P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
            P.EVENT.EVENTTIME:=TIME;
            P.EVENT.PROC:=P;
            CALL PQ.INSERT(P.EVENT)
                        ELSE
             P.EVENT:=P.EVENTAUX;
             P.EVENT.PRIOR:=0;
             P.EVENT.EVENTTIME:=TIME;
             P.EVENT.PROC:=P;
             CALL PQ.INSERT(P.EVENT);
                          FI;FI;
      CALL CHOICEPROCESS;
    END RUN;

    UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
    (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
    BEGIN
     IF P= CURRENT THEN CALL PASSIVATE ELSE
      CALL PQ.DELETE(P.EVENT);
     P.EVENT:=NONE;  FI;
    END CANCEL;

    UNIT CHOICEPROCESS:PROCEDURE;
    (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
    VAR P:SIMPROCESS;
    BEGIN
     P:=CURR;
     CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
     IF CURR=NONE THEN
     WRITE(" ERROR IN THE HEAP"); WRITELN;
                      ATTACH(MAIN);
                 ELSE ATTACH(CURR); FI;
    END CHOICEPROCESS;

  BEGIN
    PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)
    CURR,MAINPR:=NEW MAINPROGRAM;
    MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);
    MAINPR.EVENT.EVENTTIME:=0;
    MAINPR.EVENT.PROC:=MAINPR;
    CALL PQ.INSERT(MAINPR.EVENT);
    (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)
    INNER;
    PQ:=NONE;
  END SIMULATION;


 
  UNIT LISTS:SIMULATION CLASS;
  (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)

           UNIT LINKAGE:CLASS;
            (*WE WILL USE TWO WAY LISTS *)
                VAR SUC1,PRED1:LINKAGE;
                          END LINKAGE;
            UNIT HEAD:LINKAGE CLASS;
            (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
                      UNIT FIRST:FUNCTION:LINK;
                                 BEGIN
                             IF SUC1 IN LINK THEN RESULT:=SUC1
                                             ELSE RESULT:=NONE FI;
                                 END;
                      UNIT EMPTY:FUNCTION:BOOLEAN;
                                 BEGIN
                                 RESULT:=SUC1=THIS LINKAGE;
                                 END EMPTY;
                   BEGIN
                   SUC1,PRED1:=THIS LINKAGE;
                     END HEAD;

          UNIT LINK:LINKAGE CLASS;
           (* ORDINARY LIST ELEMENT PREFIX *)
                     UNIT OUT:PROCEDURE;
                              BEGIN
                              IF SUC1=/=NONE THEN
                                    SUC1.PRED1:=PRED1;
                                    PRED1.SUC1:=SUC1;
                                    SUC1,PRED1:=NONE FI;
                               END OUT;
                     UNIT INTO:PROCEDURE(S:HEAD);
                               BEGIN

                               CALL OUT;
                               IF S=/= NONE THEN
                                    IF S.SUC1=/=NONE THEN
                                            SUC1:=S;
                                            PRED1:=S.PRED1;
                                            PRED1.SUC1:=THIS LINKAGE;
                                            S.PRED1:=THIS LINKAGE;
                                                 FI FI;
                                  END INTO;
                  END LINK;

     UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
     (* USER DEFINED  PROCESS WILL BE JOINED INTO LISTS  *)
                    END ELEM;

    END LISTS;


  unit numero : class(val : real;choix:integer);
    var next : numero;
  end numero;
 
  unit liste : class;
    var tete, queue : numero;
 
 
    unit listevide : function : boolean;
    begin
      if tete = NONE then result := true fi
    end listevide;
 
    unit supprime : procedure(inout valeur:real;inout choix:integer);
      var aux : numero;
    begin
      if listevide then 
        valeur:=-1;
        choix:=0;
      else 
        valeur:=tete.val;
        choix:=tete.choix;
        aux := tete;
        tete := tete.next;
        kill(aux);
      fi
    end supprime;


    unit ajout : procedure(e : real;choix:integer);
      var aux : numero;
    begin
      if listevide then tete, queue := new numero(e,choix)
                   else aux := new numero(e,choix);
                        queue.next := aux;
                        queue := aux
      fi
    end ajout;
 
    unit member : function(e : integer) : boolean;
      var aux : numero;
    begin
      if listevide then exit fi;
      aux := tete;
      do if aux = NONE then exit fi;
         if aux.val = e then result := true;
                             exit
                        else aux := aux.next
         fi
      od
    end member;
 
    unit delliste : procedure;
      var aux : numero;
    begin
      do if listevide then exit fi;
         aux := tete.next;
         kill(tete);
         tete := aux
      od
    end delliste;
  end liste;



 unit station : LISTS class;
   unit prioritaire:procedure;
   var
      i,min:integer;
   begin
     min:=contenu(1);
     numero_prioritaire:=1;
     for i:=2 to nombre_machine
     do
         if( contenu(i)<min )
         then
           min:=contenu(i);
           numero_prioritaire:=i
         fi;
     od;
   end prioritaire;
   unit arrivee_client:simprocess class(nombre_machine,nombre_client:integer);
   var i:integer,
       r:real;
   begin
       for i:=1 to nombre_client
       do
          if( random*10 < 10 )
          then
            (* choix machine *)
            call prioritaire;
            writeln("ARRIVEE : nouveau client sur machine ",
                     numero_prioritaire);
            r:=random;
            if( r*10 < 3 )
            then
              call l(numero_prioritaire).ajout(time,1);
            fi;
            if( r*10 >= 3 ) AND (r*10 < 6 )
            then
              call l(numero_prioritaire).ajout(time,2);
            fi;
            if( r*10 >= 6 )
            then
              call l(numero_prioritaire).ajout(time,3);
            fi;

            contenu(numero_prioritaire):=contenu(numero_prioritaire)+1;
            call hold((nombre_machine+1)*base_temps);
          else
            i:=i-1;
          fi;
       od;
       termine:=1;
       writeln("ARRIVEE : FIN DES ARRIVEES");
       do
         call hold((nombre_machine+1)*base_temps);
       od;
   end arrivee_client;

     unit machine:simprocess class(base_temps,numero:integer);
     var
       total,nombre,heure,valeur:real,
       choix:integer;
     begin
       total:=0;
       nombre:=0;
       while( ( termine = 0 ) OR ( not l(numero).listevide) )
       do
        if( not l(numero).listevide )
        then
            writeln("MACHINE nø",numero," : mise en marche. ");
            heure:=time;
            call l(numero).supprime(valeur,choix);
            writeln("MACHINE nø",numero," : client arrive a ",valeur);
            writeln("MACHINE nø",numero," : client servit a ",heure);
            total:=total+(heure-valeur);
            nombre:=nombre+1;
            nbre_client(numero):=nbre_client(numero)+1;
            writeln(" MMMMMMMMMMMMMMMMMMMMMMMMM choix :",choix);
            if( choix > 1 )
            then
              (* prelavage *)
              writeln(" MACHINE nø",numero," : prelavage de la voiture ",
                      nombre);
              call hold(5*(nombre_machine+1)*base_temps);
            fi;

            (* lavage *)
            writeln(" MACHINE nø",numero," : lavage de la voiture ",nombre);
            call hold(10*(nombre_machine+1)*base_temps);
            if( choix > 2 )
            then
              (* lustrage *)
              writeln(" MACHINE nø",numero," : lustrage de la voiture ",
                      nombre);
              call hold(10*(nombre_machine+1)*base_temps);
            fi;

            (* rincage *)
            writeln(" MACHINE nø",numero," : rincage de la voiture ",nombre);
            contenu(numero):=contenu(numero)-1;
            call prioritaire;

        fi;
        call hold(5*(nombre_machine+1)*base_temps);
    od;
    if( nombre <> 0 )
    then
      writeln("MACHINE nø",numero," : mise a jour resultat -->",total/nombre);
      resultat(numero):=total/nombre;
    fi;
    fini:=fini+1;
    writeln("MACHINE nø",numero," ARRET DE LA MACHINE");
    do
        call hold((nombre_machine+1)*base_temps);
    od;
  end machine;

 end station;

 var
   l:arrayof liste,
   k,termine,numero_prioritaire:integer,
   contenu:arrayof integer,
   fini,nombre_machine,nombre_client,numero_machine:integer,
   resultat:arrayof real,
   moyenne,base_temps,base_temps2:real,
   nbre_client:arrayof integer;
 begin  
   PREF station BLOCK

     UNIT GENERATOR:SIMPROCESS CLASS;

              BEGIN
              for k:=1 to nombre_machine
              DO
                CALL SCHEDULE(NEW machine(base_temps,k),TIME+k*base_temps);
              OD;
              CALL SCHEDULE(NEW arrivee_client(nombre_machine,nombre_client),
                            TIME+k*base_temps);

     END GENERATOR;
   BEGIN
       write("MAIN : donner le nombre de machines:");
       readln(nombre_machine);
       write("MAIN : donner le nombre de clients:");
       readln(nombre_client);
       write("MAIN : donner la base de temps:");
       readln(base_temps);
       write("MAIN : donner la tempo du main:");
       readln(base_temps2);

       fini:=0;
       numero_prioritaire:=1;
       array nbre_client dim(1:nombre_machine);
       array contenu dim(1:nombre_machine);
       array l dim (1:nombre_machine);
       array resultat dim (1:nombre_machine);
       for k:=1 to nombre_machine
       do
         l(k):=new liste;
       od;

       for k:=1 to nombre_machine
       do
         resultat(k):=0.0;
         contenu(k):=0;
         nbre_client(k):=0;
       od;

       CALL SCHEDULE(NEW GENERATOR,TIME);

       while (fini<nombre_machine) 
       do
         call hold(base_temps2);
       od;
       moyenne:=0;
       for k:=1 to nombre_machine
       do
         writeln("MAIN: resultat machine numero ",k," = ",resultat(k));
         writeln("MAIN : nombre de client machine numero ",k," = ",
                 nbre_client(k));
         moyenne:=moyenne+resultat(k);
       od;
       writeln("MAIN : le temps d'attente moyen pour laver sa voiture est ",
                moyenne/nombre_machine);
     end;
   END;
end bank22;