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 30package 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 110end Ada.Containers.Unbounded_Priority_Queues; 111