gcc/ada/libgnat/a-cuprqu.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                 ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2011-2018, 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 package body Ada.Containers.Unbounded_Priority_Queues is
  31
  32    protected body Queue is
  33
  34       -----------------
  35       -- Current_Use --
  36       -----------------
  37
  38       function Current_Use return Count_Type is
  39       begin
  40          return Q_Elems.Length;
  41       end Current_Use;
  42
  43       -------------
  44       -- Dequeue --
  45       -------------
  46
  47       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
  48         when Q_Elems.Length > 0
  49       is
  50          --  Grab the first item of the set, and remove it from the set
  51
  52          C : constant Cursor := First (Q_Elems);
  53       begin
  54          Element := Sets.Element (C).Item;
  55          Delete_First (Q_Elems);
  56       end Dequeue;
  57
  58       --------------------------------
  59       -- Dequeue_Only_High_Priority --
  60       --------------------------------
  61
  62       procedure Dequeue_Only_High_Priority
  63         (At_Least : Queue_Priority;
  64          Element  : in out Queue_Interfaces.Element_Type;
  65          Success  : out Boolean)
  66       is
  67          --  Grab the first item. If it exists and has appropriate priority,
  68          --  set Success to True, and remove that item. Otherwise, set Success
  69          --  to False.
  70
  71          C : constant Cursor := First (Q_Elems);
  72       begin
  73          Success := Has_Element (C) and then
  74             not Before (At_Least, Get_Priority (Sets.Element (C).Item));
  75
  76          if Success then
  77             Element := Sets.Element (C).Item;
  78             Delete_First (Q_Elems);
  79          end if;
  80       end Dequeue_Only_High_Priority;
  81
  82       -------------
  83       -- Enqueue --
  84       -------------
  85
  86       entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
  87       begin
  88          Insert (Q_Elems, (Next_Sequence_Number, New_Item));
  89          Next_Sequence_Number := Next_Sequence_Number + 1;
  90
  91          --  If we reached a new high-water mark, increase Max_Length
  92
  93          if Q_Elems.Length > Max_Length then
  94             pragma Assert (Max_Length + 1 = Q_Elems.Length);
  95             Max_Length := Q_Elems.Length;
  96          end if;
  97       end Enqueue;
  98
  99       --------------
 100       -- Peak_Use --
 101       --------------
 102
 103       function Peak_Use return Count_Type is
 104       begin
 105          return Max_Length;
 106       end Peak_Use;
 107
 108    end Queue;
 109
 110 end Ada.Containers.Unbounded_Priority_Queues;