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 30with Ada.Unchecked_Deallocation; 31 32package 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 176end Ada.Containers.Unbounded_Synchronized_Queues; 177