File : a-coinho-shared.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT LIBRARY COMPONENTS --
4 -- --
5 -- A D A . C O N T A I N E R S . I N D E F I N I T E _ H O L D E R S --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2013-2015, Free Software Foundation, Inc. --
10 -- --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
14 -- --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
21 -- --
22 -- --
23 -- --
24 -- --
25 -- --
26 -- You should have received a copy of the GNU General Public License and --
27 -- a copy of the GCC Runtime Library Exception along with this program; --
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
29 -- <http://www.gnu.org/licenses/>. --
30 ------------------------------------------------------------------------------
31
32 -- This is an optimized version of Indefinite_Holders using copy-on-write.
33 -- It is used on platforms that support atomic built-ins.
34
35 private with Ada.Finalization;
36 private with Ada.Streams;
37
38 private with System.Atomic_Counters;
39
40 generic
41 type Element_Type (<>) is private;
42 with function "=" (Left, Right : Element_Type) return Boolean is <>;
43
44 package Ada.Containers.Indefinite_Holders is
45 pragma Annotate (CodePeer, Skip_Analysis);
46 pragma Preelaborate (Indefinite_Holders);
47 pragma Remote_Types (Indefinite_Holders);
48
49 type Holder is tagged private;
50 pragma Preelaborable_Initialization (Holder);
51
52 Empty_Holder : constant Holder;
53
54 function "=" (Left, Right : Holder) return Boolean;
55
56 function To_Holder (New_Item : Element_Type) return Holder;
57
58 function Is_Empty (Container : Holder) return Boolean;
59
60 procedure Clear (Container : in out Holder);
61
62 function Element (Container : Holder) return Element_Type;
63
64 procedure Replace_Element
65 (Container : in out Holder;
66 New_Item : Element_Type);
67
68 procedure Query_Element
69 (Container : Holder;
70 Process : not null access procedure (Element : Element_Type));
71 procedure Update_Element
72 (Container : in out Holder;
73 Process : not null access procedure (Element : in out Element_Type));
74
75 type Constant_Reference_Type
76 (Element : not null access constant Element_Type) is private
77 with
78 Implicit_Dereference => Element;
79
80 type Reference_Type
81 (Element : not null access Element_Type) is private
82 with
83 Implicit_Dereference => Element;
84
85 function Constant_Reference
86 (Container : aliased Holder) return Constant_Reference_Type;
87 pragma Inline (Constant_Reference);
88
89 function Reference
90 (Container : aliased in out Holder) return Reference_Type;
91 pragma Inline (Reference);
92
93 procedure Assign (Target : in out Holder; Source : Holder);
94
95 function Copy (Source : Holder) return Holder;
96
97 procedure Move (Target : in out Holder; Source : in out Holder);
98
99 private
100
101 use Ada.Finalization;
102 use Ada.Streams;
103
104 type Element_Access is access all Element_Type;
105 type Holder_Access is access all Holder;
106
107 type Shared_Holder is record
108 Counter : System.Atomic_Counters.Atomic_Counter;
109 Element : Element_Access;
110 end record;
111
112 type Shared_Holder_Access is access all Shared_Holder;
113
114 procedure Reference (Item : not null Shared_Holder_Access);
115 -- Increment reference counter
116
117 procedure Unreference (Item : not null Shared_Holder_Access);
118 -- Decrement reference counter, deallocate Item when counter goes to zero
119
120 procedure Read
121 (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
122 Container : out Holder);
123
124 procedure Write
125 (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
126 Container : Holder);
127
128 type Holder is new Ada.Finalization.Controlled with record
129 Reference : Shared_Holder_Access;
130 Busy : Natural := 0;
131 end record;
132 for Holder'Read use Read;
133 for Holder'Write use Write;
134
135 overriding procedure Adjust (Container : in out Holder);
136 overriding procedure Finalize (Container : in out Holder);
137
138 type Reference_Control_Type is new Controlled with record
139 Container : Holder_Access;
140 end record;
141
142 overriding procedure Adjust (Control : in out Reference_Control_Type);
143 pragma Inline (Adjust);
144
145 overriding procedure Finalize (Control : in out Reference_Control_Type);
146 pragma Inline (Finalize);
147
148 type Constant_Reference_Type
149 (Element : not null access constant Element_Type) is
150 record
151 Control : Reference_Control_Type :=
152 raise Program_Error with "uninitialized reference";
153 -- The RM says, "The default initialization of an object of
154 -- type Constant_Reference_Type or Reference_Type propagates
155 -- Program_Error."
156 end record;
157
158 procedure Write
159 (Stream : not null access Root_Stream_Type'Class;
160 Item : Constant_Reference_Type);
161
162 for Constant_Reference_Type'Write use Write;
163
164 procedure Read
165 (Stream : not null access Root_Stream_Type'Class;
166 Item : out Constant_Reference_Type);
167
168 for Constant_Reference_Type'Read use Read;
169
170 type Reference_Type (Element : not null access Element_Type) is record
171 Control : Reference_Control_Type :=
172 raise Program_Error with "uninitialized reference";
173 -- The RM says, "The default initialization of an object of
174 -- type Constant_Reference_Type or Reference_Type propagates
175 -- Program_Error."
176 end record;
177
178 procedure Write
179 (Stream : not null access Root_Stream_Type'Class;
180 Item : Reference_Type);
181
182 for Reference_Type'Write use Write;
183
184 procedure Read
185 (Stream : not null access Root_Stream_Type'Class;
186 Item : out Reference_Type);
187
188 for Reference_Type'Read use Read;
189
190 Empty_Holder : constant Holder := (Controlled with null, 0);
191
192 end Ada.Containers.Indefinite_Holders;