gcc/ada/libgnat/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-2017, 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    package body Implementation is
  35
  36       -----------------------
  37       -- Local Subprograms --
  38       -----------------------
  39
  40       procedure Free is
  41          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  42
  43       -------------
  44       -- Dequeue --
  45       -------------
  46
  47       procedure Dequeue
  48         (List    : in out List_Type;
  49          Element : out Queue_Interfaces.Element_Type)
  50       is
  51          X : Node_Access;
  52
  53       begin
  54          Element := List.First.Element;
  55
  56          X := List.First;
  57          List.First := List.First.Next;
  58
  59          if List.First = null then
  60             List.Last := null;
  61          end if;
  62
  63          List.Length := List.Length - 1;
  64
  65          Free (X);
  66       end Dequeue;
  67
  68       -------------
  69       -- Enqueue --
  70       -------------
  71
  72       procedure Enqueue
  73         (List     : in out List_Type;
  74          New_Item : Queue_Interfaces.Element_Type)
  75       is
  76          Node : Node_Access;
  77
  78       begin
  79          Node := new Node_Type'(New_Item, null);
  80
  81          if List.First = null then
  82             List.First := Node;
  83             List.Last := List.First;
  84
  85          else
  86             List.Last.Next := Node;
  87             List.Last := Node;
  88          end if;
  89
  90          List.Length := List.Length + 1;
  91
  92          if List.Length > List.Max_Length then
  93             List.Max_Length := List.Length;
  94          end if;
  95       end Enqueue;
  96
  97       --------------
  98       -- Finalize --
  99       --------------
 100
 101       procedure Finalize (List : in out List_Type) is
 102          X : Node_Access;
 103
 104       begin
 105          while List.First /= null loop
 106             X := List.First;
 107             List.First := List.First.Next;
 108             Free (X);
 109          end loop;
 110       end Finalize;
 111
 112       ------------
 113       -- Length --
 114       ------------
 115
 116       function Length (List : List_Type) return Count_Type is
 117       begin
 118          return List.Length;
 119       end Length;
 120
 121       ----------------
 122       -- Max_Length --
 123       ----------------
 124
 125       function Max_Length (List : List_Type) return Count_Type is
 126       begin
 127          return List.Max_Length;
 128       end Max_Length;
 129
 130    end Implementation;
 131
 132    protected body Queue is
 133
 134       -----------------
 135       -- Current_Use --
 136       -----------------
 137
 138       function Current_Use return Count_Type is
 139       begin
 140          return List.Length;
 141       end Current_Use;
 142
 143       -------------
 144       -- Dequeue --
 145       -------------
 146
 147       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
 148         when List.Length > 0
 149       is
 150       begin
 151          List.Dequeue (Element);
 152       end Dequeue;
 153
 154       -------------
 155       -- Enqueue --
 156       -------------
 157
 158       entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
 159       begin
 160          List.Enqueue (New_Item);
 161       end Enqueue;
 162
 163       --------------
 164       -- Peak_Use --
 165       --------------
 166
 167       function Peak_Use return Count_Type is
 168       begin
 169          return List.Max_Length;
 170       end Peak_Use;
 171
 172    end Queue;
 173
 174 end Ada.Containers.Unbounded_Synchronized_Queues;