1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2011-2019, 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 30with Ada.Unchecked_Deallocation; 31 32package 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 174end Ada.Containers.Unbounded_Synchronized_Queues; 175