gcc/ada/a-cusyqu.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --               ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2011-2014, Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- This unit was originally developed by Matthew J Heaney.                  --
  28 ------------------------------------------------------------------------------
  29
  30 with Ada.Unchecked_Deallocation;
  31
  32 package body Ada.Containers.Unbounded_Synchronized_Queues is
  33
  34    pragma Annotate (CodePeer, Skip_Analysis);
  35
  36    package body Implementation is
  37
  38       -----------------------
  39       -- Local Subprograms --
  40       -----------------------
  41
  42       procedure Free is
  43          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  44
  45       -------------
  46       -- Dequeue --
  47       -------------
  48
  49       procedure Dequeue
  50         (List    : in out List_Type;
  51          Element : out Queue_Interfaces.Element_Type)
  52       is
  53          X : Node_Access;
  54
  55       begin
  56          Element := List.First.Element;
  57
  58          X := List.First;
  59          List.First := List.First.Next;
  60
  61          if List.First = null then
  62             List.Last := null;
  63          end if;
  64
  65          List.Length := List.Length - 1;
  66
  67          Free (X);
  68       end Dequeue;
  69
  70       -------------
  71       -- Enqueue --
  72       -------------
  73
  74       procedure Enqueue
  75         (List     : in out List_Type;
  76          New_Item : Queue_Interfaces.Element_Type)
  77       is
  78          Node : Node_Access;
  79
  80       begin
  81          Node := new Node_Type'(New_Item, null);
  82
  83          if List.First = null then
  84             List.First := Node;
  85             List.Last := List.First;
  86
  87          else
  88             List.Last.Next := Node;
  89             List.Last := Node;
  90          end if;
  91
  92          List.Length := List.Length + 1;
  93
  94          if List.Length > List.Max_Length then
  95             List.Max_Length := List.Length;
  96          end if;
  97       end Enqueue;
  98
  99       --------------
 100       -- Finalize --
 101       --------------
 102
 103       procedure Finalize (List : in out List_Type) is
 104          X : Node_Access;
 105
 106       begin
 107          while List.First /= null loop
 108             X := List.First;
 109             List.First := List.First.Next;
 110             Free (X);
 111          end loop;
 112       end Finalize;
 113
 114       ------------
 115       -- Length --
 116       ------------
 117
 118       function Length (List : List_Type) return Count_Type is
 119       begin
 120          return List.Length;
 121       end Length;
 122
 123       ----------------
 124       -- Max_Length --
 125       ----------------
 126
 127       function Max_Length (List : List_Type) return Count_Type is
 128       begin
 129          return List.Max_Length;
 130       end Max_Length;
 131
 132    end Implementation;
 133
 134    protected body Queue is
 135
 136       -----------------
 137       -- Current_Use --
 138       -----------------
 139
 140       function Current_Use return Count_Type is
 141       begin
 142          return List.Length;
 143       end Current_Use;
 144
 145       -------------
 146       -- Dequeue --
 147       -------------
 148
 149       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
 150         when List.Length > 0
 151       is
 152       begin
 153          List.Dequeue (Element);
 154       end Dequeue;
 155
 156       -------------
 157       -- Enqueue --
 158       -------------
 159
 160       entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
 161       begin
 162          List.Enqueue (New_Item);
 163       end Enqueue;
 164
 165       --------------
 166       -- Peak_Use --
 167       --------------
 168
 169       function Peak_Use return Count_Type is
 170       begin
 171          return List.Max_Length;
 172       end Peak_Use;
 173
 174    end Queue;
 175
 176 end Ada.Containers.Unbounded_Synchronized_Queues;