1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--         Localization, Internationalization, Globalization for Ada        --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2010-2012, Vadim Godunko <vgodunko@gmail.com>                --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 3090 $ $Date: 2012-08-19 13:43:26 +0400 (Sun, 19 Aug 2012) $
43------------------------------------------------------------------------------
44with Ada.Unchecked_Deallocation;
45
46package body Matreshka.Internals.String_Vectors is
47
48   pragma Assert
49    (Standard'Address_Size
50       = Matreshka.Internals.Strings.Shared_String_Access'Size);
51   --  Size of System.Address must be equal to size of Shared_String_Access to
52   --  compite constants correctly.
53
54   Growth_Factor : constant := 32;
55   --  The growth factor controls how much extra space is allocated when we
56   --  have to increase the size of an allocated shared vector. By allocating
57   --  extra space, we avoid the need to reallocate on every append,
58   --  particularly important when a string is built up by repeated append
59   --  operations of small pieces. This is expressed as a factor so 32 means
60   --  add 1/32 of the length of the string as growth space.
61
62   Min_Mul_Alloc : constant
63     := Standard'Maximum_Alignment * Standard'Storage_Unit
64          / Standard'Address_Size;
65   --  Allocation will be done by a multiple of Min_Mul_Alloc. This causes no
66   --  memory loss as most (all?) malloc implementations are obliged to align
67   --  the returned memory on the maximum alignment as malloc does not know the
68   --  target alignment.
69
70   function Aligned_Size
71    (Size : String_Vector_Index) return String_Vector_Index;
72   pragma Inline (Aligned_Size);
73   --  Returns recommended size of the shared vector which is greater or equal
74   --  to specified. Calculation take in sense alignment of the allocated
75   --  memory segments to use memory effectively by Append/Insert/etc
76   --  operations.
77
78   ------------------
79   -- Aligned_Size --
80   ------------------
81
82   function Aligned_Size
83    (Size : String_Vector_Index) return String_Vector_Index
84   is
85      use Matreshka.Internals.Strings;
86
87      Static_Size : constant String_Vector_Index
88        := (Empty_Shared_String_Vector'Size
89              - Shared_String_Access'Size
90                  * (Empty_Shared_String_Vector.Last + 1))
91             / Shared_String_Access'Size;
92      --  Total size of all static components in Shared_String_Access'Size
93      --  units.
94
95      pragma Assert
96       ((Empty_Shared_String_Vector'Size
97           - Shared_String_Access'Size * (Empty_Shared_String_Vector.Last + 1))
98          mod Shared_String_Access'Size = 0);
99      --  Reminder must be zero to compute value correctly.
100
101   begin
102      return
103        ((Static_Size + Size + Size / Growth_Factor) / Min_Mul_Alloc + 1)
104           * Min_Mul_Alloc - Static_Size;
105   end Aligned_Size;
106
107   procedure Unsafe_Dereference (Item : in out Shared_String_Vector_Access);
108   --  Dereference specified object and release memory when necessary, but
109   --  doesn't dereference contained shared strings.
110
111   procedure Free is
112     new Ada.Unchecked_Deallocation
113          (Shared_String_Vector, Shared_String_Vector_Access);
114   --  Deallocate shared string vector. Should not be used anywhere except
115   --  Dereference and Unsafe_Dereference subprograms.
116
117   --------------
118   -- Allocate --
119   --------------
120
121   function Allocate
122    (Size : String_Vector_Index) return not null Shared_String_Vector_Access
123   is
124      pragma Assert (Size /= 0);
125
126   begin
127      return new Shared_String_Vector (Aligned_Size (Size));
128   end Allocate;
129
130   ------------
131   -- Append --
132   ------------
133
134   procedure Append
135    (Item   : in out Shared_String_Vector_Access;
136     String : not null Matreshka.Internals.Strings.Shared_String_Access) is
137   begin
138      Detach (Item, Item.Unused + 1);
139      Item.Value (Item.Unused) := String;
140      Item.Unused := Item.Unused + 1;
141   end Append;
142
143   -----------------
144   -- Dereference --
145   -----------------
146
147   procedure Dereference (Item : in out Shared_String_Vector_Access) is
148   begin
149      if Item /= Empty_Shared_String_Vector'Access
150        and then Matreshka.Atomics.Counters.Decrement (Item.Counter)
151      then
152         for J in 0 .. Item.Unused - 1 loop
153            Matreshka.Internals.Strings.Dereference (Item.Value (J));
154         end loop;
155
156         Free (Item);
157
158      else
159         Item := null;
160      end if;
161   end Dereference;
162
163   ------------
164   -- Detach --
165   ------------
166
167   procedure Detach
168    (Item : in out Shared_String_Vector_Access;
169     Size : String_Vector_Index)
170   is
171      Source      : Shared_String_Vector_Access := Item;
172      Destination : Shared_String_Vector_Access renames Item;
173
174   begin
175      --  Size of the requested vector is zero, return empty shared string
176      --  vector.
177
178      if Size = 0 then
179         if Source /= Empty_Shared_String_Vector'Access then
180            Dereference (Source);
181            Destination := Empty_Shared_String_Vector'Access;
182         end if;
183
184      --  Source shared string vector is empty, allocate new one.
185
186      elsif Source = Empty_Shared_String_Vector'Access then
187         Destination := Allocate (Size);
188
189      --  Source shared string vector is not enought to store specified number
190      --  of items, or used somewhere; allocate new one and copy existing data.
191
192      elsif Destination.Last < Size
193        or else not Matreshka.Atomics.Counters.Is_One (Source.Counter)
194      then
195         Destination := Allocate (Size);
196
197         Destination.Value (0 .. Source.Unused - 1) :=
198           Source.Value (0 .. Source.Unused - 1);
199         Destination.Unused := Source.Unused;
200
201         if not Matreshka.Atomics.Counters.Is_One (Source.Counter) then
202            --  Increment reference counter for all copied shared strings.
203
204            for J in 0 .. Destination.Unused - 1 loop
205               Matreshka.Internals.Strings.Reference (Destination.Value (J));
206            end loop;
207
208            Dereference (Source);
209
210         else
211            --  There is only one reference to source object, change of
212            --  reference counter of shared strings can be avoided.
213
214            Unsafe_Dereference (Source);
215         end if;
216      end if;
217   end Detach;
218
219   ------------
220   -- Insert --
221   ------------
222
223   procedure Insert
224    (Self  : in out Shared_String_Vector_Access;
225     Index : String_Vector_Index;
226     Item  : not null Matreshka.Internals.Strings.Shared_String_Access) is
227   begin
228      --  Reference shared string object.
229
230      Matreshka.Internals.Strings.Reference (Item);
231
232      if Self = Empty_Shared_String_Vector'Access then
233         --  Vector is empty, create new one and initialize it.
234
235         Self := Allocate (1);
236         Self.Value (0) := Item;
237         Self.Unused := 1;
238
239      else
240         Detach (Self, Self.Unused);
241
242         Self.Value (Index + 1 .. Self.Unused) :=
243           Self.Value (Index .. Self.Unused - 1);
244         Self.Value (Index) := Item;
245         Self.Unused := Self.Unused + 1;
246      end if;
247   end Insert;
248
249   -------------
250   -- Prepend --
251   -------------
252
253   procedure Prepend
254    (Self   : in out Shared_String_Vector_Access;
255     Vector : not null Shared_String_Vector_Access)
256   is
257      New_Length : constant String_Vector_Index
258        := Self.Unused + Vector.Unused;
259
260   begin
261      if Vector = Empty_Shared_String_Vector'Access then
262         --  Empty vector is prepended, nothing to do.
263
264         null;
265
266      elsif Self = Empty_Shared_String_Vector'Access then
267         --  Self is empty vector, replace it by prepended vector.
268
269         Self := Vector;
270         Reference (Self);
271
272      else
273         --  Prepare object for modification.
274
275         Detach (Self, New_Length);
276
277         --  Construct new value.
278
279         Self.Value (Vector.Unused .. New_Length - 1) :=
280           Self.Value (0 .. Self.Unused - 1);
281         Self.Value (0 .. Vector.Unused - 1) :=
282           Vector.Value (0 .. Vector.Unused - 1);
283         Self.Unused := New_Length;
284
285         --  Update string's reference counters.
286
287         for J in 0 .. Vector.Unused - 1 loop
288            Matreshka.Internals.Strings.Reference (Self.Value (J));
289         end loop;
290      end if;
291   end Prepend;
292
293   ---------------
294   -- Reference --
295   ---------------
296
297   procedure Reference (Item : Shared_String_Vector_Access) is
298   begin
299      if Item /= Empty_Shared_String_Vector'Access then
300         Matreshka.Atomics.Counters.Increment (Item.Counter);
301      end if;
302   end Reference;
303
304   -------------
305   -- Replace --
306   -------------
307
308   procedure Replace
309    (Self  : in out Shared_String_Vector_Access;
310     Index : String_Vector_Index;
311     Item  : not null Matreshka.Internals.Strings.Shared_String_Access)
312   is
313      use type Matreshka.Internals.Strings.Shared_String_Access;
314
315   begin
316      Detach (Self, Self.Unused);
317
318      if Self.Value (Index) /= Item then
319         Matreshka.Internals.Strings.Dereference (Self.Value (Index));
320         Self.Value (Index) := Item;
321         Matreshka.Internals.Strings.Reference (Self.Value (Index));
322      end if;
323   end Replace;
324
325   ------------------------
326   -- Unsafe_Dereference --
327   ------------------------
328
329   procedure Unsafe_Dereference (Item : in out Shared_String_Vector_Access) is
330   begin
331      if Item /= Empty_Shared_String_Vector'Access
332        and then Matreshka.Atomics.Counters.Decrement (Item.Counter)
333      then
334         Free (Item);
335
336      else
337         Item := null;
338      end if;
339   end Unsafe_Dereference;
340
341end Matreshka.Internals.String_Vectors;
342