adacl-queue.ads

1----------------------------------------------------------------------------
2--: @filename adacl-queue.ads
3--: @brief Ada Class Library, Queues.
4--: @author Martin Krischik
5--: @version 5.0.9
6--: @copyright © 2003 … 2024 Martin Krischik
7--: @licence GNU Library General Public License
8----------------------------------------------------------------------------
9--: Copyright © 2003 … 2024 Martin Krischik
10--:
11--: This library is free software; you can redistribute it and/or
12--: modify it under the terms of the GNU Library General Public
13--: License as published by the Free Software Foundation; either
14--: version 2 of the License, or (at your option) any later version.
15--:
16--: This library is distributed in the hope that it will be useful,
17--: but WITHOUT ANY WARRANTY; without even the implied warranty of
18--: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19--: Library General Public License for more details.
20--:
21--: You should have received a copy of the GNU Library General Public
22--: License along with this library; if not, write to the Free
23--: Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24----------------------------------------------------------------------------
25
26pragma License (Modified_GPL);
27pragma Ada_2022;
28
29with Ada.Containers;
30with Ada.Strings.Text_Buffers;
31with AdaCL.Pointer.Element;
32with AdaCL.Pointer.Holder;
33
34private with Ada.Containers.Bounded_Doubly_Linked_Lists;
35private with Ada.Containers.Synchronized_Queue_Interfaces;
36private with AdaCL.Pointer.Unique;
37
38---
39-- @summary
40-- Queues for Multitasking.
41--
42-- @description
43-- A queue specifially designed for multi process use. It addition to Ada.Containers.Synchronized_Queue_Interfaces it
44-- offeres and end of queue flag, wait for all elements processed and premature abort command.
45--
46--: @formal Element_Type This is the type being contained in the container.
47--: @formal Null_Element Null element used as placeholder if queue is empty. A Null_Element can be added
48--: to the queue and will be processed like any other element.
49--: @formal Default_Maximum_Size default maxiumum size of queue.
50--: @formal "=" Equality for elements.
51--
52generic
53 type Element_Type is private;
54 Null_Element : in Element_Type;
55 Default_Maximum_Size : in Ada.Containers.Count_Type := 32;
56 with function "=" (Left, Right : Element_Type) return Boolean is <>;
57package AdaCL.Queue is
58 use type Ada.Containers.Count_Type;
59
60 --: -----------------------------------------------------------------------
61
62 package Interfaces is
63
64 type Object is limited interface;
65
66 ---
67 -- The last element has been added, clear queue and finish processing.
68 --
69 --: @param This object itself.
70 procedure Finish (This : in out Object) is abstract;
71
72 ---
73 -- The queue is finishing. No new entries are allowed.
74 --
75 --: @param This object itself.
76 --: @return true if the queue has been signaled to finsh or has finished
77 function Is_Finishing (This : in Object) return Boolean is abstract;
78
79 ---
80 -- Queue slots currently in use
81 --
82 --: @param This object itself.
83 --: @return elements in queue
84 function Current_Use (This : Object) return Ada.Containers.Count_Type is abstract with
85 Inline;
86
87 ---
88 -- Queue is currently empty.
89 --
90 --: @param This object itself.
91 --: @return true when no elements are in queue.
92 function Is_Empty (This : Object) return Boolean is abstract with
93 Post'Class => Is_Empty'Result = (This.Current_Use = 0);
94
95 ---
96 -- The last element has been removed after the queue been signaled to finsh.
97 --
98 --: @param This object itself.
99 --: @return true if the queue has finished processing elements.
100 function Has_Finished (This : in Object) return Boolean is abstract with
101 Post'Class => Has_Finished'Result = (This.Is_Finishing and then This.Is_Empty);
102
103 ---
104 -- Wait for queue to finish
105 --
106 --: @param This object itself.
107 procedure Wait_Finished (This : in out Object) is abstract with
108 Post'Class => (This.Is_Finishing and then This.Is_Empty);
109
110 ---
111 -- Free entries available in Object.
112 --
113 --: @param This object itself.
114 --: @return free slots in queue
115 function Available (This : Object) return Ada.Containers.Count_Type is abstract;
116
117 ---
118 -- Add a new element to the Object. Blocks when queue is full.
119 --
120 --: @param This object itself.
121 --: @param New_Item Element ot be added.
122 procedure Enqueue (This : in out Object; New_Item : in Element_Type) is abstract;
123
124 ---
125 -- Remove element from the Object. Blocks when queue is empty and not finished. When queue is finished and is
126 -- empty returns then Null_Element.
127 --
128 --: @param This object itself.
129 --: @param Element Element ot be removed.
130 --: @param EmptyAndFinished Object is emptys and finshed. Depending on timing you might or might not
131 --: get a last Dequeue with this flag beeing true.
132 procedure Dequeue
133 (This : in out Object;
134 Element : out Element_Type;
135 EmptyAndFinished : out Boolean) is abstract with
136 Post'Class => (if EmptyAndFinished then Element = Null_Element);
137
138 --
139 -- Abort queue. For example because of an error condition
140 --
141 --: @param This object itself.
142 procedure Abort_Queue (This : in out Object) is abstract with
143 Post'Class => (This.Is_Finishing and then This.Is_Empty);
144
145 end Interfaces;
146
147 --: -----------------------------------------------------------------------
148
149 package Protect is
150 Illeagal_State_Error : exception;
151
152 --
153 -- A protected Queue. Adding and removing elements from this queue is protrected so that this queue can be used
154 -- in tasks.
155 --
156 type Object (Maximum_Size : Ada.Containers.Count_Type := Default_Maximum_Size) is
157 new AdaCL.Pointer.Element.Object and Interfaces.Object with private;
158
159 ---
160 -- The last element has been added, clear queue and finish processing.
161 --
162 --: @param This object itself.
163 overriding procedure Finish (This : in out Object);
164
165 ---
166 -- The queue is finishing. No new entries are allowed.
167 --
168 --: @param This object itself.
169 --: @return true if the queue has been signaled to finsh or has finished
170 overriding function Is_Finishing (This : in Object) return Boolean with
171 Inline;
172
173 ---
174 -- Queue slots currently in use
175 --
176 --: @param This object itself.
177 --: @return elements in queue
178 overriding function Current_Use (This : Object) return Ada.Containers.Count_Type;
179
180 ---
181 -- Queue is currently empty.
182 --
183 --: @param This object itself.
184 --: @return true when no elements are in queue.
185 overriding function Is_Empty (This : Object) return Boolean with
186 Post'Class => Is_Empty'Result = (This.Current_Use = 0);
187
188 ---
189 -- The last element has been removed after the queue been signaled to finsh.
190 --
191 --: @param This object itself.
192 --: @return true if the queue has finished processing elements.
193 overriding function Has_Finished (This : in Object) return Boolean with
194 Post'Class => Has_Finished'Result = (This.Is_Finishing and then This.Is_Empty);
195
196 ---
197 -- Wait for queue to finish
198 --
199 --: @param This object itself.
200 overriding procedure Wait_Finished (This : in out Object) with
201 Post'Class => (This.Is_Finishing and then This.Is_Empty);
202
203 ---
204 -- Free entries available in Object.
205 --
206 --: @param This object itself.
207 --: @return free slots in queue
208 overriding function Available (This : Object) return Ada.Containers.Count_Type with
209 Post'Class => Available'Result = (if This.Is_Finishing then 0 else This.Maximum_Size - This.Current_Use);
210
211 ---
212 -- Add a new element to the Object. Blocks when queue is full.
213 --
214 --: @param This object itself.
215 --: @param New_Item Element ot be added.
216 overriding procedure Enqueue (This : in out Object; New_Item : in Element_Type);
217
218 ---
219 -- Remove element from the Object. Blocks when queue is empty and not finished. When queue is finished and is
220 -- empty returns then Null_Element.
221 --
222 --: @param This object itself.
223 --: @param Element Element ot be removed.
224 --: @param EmptyAndFinished Object is emptys and finshed. Depending on timing you might or might not
225 --: get a last Dequeue with this flag beeing true.
226 overriding procedure Dequeue
227 (This : in out Object;
228 Element : out Element_Type;
229 EmptyAndFinished : out Boolean) with
230 Post'Class => (if EmptyAndFinished then Element = Null_Element);
231
232 --
233 -- Abort queue. For example because of an error condition
234 --
235 --: @param This object itself.
236 overriding procedure Abort_Queue (This : in out Object) with
237 Post'Class => (This.Is_Finishing and then This.Is_Empty);
238
239 private
240 package Inherited renames AdaCL.Pointer.Element;
241 package Core is new Ada.Containers.Synchronized_Queue_Interfaces (Element_Type);
242 package Lists is new Ada.Containers.Bounded_Doubly_Linked_Lists (Element_Type);
243 subtype List is Lists.List;
244
245 protected type Sychronized_Object
246 (Maximum_Size : Ada.Containers.Count_Type)
247 is new Core.Queue and Interfaces.Object with
248 overriding procedure Finish;
249
250 overriding function Available return Ada.Containers.Count_Type with
251 Inline;
252
253 overriding function Is_Finishing return Boolean with
254 Inline;
255
256 overriding function Current_Use return Ada.Containers.Count_Type with
257 Inline;
258
259 overriding function Peak_Use return Ada.Containers.Count_Type with
260 Inline;
261
262 overriding function Is_Empty return Boolean with
263 Inline;
264
265 overriding function Has_Finished return Boolean with
266 Inline;
267
268 overriding entry Wait_Finished;
269
270 overriding entry Enqueue (New_Item : in Element_Type);
271
272 overriding entry Dequeue (Element : out Element_Type);
273
274 overriding entry Dequeue (Element : out Element_Type; EmptyAndFinished : out Boolean);
275
276 overriding procedure Abort_Queue;
277
278 private
279 ---
280 -- container to store elements.
281 --
282 Data : List (Maximum_Size);
283
284 ---
285 -- Queue Status
286 --
287 Finish_Flag : Boolean := False;
288 end Sychronized_Object;
289
290 package Sychronized_Holder is new AdaCL.Pointer.Unique (Sychronized_Object);
291
292 --
293 -- Instanz Data
294 --
295 --: @entry Delegate queue to delegate Enqueue and Dequeue to.
296 type Object (Maximum_Size : Ada.Containers.Count_Type := Default_Maximum_Size) is
297 new AdaCL.Pointer.Element.Object and Interfaces.Object with record
298 Delegate : Sychronized_Holder.Object := Sychronized_Holder.Create (new Sychronized_Object (Maximum_Size));
299 end record with
300 Put_Image => Object_Image;
301
302 procedure Object_Image (Output : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; This : Object);
303
304 ---
305 -- The Object is finishing. No new entries are allowed.
306 --
307 --: @param This object itself.
308 overriding function Is_Finishing (This : in Object) return Boolean is (This.Delegate.Get.Is_Finishing);
309
310 overriding function Current_Use (This : in Object) return Ada.Containers.Count_Type is
311 (This.Delegate.Get.Current_Use);
312
313 overriding function Is_Empty (This : Object) return Boolean is (This.Delegate.Get.Is_Empty);
314
315 overriding function Has_Finished (This : in Object) return Boolean is (This.Delegate.Get.Has_Finished);
316
317 overriding function Available (This : Object) return Ada.Containers.Count_Type is (This.Delegate.Get.Available);
318
319 end Protect;
320
321 package Protected_Holder is new AdaCL.Pointer.Holder (Protect.Object);
322 subtype Protected_Object is Protected_Holder.Object;
323
324 ---
325 -- creates a new protected queue. Use this method to make use of the reference counting mechanism.
326 --
327 --: @param Maximum_Size of the queue;
328 function Create_Protect
329 (Maximum_Size : in Ada.Containers.Count_Type := Default_Maximum_Size) return Protected_Object is
330 (Protected_Holder.Create (new Protect.Object (Maximum_Size)));
331
332end AdaCL.Queue;
333
334--: vim: set textwidth=0 nowrap tabstop=8 shiftwidth=3 softtabstop=3 expandtab :
335--: vim: set filetype=ada fileencoding=utf-8 fileformat=unix foldmethod=expr :
336--: vim: set nospell spelllang=en :