1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--         Localization, Internationalization, Globalization for Ada        --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2010-2015, 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: 5087 $ $Date: 2015-01-10 13:39:54 +0300 (Sat, 10 Jan 2015) $
43------------------------------------------------------------------------------
44with Ada.Unchecked_Deallocation;
45
46package body Matreshka.Internals.Stream_Element_Vectors is
47
48   Growth_Factor : constant := 32;
49   --  The growth factor controls how much extra space is allocated when we
50   --  have to increase the size of an allocated vector. By allocating extra
51   --  space, we avoid the need to reallocate on every append, particularly
52   --  important when a vector is built up by repeated append operations of
53   --  small pieces. This is expressed as a factor so 32 means add 1/32 of the
54   --  length of the vector as growth space.
55
56   Min_Mul_Alloc : constant
57     := Standard'Maximum_Alignment * Standard'Storage_Unit
58          / Ada.Streams.Stream_Element'Size;
59   --  Allocation will be done by a multiple of Min_Mul_Alloc. This causes
60   --  no memory loss as most (all?) malloc implementations are obliged to
61   --  align the returned memory on the maximum alignment as malloc does not
62   --  know the target alignment.
63
64   procedure Free is
65     new Ada.Unchecked_Deallocation
66          (Shared_Stream_Element_Vector, Shared_Stream_Element_Vector_Access);
67
68   function Aligned_Size
69    (Size : Ada.Streams.Stream_Element_Offset)
70       return Ada.Streams.Stream_Element_Offset;
71   pragma Inline (Aligned_Size);
72   --  Returns recommended size of the shared vector which is greater or equal
73   --  to specified. Calculation take in sense alignment of the allocated
74   --  memory segments to use memory effectively by Append/Insert/etc
75   --  operations.
76
77   ------------------
78   -- Aligned_Size --
79   ------------------
80
81   function Aligned_Size
82    (Size : Ada.Streams.Stream_Element_Offset)
83       return Ada.Streams.Stream_Element_Offset
84   is
85      Static_Size  : constant Ada.Streams.Stream_Element_Offset
86        := (Empty_Shared_Stream_Element_Vector'Size
87              - Ada.Streams.Stream_Element'Size
88                  * (Empty_Shared_Stream_Element_Vector.Size + 1))
89              / Ada.Streams.Stream_Element'Size;
90      --  Total size of all static components in Code_Unit_16 units.
91
92      pragma Assert
93       ((Empty_Shared_Stream_Element_Vector'Size
94           - Ada.Streams.Stream_Element'Size
95               * (Empty_Shared_Stream_Element_Vector.Size + 1))
96          mod Ada.Streams.Stream_Element'Size = 0);
97      --  Reminder must be zero to compute value correctly.
98
99   begin
100      return
101       (((Static_Size + Size + Size / Growth_Factor)
102            / Min_Mul_Alloc + 1) * Min_Mul_Alloc - Static_Size);
103   end Aligned_Size;
104
105   --------------
106   -- Allocate --
107   --------------
108
109   function Allocate
110    (Size : Ada.Streams.Stream_Element_Offset)
111       return not null Shared_Stream_Element_Vector_Access is
112   begin
113      if Size = 0 then
114         return Empty_Shared_Stream_Element_Vector'Access;
115
116      else
117         return new Shared_Stream_Element_Vector (Aligned_Size (Size) - 1);
118      end if;
119   end Allocate;
120
121   -------------------
122   -- Can_Be_Reused --
123   -------------------
124
125   function Can_Be_Reused
126    (Self : not null Shared_Stream_Element_Vector_Access;
127     Size : Ada.Streams.Stream_Element_Offset) return Boolean is
128   begin
129      return
130        Self /= Empty_Shared_Stream_Element_Vector'Access
131          and Self.Size >= Size
132          and Matreshka.Atomics.Counters.Is_One (Self.Counter);
133   end Can_Be_Reused;
134
135   -----------------
136   -- Dereference --
137   -----------------
138
139   procedure Dereference (Item : in out Shared_Stream_Element_Vector_Access) is
140   begin
141      if Item /= Empty_Shared_Stream_Element_Vector'Access
142        and then Matreshka.Atomics.Counters.Decrement (Item.Counter)
143      then
144         Free (Item);
145
146      else
147         Item := null;
148      end if;
149   end Dereference;
150
151   ---------------
152   -- Fill_Tail --
153   ---------------
154
155   procedure Fill_Tail (Item : not null Shared_Stream_Element_Vector_Access) is
156      pragma Assert (Ada.Streams.Stream_Element'Size = 8);
157
158      Index : Ada.Streams.Stream_Element_Offset := Item.Length;
159
160   begin
161      while Index mod 4 /= 0 loop
162         Item.Value (Index) := 0;
163         Index := Index + 1;
164      end loop;
165   end Fill_Tail;
166
167   ----------
168   -- Hash --
169   ----------
170
171   function Hash
172    (Item : not null Shared_Stream_Element_Vector_Access) return League.Hash_Type
173   is
174      use type League.Hash_Type;
175
176      M      : constant League.Hash_Type := 16#5BD1E995#;
177      H      : League.Hash_Type := League.Hash_Type (Item.Length);
178      K      : League.Hash_Type;
179      Index  : Ada.Streams.Stream_Element_Offset := 0;
180      Length : Ada.Streams.Stream_Element_Offset := (Item.Length + 3) / 4;
181      Data   :
182        array (Ada.Streams.Stream_Element_Offset range 0 .. Length - 1)
183          of League.Hash_Type;
184      for Data'Address use Item.Value'Address;
185      pragma Import (Ada, Data);
186
187   begin
188      while Index < Length loop
189         K := League.Hash_Type (Data (Index)) * M;
190         K := K xor (K / 16#1000000#);
191         K := K * M;
192
193         H := H * M;
194         H := H xor K;
195         Index := Index + 1;
196      end loop;
197
198      H := H xor (H / 16#2000#);
199      H := H * M;
200      H := H xor (H / 16#8000#);
201
202      return H;
203   end Hash;
204
205   ---------------
206   -- Reference --
207   ---------------
208
209   procedure Reference (Item : Shared_Stream_Element_Vector_Access) is
210   begin
211      if Item /= Empty_Shared_Stream_Element_Vector'Access then
212         Matreshka.Atomics.Counters.Increment (Item.Counter);
213      end if;
214   end Reference;
215
216end Matreshka.Internals.Stream_Element_Vectors;
217