1------------------------------------------------------------------------------ 2-- -- 3-- GNAT LIBRARY COMPONENTS -- 4-- -- 5-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_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.Bounded_Synchronized_Queues is 31 32 package body Implementation is 33 34 ------------- 35 -- Dequeue -- 36 ------------- 37 38 procedure Dequeue 39 (List : in out List_Type; 40 Element : out Queue_Interfaces.Element_Type) 41 is 42 EE : Element_Array renames List.Elements; 43 44 begin 45 Element := EE (List.First); 46 List.Length := List.Length - 1; 47 48 if List.Length = 0 then 49 List.First := 0; 50 List.Last := 0; 51 52 elsif List.First <= List.Last then 53 List.First := List.First + 1; 54 55 else 56 List.First := List.First + 1; 57 58 if List.First > List.Capacity then 59 List.First := 1; 60 end if; 61 end if; 62 end Dequeue; 63 64 ------------- 65 -- Enqueue -- 66 ------------- 67 68 procedure Enqueue 69 (List : in out List_Type; 70 New_Item : Queue_Interfaces.Element_Type) 71 is 72 begin 73 if List.Length >= List.Capacity then 74 raise Capacity_Error with "No capacity for insertion"; 75 end if; 76 77 if List.Length = 0 then 78 List.Elements (1) := New_Item; 79 List.First := 1; 80 List.Last := 1; 81 82 elsif List.First <= List.Last then 83 if List.Last < List.Capacity then 84 List.Elements (List.Last + 1) := New_Item; 85 List.Last := List.Last + 1; 86 87 else 88 List.Elements (1) := New_Item; 89 List.Last := 1; 90 end if; 91 92 else 93 List.Elements (List.Last + 1) := New_Item; 94 List.Last := List.Last + 1; 95 end if; 96 97 List.Length := List.Length + 1; 98 99 if List.Length > List.Max_Length then 100 List.Max_Length := List.Length; 101 end if; 102 end Enqueue; 103 104 ------------ 105 -- Length -- 106 ------------ 107 108 function Length (List : List_Type) return Count_Type is 109 begin 110 return List.Length; 111 end Length; 112 113 ---------------- 114 -- Max_Length -- 115 ---------------- 116 117 function Max_Length (List : List_Type) return Count_Type is 118 begin 119 return List.Max_Length; 120 end Max_Length; 121 122 end Implementation; 123 124 protected body Queue is 125 126 ----------------- 127 -- Current_Use -- 128 ----------------- 129 130 function Current_Use return Count_Type is 131 begin 132 return List.Length; 133 end Current_Use; 134 135 ------------- 136 -- Dequeue -- 137 ------------- 138 139 entry Dequeue (Element : out Queue_Interfaces.Element_Type) 140 when List.Length > 0 141 is 142 begin 143 List.Dequeue (Element); 144 end Dequeue; 145 146 ------------- 147 -- Enqueue -- 148 ------------- 149 150 entry Enqueue (New_Item : Queue_Interfaces.Element_Type) 151 when List.Length < Capacity 152 is 153 begin 154 List.Enqueue (New_Item); 155 end Enqueue; 156 157 -------------- 158 -- Peak_Use -- 159 -------------- 160 161 function Peak_Use return Count_Type is 162 begin 163 return List.Max_Length; 164 end Peak_Use; 165 166 end Queue; 167 168end Ada.Containers.Bounded_Synchronized_Queues; 169