------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a GNU GPL real-time scheduling analysis tool.
-- This program provides services to automatically check schedulability and
-- other performance criteria of real-time architecture models.
--
-- Copyright (C) 2002-2023, Frank Singhoff, Alain Plantec, Jerome Legrand,
--                          Hai Nam Tran, Stephane Rubini
--
-- The Cheddar project was started in 2002 by
-- Frank Singhoff, Lab-STICC UMR 6285, Université de Bretagne Occidentale
--
-- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008.
-- Since 2008, Ellidiss technologies also contributes to the development of
-- Cheddar and provides industrial support.
--
-- The full list of contributors and sponsors can be found in README.md
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--
-- Contact : cheddar@listes.univ-brest.fr
--
------------------------------------------------------------------------------
-- Last update :
--    $Rev$
--    $Date$
--    $Author: singhoff $
------------------------------------------------------------------------------
------------------------------------------------------------------------------

with Text_IO; use Text_IO;

package body fifos is

   -- increment or decrement an index
   --
   procedure increment_index (index : in out element_range) is
   begin
      if (index = element_range'last) then
         index := element_range'first;
      else
         index := index + 1;
      end if;
   end increment_index;

   procedure decrement_index (index : in out element_range) is
   begin
      if (index = element_range'first) then
         index := element_range'last;
      else
         index := index - 1;
      end if;
   end decrement_index;

   procedure reset (my_fifo : in out fifo) is
   begin
      my_fifo.queue := 0;
      my_fifo.head  := 0;
      my_fifo.size  := 0;
   end reset;

   procedure put (my_fifo : in fifo) is
      index : element_range := my_fifo.queue;
   begin
      Put_Line
        ("Fifo : queue = " &
         my_fifo.queue'img &
         "; head = " &
         my_fifo.head'img &
         "; size = " &
         my_fifo.size'img);
      while (index /= my_fifo.head) loop
         put (my_fifo.data (index));
         increment_index (index);
      end loop;
      New_Line;
   end put;

   procedure insert (my_fifo : in out fifo; e : in element) is
      tmp : element_range := my_fifo.queue;
   begin
      increment_index (tmp);
      if (my_fifo.head = tmp) then
         raise full_fifo;
      end if;
      my_fifo.data (my_fifo.queue) := e;
      increment_index (my_fifo.queue);
      my_fifo.size := my_fifo.size + 1;
   end insert;

   procedure remove (my_fifo : in out fifo) is
   begin
      if is_empty (my_fifo) then
         raise empty_fifo;
      end if;
      increment_index (my_fifo.head);
      my_fifo.size := my_fifo.size - 1;
   end remove;

   function consult (my_fifo : in fifo) return element is
   begin
      if is_empty (my_fifo) then
         raise empty_fifo;
      end if;
      return (my_fifo.data (my_fifo.head));
   end consult;

   function is_empty (my_fifo : in fifo) return Boolean is
   begin
      return (my_fifo.queue = my_fifo.head);
   end is_empty;

   function get_size (my_fifo : in fifo) return Natural is
   begin
      return (my_fifo.size);
   end get_size;

   procedure sort (my_fifo : in out fifo; order : order_function) is
      temp       : element;
      index      : element_range;
      index_next : element_range;
   begin
      for i in 1 .. my_fifo.size loop
         index := my_fifo.head;
         for j in 1 .. my_fifo.size - 1 loop
            index_next := index;
            increment_index (index_next);
            if not order (my_fifo.data (index), my_fifo.data (index_next)) then
               temp                      := my_fifo.data (index);
               my_fifo.data (index)      := my_fifo.data (index_next);
               my_fifo.data (index_next) := temp;
            end if;
            increment_index (index);
         end loop;
      end loop;
   end sort;

   procedure remove_any_where (my_fifo : in out fifo; e : in element) is
      index      : element_range := my_fifo.head;
      index_next : element_range;
   begin
      if is_empty (my_fifo) then
         raise empty_fifo;
      end if;
      if (my_fifo.size = 1) then
         if (my_fifo.data (index) = e) then
            reset (my_fifo);
            return;
         else
            raise element_not_found;
         end if;
      end if;

      -- When the fifo as more than 1 element
      --
      loop
         if (my_fifo.data (index) = e) then
            index_next := index;
            increment_index (index_next);
            loop
               my_fifo.data (index) := my_fifo.data (index_next);
               if index_next = my_fifo.queue then
                  my_fifo.size  := my_fifo.size - 1;
                  my_fifo.queue := index;
                  return;
               end if;
               increment_index (index);
               increment_index (index_next);
            end loop;
         end if;
         exit when index = my_fifo.queue;
         increment_index (index);
      end loop;

      raise element_not_found;
   end remove_any_where;

end fifos;