-- PQ (10/12) ; PM (10/14)

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions;

-- Priorité rédacteurs, approche automate.
package body LR.Synchro.Priored is

   -- La mise en oeuvre d'une stricte priorité rédacteurs est problématique,
   -- car on ne peut réévaluer les gardes: si l'ouverture de l'entrée Demander_Lecture
   -- se fait vu l'état courant (pas de rédacteur en attente) et qu'ensuite un
   -- rédacteur arrive, l'entrée est toujours ouverte et un lecteur peut
   -- passer. Par contre les lecteurs suivants attendront comme il faut :
   -- il y a absence de famine des rédacteurs et un seul lecteur qui peut
   -- doubler, c'est le mieux qu'on puisse faire ainsi.

   function Nom_Strategie return String is
   begin
      return "Automate, priorité rédacteurs";
   end Nom_Strategie;

   task LectRedTask is
      entry Demander_Lecture;
      entry Demander_Ecriture;
      entry Terminer_Lecture;
      entry Terminer_Ecriture;
   end LectRedTask;

   task body LectRedTask is
      type EtatType is (Libre, Lecture, Ecriture);
      etat : EtatType := Libre;
      nbLecteurs : Natural := 0; -- etat Lecture seulement
   begin
        loop
            case etat is
                when Libre =>
                    select
                        when Demander_Ecriture'Count = 0 =>
                            accept Demander_Lecture;
                            etat := Lecture;
                            NbLecteurs := 1;
                    or
                        accept Demander_Ecriture;
                        etat := Ecriture;
                    end select;
                when Lecture =>
                    select
                        when Demander_Ecriture'Count = 0 =>
                            accept Demander_Lecture;
                            NbLecteurs := NbLecteurs + 1;
                    or
                        accept Terminer_Lecture;
                        NbLecteurs := NbLecteurs - 1;
                        if NbLecteurs = 0 then
                            etat := Libre;
                        end if;
                    end select;
                when Ecriture =>
                        accept Terminer_Ecriture;
                        etat := Libre;
            end case;
        end loop;
   exception
      when Error: others =>
         Put_Line("**** LectRedTask: exception: " & Ada.Exceptions.Exception_Information(Error));
   end LectRedTask;

   procedure Demander_Lecture is
   begin
      LectRedTask.Demander_Lecture;
   end Demander_Lecture;

   procedure Demander_Ecriture is
   begin
      LectRedTask.Demander_Ecriture;
   end Demander_Ecriture;

   procedure Terminer_Lecture is
   begin
      LectRedTask.Terminer_Lecture;
   end Terminer_Lecture;

   procedure Terminer_Ecriture is
   begin
      LectRedTask.Terminer_Ecriture;
   end Terminer_Ecriture;

end LR.Synchro.Priored;