Source code in the ada programming language

generic
   type Element_Type is private;
package Fifo is
   type Fifo_Type is private;
   procedure Push(List : in out Fifo_Type; Item : in Element_Type);
   procedure Pop(List : in out Fifo_Type; Item : out Element_Type);
   function Is_Empty(List : Fifo_Type) return Boolean;
   Empty_Error : exception;
private
   type Fifo_Element;
   type Fifo_Ptr is access Fifo_Element;
   type Fifo_Type is record
      Head : Fifo_Ptr := null;
      Tail : Fifo_Ptr := null;
   end record;
   type Fifo_Element is record
      Value : Element_Type;
      Next  : Fifo_Ptr := null;
   end record;
end Fifo;


with Ada.Unchecked_Deallocation;

package body Fifo is 

   ----------
   -- Push --
   ----------

   procedure Push (List : in out Fifo_Type; Item : in Element_Type) is
      Temp : Fifo_Ptr := new Fifo_Element'(Item, null);
   begin
      if List.Tail = null then
         List.Tail := Temp;
      end if;
      if List.Head /= null then
        List.Head.Next := Temp;
      end if;
      List.Head := Temp;
   end Push;

   ---------
   -- Pop --
   ---------

   procedure Pop (List : in out Fifo_Type; Item : out Element_Type) is
      procedure Free is new Ada.Unchecked_Deallocation(Fifo_Element, Fifo_Ptr);
      Temp : Fifo_Ptr := List.Tail;
   begin
      if List.Head = null then
         raise Empty_Error;
      end if;
      Item := List.Tail.Value;
      List.Tail := List.Tail.Next;
      if List.Tail = null then
         List.Head := null;
      end if;
      Free(Temp);
   end Pop;

   --------------
   -- Is_Empty --
   --------------

   function Is_Empty (List : Fifo_Type) return Boolean is
   begin
      return List.Head = null;
   end Is_Empty; 

end Fifo;


with Fifo;
with Ada.Text_Io; use Ada.Text_Io;

procedure Fifo_Test is
   package Int_Fifo is new Fifo(Integer);
   use Int_Fifo;
   My_Fifo : Fifo_Type;
   Val : Integer;
begin
   for I in 1..10 loop
      Push(My_Fifo, I);
   end loop;
   while not Is_Empty(My_Fifo) loop
      Pop(My_Fifo, Val);
      Put_Line(Integer'Image(Val));
   end loop;
end Fifo_Test;


 
 with Ada.Containers.Doubly_Linked_Lists;
 generic
    type Element_Type is private;
 package Generic_Fifo is
    type Fifo_Type is tagged private;
    procedure Push(The_Fifo : in out Fifo_Type; Item : in Element_Type);
    procedure Pop(The_Fifo : in out Fifo_Type; Item : out Element_Type);
    Empty_Error : Exception;
 private
    package List_Pkg is new Ada.Containers.Doubly_Linked_Lists(Element_Type);
    use List_Pkg;
    Type Fifo_Type is new List with null record;
 end Generic_Fifo;


 package body Generic_Fifo is
 
    ----------
    -- Push --
    ---------- 
 
    procedure Push (The_Fifo : in out Fifo_Type; Item : in Element_Type) is
    begin
       The_Fifo.Prepend(Item);
    end Push;
 
    ---------
    -- Pop --
    ---------
 
    procedure Pop (The_Fifo : in out Fifo_Type; Item : out Element_Type) is
    begin
       if Is_Empty(The_Fifo) then
          raise Empty_Error;
       end if;
       Item := The_Fifo.Last_Element;
       The_Fifo.Delete_Last;
    end Pop;
 
 end Generic_Fifo;


with Generic_Fifo;
with Ada.Text_Io; use Ada.Text_Io;

procedure Generic_Fifo_Test is
   package Int_Fifo is new Generic_Fifo(Integer);
   use Int_Fifo;
   My_Fifo : Fifo_Type;
   Val : Integer;
begin
   for I in 1..10 loop
      My_Fifo.Push(I);
   end loop;
   while not My_Fifo.Is_Empty loop
      My_Fifo.Pop(Val);
      Put_Line(Integer'Image(Val));
   end loop;
end Generic_Fifo_Test;


generic
   type Element_Type is private;
package Synchronous_Fifo is
   protected type Fifo is
      entry Push(Item : Element_Type);
      entry Pop(Item : out Element_Type);
   private
      Value : Element_Type;
      Is_New : Boolean := False;
   end Fifo;
end Synchronous_Fifo;


package body Synchronous_Fifo is

   ----------
   -- Fifo --
   ----------

   protected body Fifo is 

      ---------
      -- Push --
      ---------

      entry Push (Item : Element_Type) when not Is_New is
      begin
         Value := Item;
         Is_New := True;
      end Push; 

      ---------
      -- Pop --
      ---------

      entry Pop (Item : out Element_Type) when Is_New is
      begin
         Item := Value;
         Is_New := False;
      end Pop; 

   end Fifo;

end Synchronous_Fifo;


with Synchronous_Fifo;
with Ada.Text_Io; use Ada.Text_Io;

 procedure Synchronous_Fifo_Test is
    package Int_Fifo is new Synchronous_Fifo(Integer);
    use Int_Fifo;
    Buffer : Fifo;
    
    task Writer is
       entry Stop;
    end Writer;
    
    task body Writer is
       Val : Positive := 1;
    begin
       loop
          select
             accept Stop;
             exit;
          else
             select
                Buffer.Push(Val);
                Val := Val + 1;
             or
                delay 1.0;
             end select;
          end select;
       end loop;
    end Writer;
    
    task Reader is
       entry Stop;
    end Reader;
    
    task body Reader is
       Val : Positive;
    begin
       loop
          select
             accept Stop;
             exit;
          else
             select
                Buffer.Pop(Val);
                Put_Line(Integer'Image(Val));
             or
                 delay 1.0;
            end select;
          end select;
       end loop;
    end Reader;
 begin
    delay 0.1;
    Writer.Stop;
    Reader.Stop;
 end Synchronous_Fifo_Test;


generic
   type Element_Type is private;
package Asynchronous_Fifo is
   protected type Fifo is
      procedure Push(Item : Element_Type);
      entry Pop(Item : out Element_Type);
   private
      Value : Element_Type;
      Valid : Boolean := False;
   end Fifo;
end Asynchronous_Fifo;


package body Asynchronous_Fifo is

   ----------
   -- Fifo --
   ----------

   protected body Fifo is 

      ----------
      -- Push --
      ----------

      procedure Push (Item : Element_Type) is
      begin
          Value := Item;
         Valid := True;
      end Push;

      ---------
      -- Pop --
      ---------

      entry Pop (Item : out Element_Type) when Valid is
      begin
         Item := Value;
      end Pop;

   end Fifo; 

end Asynchronous_Fifo;


with Asynchronous_Fifo;
with Ada.Text_Io; use Ada.Text_Io; 

 procedure Asynchronous_Fifo_Test is
    package Int_Fifo is new Asynchronous_Fifo(Integer);
    use Int_Fifo;
    Buffer : Fifo;
    
    task Writer is
       entry Stop;
    end Writer;
    
    task body Writer is
       Val : Positive := 1;
    begin
       loop
          select
             accept Stop;
             exit;
          else
             Buffer.Push(Val);
             Val := Val + 1;
          end select;
       end loop;
    end Writer;
    
    task Reader is
       entry Stop;
    end Reader;
    
    task body Reader is
       Val : Positive;
    begin
       loop
          select 
             accept Stop;
             exit;
          else
             Buffer.Pop(Val);
             Put_Line(Integer'Image(Val));
          end select;
       end loop;<syntaxhighlight lang="ada">
    end Reader;
 begin
    delay 0.1;
    Writer.Stop;
    Reader.Stop;
 end Asynchronous_Fifo_Test;