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