gcc/ada/a-stzunb-shared.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --      A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D       --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Strings.Wide_Wide_Search;
  33 with Ada.Unchecked_Deallocation;
  34
  35 package body Ada.Strings.Wide_Wide_Unbounded is
  36
  37    use Ada.Strings.Wide_Wide_Maps;
  38
  39    Growth_Factor : constant := 32;
  40    --  The growth factor controls how much extra space is allocated when
  41    --  we have to increase the size of an allocated unbounded string. By
  42    --  allocating extra space, we avoid the need to reallocate on every
  43    --  append, particularly important when a string is built up by repeated
  44    --  append operations of small pieces. This is expressed as a factor so
  45    --  32 means add 1/32 of the length of the string as growth space.
  46
  47    Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
  48    --  Allocation will be done by a multiple of Min_Mul_Alloc. This causes
  49    --  no memory loss as most (all?) malloc implementations are obliged to
  50    --  align the returned memory on the maximum alignment as malloc does not
  51    --  know the target alignment.
  52
  53    procedure Sync_Add_And_Fetch
  54      (Ptr   : access Interfaces.Unsigned_32;
  55       Value : Interfaces.Unsigned_32);
  56    pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
  57
  58    function Sync_Sub_And_Fetch
  59      (Ptr   : access Interfaces.Unsigned_32;
  60       Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
  61    pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
  62
  63    function Aligned_Max_Length (Max_Length : Natural) return Natural;
  64    --  Returns recommended length of the shared string which is greater or
  65    --  equal to specified length. Calculation take in sense alignment of
  66    --  the allocated memory segments to use memory effectively by
  67    --  Append/Insert/etc operations.
  68
  69    ---------
  70    -- "&" --
  71    ---------
  72
  73    function "&"
  74      (Left  : Unbounded_Wide_Wide_String;
  75       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
  76    is
  77       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
  78       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
  79       DL : constant Natural := LR.Last + RR.Last;
  80       DR : Shared_Wide_Wide_String_Access;
  81
  82    begin
  83       --  Result is an empty string, reuse shared empty string.
  84
  85       if DL = 0 then
  86          Reference (Empty_Shared_Wide_Wide_String'Access);
  87          DR := Empty_Shared_Wide_Wide_String'Access;
  88
  89       --  Left string is empty, return Rigth string.
  90
  91       elsif LR.Last = 0 then
  92          Reference (RR);
  93          DR := RR;
  94
  95       --  Right string is empty, return Left string.
  96
  97       elsif RR.Last = 0 then
  98          Reference (LR);
  99          DR := LR;
 100
 101       --  Overwise, allocate new shared string and fill data.
 102
 103       else
 104          DR := Allocate (LR.Last + RR.Last);
 105          DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
 106          DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
 107          DR.Last := DL;
 108       end if;
 109
 110       return (AF.Controlled with Reference => DR);
 111    end "&";
 112
 113    function "&"
 114      (Left  : Unbounded_Wide_Wide_String;
 115       Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
 116    is
 117       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 118       DL : constant Natural := LR.Last + Right'Length;
 119       DR : Shared_Wide_Wide_String_Access;
 120
 121    begin
 122       --  Result is an empty string, reuse shared empty string.
 123
 124       if DL = 0 then
 125          Reference (Empty_Shared_Wide_Wide_String'Access);
 126          DR := Empty_Shared_Wide_Wide_String'Access;
 127
 128       --  Right is an empty string, return Left string.
 129
 130       elsif Right'Length = 0 then
 131          Reference (LR);
 132          DR := LR;
 133
 134       --  Otherwise, allocate new shared string and fill it.
 135
 136       else
 137          DR := Allocate (DL);
 138          DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
 139          DR.Data (LR.Last + 1 .. DL) := Right;
 140          DR.Last := DL;
 141       end if;
 142
 143       return (AF.Controlled with Reference => DR);
 144    end "&";
 145
 146    function "&"
 147      (Left  : Wide_Wide_String;
 148       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 149    is
 150       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 151       DL : constant Natural := Left'Length + RR.Last;
 152       DR : Shared_Wide_Wide_String_Access;
 153
 154    begin
 155       --  Result is an empty string, reuse shared one.
 156
 157       if DL = 0 then
 158          Reference (Empty_Shared_Wide_Wide_String'Access);
 159          DR := Empty_Shared_Wide_Wide_String'Access;
 160
 161       --  Left is empty string, return Right string.
 162
 163       elsif Left'Length = 0 then
 164          Reference (RR);
 165          DR := RR;
 166
 167       --  Otherwise, allocate new shared string and fill it.
 168
 169       else
 170          DR := Allocate (DL);
 171          DR.Data (1 .. Left'Length) := Left;
 172          DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
 173          DR.Last := DL;
 174       end if;
 175
 176       return (AF.Controlled with Reference => DR);
 177    end "&";
 178
 179    function "&"
 180      (Left  : Unbounded_Wide_Wide_String;
 181       Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
 182    is
 183       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 184       DL : constant Natural := LR.Last + 1;
 185       DR : Shared_Wide_Wide_String_Access;
 186
 187    begin
 188       DR := Allocate (DL);
 189       DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
 190       DR.Data (DL) := Right;
 191       DR.Last := DL;
 192
 193       return (AF.Controlled with Reference => DR);
 194    end "&";
 195
 196    function "&"
 197      (Left  : Wide_Wide_Character;
 198       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 199    is
 200       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 201       DL : constant Natural := 1 + RR.Last;
 202       DR : Shared_Wide_Wide_String_Access;
 203
 204    begin
 205       DR := Allocate (DL);
 206       DR.Data (1) := Left;
 207       DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
 208       DR.Last := DL;
 209
 210       return (AF.Controlled with Reference => DR);
 211    end "&";
 212
 213    ---------
 214    -- "*" --
 215    ---------
 216
 217    function "*"
 218      (Left  : Natural;
 219       Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
 220    is
 221       DR : Shared_Wide_Wide_String_Access;
 222
 223    begin
 224       --  Result is an empty string, reuse shared empty string.
 225
 226       if Left = 0 then
 227          Reference (Empty_Shared_Wide_Wide_String'Access);
 228          DR := Empty_Shared_Wide_Wide_String'Access;
 229
 230       --  Otherwise, allocate new shared string and fill it.
 231
 232       else
 233          DR := Allocate (Left);
 234
 235          for J in 1 .. Left loop
 236             DR.Data (J) := Right;
 237          end loop;
 238
 239          DR.Last := Left;
 240       end if;
 241
 242       return (AF.Controlled with Reference => DR);
 243    end "*";
 244
 245    function "*"
 246      (Left  : Natural;
 247       Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
 248    is
 249       DL : constant Natural := Left * Right'Length;
 250       DR : Shared_Wide_Wide_String_Access;
 251       K  : Positive;
 252
 253    begin
 254       --  Result is an empty string, reuse shared empty string.
 255
 256       if DL = 0 then
 257          Reference (Empty_Shared_Wide_Wide_String'Access);
 258          DR := Empty_Shared_Wide_Wide_String'Access;
 259
 260       --  Otherwise, allocate new shared string and fill it.
 261
 262       else
 263          DR := Allocate (DL);
 264          K := 1;
 265
 266          for J in 1 .. Left loop
 267             DR.Data (K .. K + Right'Length - 1) := Right;
 268             K := K + Right'Length;
 269          end loop;
 270
 271          DR.Last := DL;
 272       end if;
 273
 274       return (AF.Controlled with Reference => DR);
 275    end "*";
 276
 277    function "*"
 278      (Left  : Natural;
 279       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 280    is
 281       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 282       DL : constant Natural := Left * RR.Last;
 283       DR : Shared_Wide_Wide_String_Access;
 284       K  : Positive;
 285
 286    begin
 287       --  Result is an empty string, reuse shared empty string.
 288
 289       if DL = 0 then
 290          Reference (Empty_Shared_Wide_Wide_String'Access);
 291          DR := Empty_Shared_Wide_Wide_String'Access;
 292
 293       --  Coefficient is one, just return string itself.
 294
 295       elsif Left = 1 then
 296          Reference (RR);
 297          DR := RR;
 298
 299       --  Otherwise, allocate new shared string and fill it.
 300
 301       else
 302          DR := Allocate (DL);
 303          K := 1;
 304
 305          for J in 1 .. Left loop
 306             DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
 307             K := K + RR.Last;
 308          end loop;
 309
 310          DR.Last := DL;
 311       end if;
 312
 313       return (AF.Controlled with Reference => DR);
 314    end "*";
 315
 316    ---------
 317    -- "<" --
 318    ---------
 319
 320    function "<"
 321      (Left  : Unbounded_Wide_Wide_String;
 322       Right : Unbounded_Wide_Wide_String) return Boolean
 323    is
 324       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 325       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 326    begin
 327       return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
 328    end "<";
 329
 330    function "<"
 331      (Left  : Unbounded_Wide_Wide_String;
 332       Right : Wide_Wide_String) return Boolean
 333    is
 334       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 335    begin
 336       return LR.Data (1 .. LR.Last) < Right;
 337    end "<";
 338
 339    function "<"
 340      (Left  : Wide_Wide_String;
 341       Right : Unbounded_Wide_Wide_String) return Boolean
 342    is
 343       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 344    begin
 345       return Left < RR.Data (1 .. RR.Last);
 346    end "<";
 347
 348    ----------
 349    -- "<=" --
 350    ----------
 351
 352    function "<="
 353      (Left  : Unbounded_Wide_Wide_String;
 354       Right : Unbounded_Wide_Wide_String) return Boolean
 355    is
 356       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 357       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 358
 359    begin
 360       --  LR = RR means two strings shares shared string, thus they are equal
 361
 362       return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
 363    end "<=";
 364
 365    function "<="
 366      (Left  : Unbounded_Wide_Wide_String;
 367       Right : Wide_Wide_String) return Boolean
 368    is
 369       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 370    begin
 371       return LR.Data (1 .. LR.Last) <= Right;
 372    end "<=";
 373
 374    function "<="
 375      (Left  : Wide_Wide_String;
 376       Right : Unbounded_Wide_Wide_String) return Boolean
 377    is
 378       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 379    begin
 380       return Left <= RR.Data (1 .. RR.Last);
 381    end "<=";
 382
 383    ---------
 384    -- "=" --
 385    ---------
 386
 387    function "="
 388      (Left  : Unbounded_Wide_Wide_String;
 389       Right : Unbounded_Wide_Wide_String) return Boolean
 390    is
 391       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 392       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 393
 394    begin
 395       return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
 396       --  LR = RR means two strings shares shared string, thus they are equal.
 397    end "=";
 398
 399    function "="
 400      (Left  : Unbounded_Wide_Wide_String;
 401       Right : Wide_Wide_String) return Boolean
 402    is
 403       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 404    begin
 405       return LR.Data (1 .. LR.Last) = Right;
 406    end "=";
 407
 408    function "="
 409      (Left  : Wide_Wide_String;
 410       Right : Unbounded_Wide_Wide_String) return Boolean
 411    is
 412       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 413    begin
 414       return Left = RR.Data (1 .. RR.Last);
 415    end "=";
 416
 417    ---------
 418    -- ">" --
 419    ---------
 420
 421    function ">"
 422      (Left  : Unbounded_Wide_Wide_String;
 423       Right : Unbounded_Wide_Wide_String) return Boolean
 424    is
 425       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 426       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 427    begin
 428       return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
 429    end ">";
 430
 431    function ">"
 432      (Left  : Unbounded_Wide_Wide_String;
 433       Right : Wide_Wide_String) return Boolean
 434    is
 435       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 436    begin
 437       return LR.Data (1 .. LR.Last) > Right;
 438    end ">";
 439
 440    function ">"
 441      (Left  : Wide_Wide_String;
 442       Right : Unbounded_Wide_Wide_String) return Boolean
 443    is
 444       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 445    begin
 446       return Left > RR.Data (1 .. RR.Last);
 447    end ">";
 448
 449    ----------
 450    -- ">=" --
 451    ----------
 452
 453    function ">="
 454      (Left  : Unbounded_Wide_Wide_String;
 455       Right : Unbounded_Wide_Wide_String) return Boolean
 456    is
 457       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 458       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 459
 460    begin
 461       --  LR = RR means two strings shares shared string, thus they are equal
 462
 463       return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
 464    end ">=";
 465
 466    function ">="
 467      (Left  : Unbounded_Wide_Wide_String;
 468       Right : Wide_Wide_String) return Boolean
 469    is
 470       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 471    begin
 472       return LR.Data (1 .. LR.Last) >= Right;
 473    end ">=";
 474
 475    function ">="
 476      (Left  : Wide_Wide_String;
 477       Right : Unbounded_Wide_Wide_String) return Boolean
 478    is
 479       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 480    begin
 481       return Left >= RR.Data (1 .. RR.Last);
 482    end ">=";
 483
 484    ------------
 485    -- Adjust --
 486    ------------
 487
 488    procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
 489    begin
 490       Reference (Object.Reference);
 491    end Adjust;
 492
 493    ------------------------
 494    -- Aligned_Max_Length --
 495    ------------------------
 496
 497    function Aligned_Max_Length (Max_Length : Natural) return Natural is
 498       Static_Size  : constant Natural :=
 499                        Empty_Shared_Wide_Wide_String'Size
 500                          / Standard'Storage_Unit;
 501       --  Total size of all static components
 502
 503       Element_Size : constant Natural :=
 504                        Wide_Wide_Character'Size / Standard'Storage_Unit;
 505
 506    begin
 507       return
 508         (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
 509           * Min_Mul_Alloc - Static_Size) / Element_Size;
 510    end Aligned_Max_Length;
 511
 512    --------------
 513    -- Allocate --
 514    --------------
 515
 516    function Allocate
 517      (Max_Length : Natural) return Shared_Wide_Wide_String_Access is
 518    begin
 519       --  Empty string requested, return shared empty string
 520
 521       if Max_Length = 0 then
 522          Reference (Empty_Shared_Wide_Wide_String'Access);
 523          return Empty_Shared_Wide_Wide_String'Access;
 524
 525       --  Otherwise, allocate requested space (and probably some more room)
 526
 527       else
 528          return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length));
 529       end if;
 530    end Allocate;
 531
 532    ------------
 533    -- Append --
 534    ------------
 535
 536    procedure Append
 537      (Source   : in out Unbounded_Wide_Wide_String;
 538       New_Item : Unbounded_Wide_Wide_String)
 539    is
 540       SR  : constant Shared_Wide_Wide_String_Access := Source.Reference;
 541       NR  : constant Shared_Wide_Wide_String_Access := New_Item.Reference;
 542       DL  : constant Natural              := SR.Last + NR.Last;
 543       DR  : Shared_Wide_Wide_String_Access;
 544
 545    begin
 546       --  Source is an empty string, reuse New_Item data
 547
 548       if SR.Last = 0 then
 549          Reference (NR);
 550          Source.Reference := NR;
 551          Unreference (SR);
 552
 553       --  New_Item is empty string, nothing to do
 554
 555       elsif NR.Last = 0 then
 556          null;
 557
 558       --  Try to reuse existent shared string
 559
 560       elsif Can_Be_Reused (SR, DL) then
 561          SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 562          SR.Last := DL;
 563
 564       --  Otherwise, allocate new one and fill it
 565
 566       else
 567          DR := Allocate (DL + DL / Growth_Factor);
 568          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 569          DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 570          DR.Last := DL;
 571          Source.Reference := DR;
 572          Unreference (SR);
 573       end if;
 574    end Append;
 575
 576    procedure Append
 577      (Source   : in out Unbounded_Wide_Wide_String;
 578       New_Item : Wide_Wide_String)
 579    is
 580       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 581       DL : constant Natural := SR.Last + New_Item'Length;
 582       DR : Shared_Wide_Wide_String_Access;
 583
 584    begin
 585       --  New_Item is an empty string, nothing to do
 586
 587       if New_Item'Length = 0 then
 588          null;
 589
 590       --  Try to reuse existing shared string
 591
 592       elsif Can_Be_Reused (SR, DL) then
 593          SR.Data (SR.Last + 1 .. DL) := New_Item;
 594          SR.Last := DL;
 595
 596       --  Otherwise, allocate new one and fill it
 597
 598       else
 599          DR := Allocate (DL + DL / Growth_Factor);
 600          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 601          DR.Data (SR.Last + 1 .. DL) := New_Item;
 602          DR.Last := DL;
 603          Source.Reference := DR;
 604          Unreference (SR);
 605       end if;
 606    end Append;
 607
 608    procedure Append
 609      (Source   : in out Unbounded_Wide_Wide_String;
 610       New_Item : Wide_Wide_Character)
 611    is
 612       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 613       DL : constant Natural := SR.Last + 1;
 614       DR : Shared_Wide_Wide_String_Access;
 615
 616    begin
 617       --  Try to reuse existing shared string
 618
 619       if Can_Be_Reused (SR, SR.Last + 1) then
 620          SR.Data (SR.Last + 1) := New_Item;
 621          SR.Last := SR.Last + 1;
 622
 623       --  Otherwise, allocate new one and fill it
 624
 625       else
 626          DR := Allocate (DL + DL / Growth_Factor);
 627          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 628          DR.Data (DL) := New_Item;
 629          DR.Last := DL;
 630          Source.Reference := DR;
 631          Unreference (SR);
 632       end if;
 633    end Append;
 634
 635    -------------------
 636    -- Can_Be_Reused --
 637    -------------------
 638
 639    function Can_Be_Reused
 640      (Item   : Shared_Wide_Wide_String_Access;
 641       Length : Natural) return Boolean
 642    is
 643       use Interfaces;
 644    begin
 645       return
 646         Item.Counter = 1
 647           and then Item.Max_Length >= Length
 648           and then Item.Max_Length <=
 649                      Aligned_Max_Length (Length + Length / Growth_Factor);
 650    end Can_Be_Reused;
 651
 652    -----------
 653    -- Count --
 654    -----------
 655
 656    function Count
 657      (Source  : Unbounded_Wide_Wide_String;
 658       Pattern : Wide_Wide_String;
 659       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 660                   Wide_Wide_Maps.Identity)
 661       return Natural
 662    is
 663       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 664    begin
 665       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 666    end Count;
 667
 668    function Count
 669      (Source  : Unbounded_Wide_Wide_String;
 670       Pattern : Wide_Wide_String;
 671       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 672       return Natural
 673    is
 674       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 675    begin
 676       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 677    end Count;
 678
 679    function Count
 680      (Source : Unbounded_Wide_Wide_String;
 681       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 682    is
 683       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 684    begin
 685       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
 686    end Count;
 687
 688    ------------
 689    -- Delete --
 690    ------------
 691
 692    function Delete
 693      (Source  : Unbounded_Wide_Wide_String;
 694       From    : Positive;
 695       Through : Natural) return Unbounded_Wide_Wide_String
 696    is
 697       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 698       DL : Natural;
 699       DR : Shared_Wide_Wide_String_Access;
 700
 701    begin
 702       --  Empty slice is deleted, use the same shared string
 703
 704       if From > Through then
 705          Reference (SR);
 706          DR := SR;
 707
 708       --  Index is out of range
 709
 710       elsif Through > SR.Last then
 711          raise Index_Error;
 712
 713       --  Compute size of the result
 714
 715       else
 716          DL := SR.Last - (Through - From + 1);
 717
 718          --  Result is an empty string, reuse shared empty string
 719
 720          if DL = 0 then
 721             Reference (Empty_Shared_Wide_Wide_String'Access);
 722             DR := Empty_Shared_Wide_Wide_String'Access;
 723
 724          --  Otherwise, allocate new shared string and fill it
 725
 726          else
 727             DR := Allocate (DL);
 728             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 729             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 730             DR.Last := DL;
 731          end if;
 732       end if;
 733
 734       return (AF.Controlled with Reference => DR);
 735    end Delete;
 736
 737    procedure Delete
 738      (Source  : in out Unbounded_Wide_Wide_String;
 739       From    : Positive;
 740       Through : Natural)
 741    is
 742       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 743       DL : Natural;
 744       DR : Shared_Wide_Wide_String_Access;
 745
 746    begin
 747       --  Nothing changed, return
 748
 749       if From > Through then
 750          null;
 751
 752       --  Through is outside of the range
 753
 754       elsif Through > SR.Last then
 755          raise Index_Error;
 756
 757       else
 758          DL := SR.Last - (Through - From + 1);
 759
 760          --  Result is empty, reuse shared empty string
 761
 762          if DL = 0 then
 763             Reference (Empty_Shared_Wide_Wide_String'Access);
 764             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
 765             Unreference (SR);
 766
 767          --  Try to reuse existent shared string
 768
 769          elsif Can_Be_Reused (SR, DL) then
 770             SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 771             SR.Last := DL;
 772
 773          --  Otherwise, allocate new shared string
 774
 775          else
 776             DR := Allocate (DL);
 777             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 778             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 779             DR.Last := DL;
 780             Source.Reference := DR;
 781             Unreference (SR);
 782          end if;
 783       end if;
 784    end Delete;
 785
 786    -------------
 787    -- Element --
 788    -------------
 789
 790    function Element
 791      (Source : Unbounded_Wide_Wide_String;
 792       Index  : Positive) return Wide_Wide_Character
 793    is
 794       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 795    begin
 796       if Index <= SR.Last then
 797          return SR.Data (Index);
 798       else
 799          raise Index_Error;
 800       end if;
 801    end Element;
 802
 803    --------------
 804    -- Finalize --
 805    --------------
 806
 807    procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
 808       SR : constant Shared_Wide_Wide_String_Access := Object.Reference;
 809
 810    begin
 811       if SR /= null then
 812
 813          --  The same controlled object can be finalized several times for
 814          --  some reason. As per 7.6.1(24) this should have no ill effect,
 815          --  so we need to add a guard for the case of finalizing the same
 816          --  object twice.
 817
 818          Object.Reference := null;
 819          Unreference (SR);
 820       end if;
 821    end Finalize;
 822
 823    ----------------
 824    -- Find_Token --
 825    ----------------
 826
 827    procedure Find_Token
 828      (Source : Unbounded_Wide_Wide_String;
 829       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 830       From   : Positive;
 831       Test   : Strings.Membership;
 832       First  : out Positive;
 833       Last   : out Natural)
 834    is
 835       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 836    begin
 837       Wide_Wide_Search.Find_Token
 838         (SR.Data (From .. SR.Last), Set, Test, First, Last);
 839    end Find_Token;
 840
 841    procedure Find_Token
 842      (Source : Unbounded_Wide_Wide_String;
 843       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 844       Test   : Strings.Membership;
 845       First  : out Positive;
 846       Last   : out Natural)
 847    is
 848       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 849    begin
 850       Wide_Wide_Search.Find_Token
 851         (SR.Data (1 .. SR.Last), Set, Test, First, Last);
 852    end Find_Token;
 853
 854    ----------
 855    -- Free --
 856    ----------
 857
 858    procedure Free (X : in out Wide_Wide_String_Access) is
 859       procedure Deallocate is
 860          new Ada.Unchecked_Deallocation
 861                (Wide_Wide_String, Wide_Wide_String_Access);
 862    begin
 863       Deallocate (X);
 864    end Free;
 865
 866    ----------
 867    -- Head --
 868    ----------
 869
 870    function Head
 871      (Source : Unbounded_Wide_Wide_String;
 872       Count  : Natural;
 873       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 874       return Unbounded_Wide_Wide_String
 875    is
 876       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 877       DR : Shared_Wide_Wide_String_Access;
 878
 879    begin
 880       --  Result is empty, reuse shared empty string
 881
 882       if Count = 0 then
 883          Reference (Empty_Shared_Wide_Wide_String'Access);
 884          DR := Empty_Shared_Wide_Wide_String'Access;
 885
 886       --  Length of the string is the same as requested, reuse source shared
 887       --  string.
 888
 889       elsif Count = SR.Last then
 890          Reference (SR);
 891          DR := SR;
 892
 893       --  Otherwise, allocate new shared string and fill it
 894
 895       else
 896          DR := Allocate (Count);
 897
 898          --  Length of the source string is more than requested, copy
 899          --  corresponding slice.
 900
 901          if Count < SR.Last then
 902             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 903
 904          --  Length of the source string is less then requested, copy all
 905          --  contents and fill others by Pad character.
 906
 907          else
 908             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 909
 910             for J in SR.Last + 1 .. Count loop
 911                DR.Data (J) := Pad;
 912             end loop;
 913          end if;
 914
 915          DR.Last := Count;
 916       end if;
 917
 918       return (AF.Controlled with Reference => DR);
 919    end Head;
 920
 921    procedure Head
 922      (Source : in out Unbounded_Wide_Wide_String;
 923       Count  : Natural;
 924       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 925    is
 926       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 927       DR : Shared_Wide_Wide_String_Access;
 928
 929    begin
 930       --  Result is empty, reuse empty shared string
 931
 932       if Count = 0 then
 933          Reference (Empty_Shared_Wide_Wide_String'Access);
 934          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
 935          Unreference (SR);
 936
 937       --  Result is same with source string, reuse source shared string
 938
 939       elsif Count = SR.Last then
 940          null;
 941
 942       --  Try to reuse existent shared string
 943
 944       elsif Can_Be_Reused (SR, Count) then
 945          if Count > SR.Last then
 946             for J in SR.Last + 1 .. Count loop
 947                SR.Data (J) := Pad;
 948             end loop;
 949          end if;
 950
 951          SR.Last := Count;
 952
 953       --  Otherwise, allocate new shared string and fill it
 954
 955       else
 956          DR := Allocate (Count);
 957
 958          --  Length of the source string is greater then requested, copy
 959          --  corresponding slice.
 960
 961          if Count < SR.Last then
 962             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 963
 964          --  Length of the source string is less the requested, copy all
 965          --  exists data and fill others by Pad character.
 966
 967          else
 968             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 969
 970             for J in SR.Last + 1 .. Count loop
 971                DR.Data (J) := Pad;
 972             end loop;
 973          end if;
 974
 975          DR.Last := Count;
 976          Source.Reference := DR;
 977          Unreference (SR);
 978       end if;
 979    end Head;
 980
 981    -----------
 982    -- Index --
 983    -----------
 984
 985    function Index
 986      (Source  : Unbounded_Wide_Wide_String;
 987       Pattern : Wide_Wide_String;
 988       Going   : Strings.Direction := Strings.Forward;
 989       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 990                   Wide_Wide_Maps.Identity)
 991       return Natural
 992    is
 993       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 994    begin
 995       return Wide_Wide_Search.Index
 996         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 997    end Index;
 998
 999    function Index
1000      (Source  : Unbounded_Wide_Wide_String;
1001       Pattern : Wide_Wide_String;
1002       Going   : Direction := Forward;
1003       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1004       return Natural
1005    is
1006       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1007    begin
1008       return Wide_Wide_Search.Index
1009         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
1010    end Index;
1011
1012    function Index
1013      (Source : Unbounded_Wide_Wide_String;
1014       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
1015       Test   : Strings.Membership := Strings.Inside;
1016       Going  : Strings.Direction  := Strings.Forward) return Natural
1017    is
1018       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1019    begin
1020       return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
1021    end Index;
1022
1023    function Index
1024      (Source  : Unbounded_Wide_Wide_String;
1025       Pattern : Wide_Wide_String;
1026       From    : Positive;
1027       Going   : Direction := Forward;
1028       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
1029                   Wide_Wide_Maps.Identity)
1030       return Natural
1031    is
1032       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1033    begin
1034       return Wide_Wide_Search.Index
1035         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1036    end Index;
1037
1038    function Index
1039      (Source  : Unbounded_Wide_Wide_String;
1040       Pattern : Wide_Wide_String;
1041       From    : Positive;
1042       Going   : Direction := Forward;
1043       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1044       return Natural
1045    is
1046       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1047    begin
1048       return Wide_Wide_Search.Index
1049         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1050    end Index;
1051
1052    function Index
1053      (Source  : Unbounded_Wide_Wide_String;
1054       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
1055       From    : Positive;
1056       Test    : Membership := Inside;
1057       Going   : Direction := Forward) return Natural
1058    is
1059       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1060    begin
1061       return Wide_Wide_Search.Index
1062         (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1063    end Index;
1064
1065    ---------------------
1066    -- Index_Non_Blank --
1067    ---------------------
1068
1069    function Index_Non_Blank
1070      (Source : Unbounded_Wide_Wide_String;
1071       Going  : Strings.Direction := Strings.Forward) return Natural
1072    is
1073       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1074    begin
1075       return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1076    end Index_Non_Blank;
1077
1078    function Index_Non_Blank
1079      (Source : Unbounded_Wide_Wide_String;
1080       From   : Positive;
1081       Going  : Direction := Forward) return Natural
1082    is
1083       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1084    begin
1085       return Wide_Wide_Search.Index_Non_Blank
1086         (SR.Data (1 .. SR.Last), From, Going);
1087    end Index_Non_Blank;
1088
1089    ----------------
1090    -- Initialize --
1091    ----------------
1092
1093    procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
1094    begin
1095       Reference (Object.Reference);
1096    end Initialize;
1097
1098    ------------
1099    -- Insert --
1100    ------------
1101
1102    function Insert
1103      (Source   : Unbounded_Wide_Wide_String;
1104       Before   : Positive;
1105       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
1106    is
1107       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1108       DL : constant Natural := SR.Last + New_Item'Length;
1109       DR : Shared_Wide_Wide_String_Access;
1110
1111    begin
1112       --  Check index first
1113
1114       if Before > SR.Last + 1 then
1115          raise Index_Error;
1116       end if;
1117
1118       --  Result is empty, reuse empty shared string
1119
1120       if DL = 0 then
1121          Reference (Empty_Shared_Wide_Wide_String'Access);
1122          DR := Empty_Shared_Wide_Wide_String'Access;
1123
1124       --  Inserted string is empty, reuse source shared string
1125
1126       elsif New_Item'Length = 0 then
1127          Reference (SR);
1128          DR := SR;
1129
1130       --  Otherwise, allocate new shared string and fill it
1131
1132       else
1133          DR := Allocate (DL + DL / Growth_Factor);
1134          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1135          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1136          DR.Data (Before + New_Item'Length .. DL) :=
1137            SR.Data (Before .. SR.Last);
1138          DR.Last := DL;
1139       end if;
1140
1141       return (AF.Controlled with Reference => DR);
1142    end Insert;
1143
1144    procedure Insert
1145      (Source   : in out Unbounded_Wide_Wide_String;
1146       Before   : Positive;
1147       New_Item : Wide_Wide_String)
1148    is
1149       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1150       DL : constant Natural := SR.Last + New_Item'Length;
1151       DR : Shared_Wide_Wide_String_Access;
1152
1153    begin
1154       --  Check bounds
1155
1156       if Before > SR.Last + 1 then
1157          raise Index_Error;
1158       end if;
1159
1160       --  Result is empty string, reuse empty shared string
1161
1162       if DL = 0 then
1163          Reference (Empty_Shared_Wide_Wide_String'Access);
1164          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1165          Unreference (SR);
1166
1167       --  Inserted string is empty, nothing to do
1168
1169       elsif New_Item'Length = 0 then
1170          null;
1171
1172       --  Try to reuse existent shared string first
1173
1174       elsif Can_Be_Reused (SR, DL) then
1175          SR.Data (Before + New_Item'Length .. DL) :=
1176            SR.Data (Before .. SR.Last);
1177          SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1178          SR.Last := DL;
1179
1180       --  Otherwise, allocate new shared string and fill it
1181
1182       else
1183          DR := Allocate (DL + DL / Growth_Factor);
1184          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1185          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1186          DR.Data (Before + New_Item'Length .. DL) :=
1187            SR.Data (Before .. SR.Last);
1188          DR.Last := DL;
1189          Source.Reference := DR;
1190          Unreference (SR);
1191       end if;
1192    end Insert;
1193
1194    ------------
1195    -- Length --
1196    ------------
1197
1198    function Length (Source : Unbounded_Wide_Wide_String) return Natural is
1199    begin
1200       return Source.Reference.Last;
1201    end Length;
1202
1203    ---------------
1204    -- Overwrite --
1205    ---------------
1206
1207    function Overwrite
1208      (Source   : Unbounded_Wide_Wide_String;
1209       Position : Positive;
1210       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
1211    is
1212       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1213       DL : Natural;
1214       DR : Shared_Wide_Wide_String_Access;
1215
1216    begin
1217       --  Check bounds
1218
1219       if Position > SR.Last + 1 then
1220          raise Index_Error;
1221       end if;
1222
1223       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1224
1225       --  Result is empty string, reuse empty shared string
1226
1227       if DL = 0 then
1228          Reference (Empty_Shared_Wide_Wide_String'Access);
1229          DR := Empty_Shared_Wide_Wide_String'Access;
1230
1231       --  Result is same with source string, reuse source shared string
1232
1233       elsif New_Item'Length = 0 then
1234          Reference (SR);
1235          DR := SR;
1236
1237       --  Otherwise, allocate new shared string and fill it
1238
1239       else
1240          DR := Allocate (DL);
1241          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1242          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1243          DR.Data (Position + New_Item'Length .. DL) :=
1244            SR.Data (Position + New_Item'Length .. SR.Last);
1245          DR.Last := DL;
1246       end if;
1247
1248       return (AF.Controlled with Reference => DR);
1249    end Overwrite;
1250
1251    procedure Overwrite
1252      (Source    : in out Unbounded_Wide_Wide_String;
1253       Position  : Positive;
1254       New_Item  : Wide_Wide_String)
1255    is
1256       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1257       DL : Natural;
1258       DR : Shared_Wide_Wide_String_Access;
1259
1260    begin
1261       --  Bounds check
1262
1263       if Position > SR.Last + 1 then
1264          raise Index_Error;
1265       end if;
1266
1267       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1268
1269       --  Result is empty string, reuse empty shared string
1270
1271       if DL = 0 then
1272          Reference (Empty_Shared_Wide_Wide_String'Access);
1273          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1274          Unreference (SR);
1275
1276       --  String unchanged, nothing to do
1277
1278       elsif New_Item'Length = 0 then
1279          null;
1280
1281       --  Try to reuse existent shared string
1282
1283       elsif Can_Be_Reused (SR, DL) then
1284          SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1285          SR.Last := DL;
1286
1287       --  Otherwise allocate new shared string and fill it
1288
1289       else
1290          DR := Allocate (DL);
1291          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1292          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1293          DR.Data (Position + New_Item'Length .. DL) :=
1294            SR.Data (Position + New_Item'Length .. SR.Last);
1295          DR.Last := DL;
1296          Source.Reference := DR;
1297          Unreference (SR);
1298       end if;
1299    end Overwrite;
1300
1301    ---------------
1302    -- Reference --
1303    ---------------
1304
1305    procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
1306    begin
1307       Sync_Add_And_Fetch (Item.Counter'Access, 1);
1308    end Reference;
1309
1310    ---------------------
1311    -- Replace_Element --
1312    ---------------------
1313
1314    procedure Replace_Element
1315      (Source : in out Unbounded_Wide_Wide_String;
1316       Index  : Positive;
1317       By     : Wide_Wide_Character)
1318    is
1319       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1320       DR : Shared_Wide_Wide_String_Access;
1321
1322    begin
1323       --  Bounds check.
1324
1325       if Index <= SR.Last then
1326
1327          --  Try to reuse existent shared string
1328
1329          if Can_Be_Reused (SR, SR.Last) then
1330             SR.Data (Index) := By;
1331
1332          --  Otherwise allocate new shared string and fill it
1333
1334          else
1335             DR := Allocate (SR.Last);
1336             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1337             DR.Data (Index) := By;
1338             DR.Last := SR.Last;
1339             Source.Reference := DR;
1340             Unreference (SR);
1341          end if;
1342
1343       else
1344          raise Index_Error;
1345       end if;
1346    end Replace_Element;
1347
1348    -------------------
1349    -- Replace_Slice --
1350    -------------------
1351
1352    function Replace_Slice
1353      (Source : Unbounded_Wide_Wide_String;
1354       Low    : Positive;
1355       High   : Natural;
1356       By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
1357    is
1358       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1359       DL : Natural;
1360       DR : Shared_Wide_Wide_String_Access;
1361
1362    begin
1363       --  Check bounds
1364
1365       if Low > SR.Last + 1 then
1366          raise Index_Error;
1367       end if;
1368
1369       --  Do replace operation when removed slice is not empty
1370
1371       if High >= Low then
1372          DL := By'Length + SR.Last + Low - High - 1;
1373
1374          --  Result is empty string, reuse empty shared string
1375
1376          if DL = 0 then
1377             Reference (Empty_Shared_Wide_Wide_String'Access);
1378             DR := Empty_Shared_Wide_Wide_String'Access;
1379
1380          --  Otherwise allocate new shared string and fill it
1381
1382          else
1383             DR := Allocate (DL);
1384             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1385             DR.Data (Low .. Low + By'Length - 1) := By;
1386             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1387             DR.Last := DL;
1388          end if;
1389
1390          return (AF.Controlled with Reference => DR);
1391
1392       --  Otherwise just insert string
1393
1394       else
1395          return Insert (Source, Low, By);
1396       end if;
1397    end Replace_Slice;
1398
1399    procedure Replace_Slice
1400      (Source : in out Unbounded_Wide_Wide_String;
1401       Low    : Positive;
1402       High   : Natural;
1403       By     : Wide_Wide_String)
1404    is
1405       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1406       DL : Natural;
1407       DR : Shared_Wide_Wide_String_Access;
1408
1409    begin
1410       --  Bounds check
1411
1412       if Low > SR.Last + 1 then
1413          raise Index_Error;
1414       end if;
1415
1416       --  Do replace operation only when replaced slice is not empty
1417
1418       if High >= Low then
1419          DL := By'Length + SR.Last + Low - High - 1;
1420
1421          --  Result is empty string, reuse empty shared string
1422
1423          if DL = 0 then
1424             Reference (Empty_Shared_Wide_Wide_String'Access);
1425             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1426             Unreference (SR);
1427
1428          --  Try to reuse existent shared string
1429
1430          elsif Can_Be_Reused (SR, DL) then
1431             SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1432             SR.Data (Low .. Low + By'Length - 1) := By;
1433             SR.Last := DL;
1434
1435          --  Otherwise allocate new shared string and fill it
1436
1437          else
1438             DR := Allocate (DL);
1439             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1440             DR.Data (Low .. Low + By'Length - 1) := By;
1441             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1442             DR.Last := DL;
1443             Source.Reference := DR;
1444             Unreference (SR);
1445          end if;
1446
1447       --  Otherwise just insert item
1448
1449       else
1450          Insert (Source, Low, By);
1451       end if;
1452    end Replace_Slice;
1453
1454    -------------------------------
1455    -- Set_Unbounded_Wide_Wide_String --
1456    -------------------------------
1457
1458    procedure Set_Unbounded_Wide_Wide_String
1459      (Target : out Unbounded_Wide_Wide_String;
1460       Source : Wide_Wide_String)
1461    is
1462       TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
1463       DR : Shared_Wide_Wide_String_Access;
1464
1465    begin
1466       --  In case of empty string, reuse empty shared string
1467
1468       if Source'Length = 0 then
1469          Reference (Empty_Shared_Wide_Wide_String'Access);
1470          Target.Reference := Empty_Shared_Wide_Wide_String'Access;
1471
1472       else
1473          --  Try to reuse existent shared string
1474
1475          if Can_Be_Reused (TR, Source'Length) then
1476             Reference (TR);
1477             DR := TR;
1478
1479          --  Otherwise allocate new shared string
1480
1481          else
1482             DR := Allocate (Source'Length);
1483             Target.Reference := DR;
1484          end if;
1485
1486          DR.Data (1 .. Source'Length) := Source;
1487          DR.Last := Source'Length;
1488       end if;
1489
1490       Unreference (TR);
1491    end Set_Unbounded_Wide_Wide_String;
1492
1493    -----------
1494    -- Slice --
1495    -----------
1496
1497    function Slice
1498      (Source : Unbounded_Wide_Wide_String;
1499       Low    : Positive;
1500       High   : Natural) return Wide_Wide_String
1501    is
1502       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1503
1504    begin
1505       --  Note: test of High > Length is in accordance with AI95-00128
1506
1507       if Low > SR.Last + 1 or else High > SR.Last then
1508          raise Index_Error;
1509
1510       else
1511          return SR.Data (Low .. High);
1512       end if;
1513    end Slice;
1514
1515    ----------
1516    -- Tail --
1517    ----------
1518
1519    function Tail
1520      (Source : Unbounded_Wide_Wide_String;
1521       Count  : Natural;
1522       Pad    : Wide_Wide_Character := Wide_Wide_Space)
1523       return Unbounded_Wide_Wide_String
1524    is
1525       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1526       DR : Shared_Wide_Wide_String_Access;
1527
1528    begin
1529       --  For empty result reuse empty shared string
1530
1531       if Count = 0 then
1532          Reference (Empty_Shared_Wide_Wide_String'Access);
1533          DR := Empty_Shared_Wide_Wide_String'Access;
1534
1535       --  Result is hole source string, reuse source shared string
1536
1537       elsif Count = SR.Last then
1538          Reference (SR);
1539          DR := SR;
1540
1541       --  Otherwise allocate new shared string and fill it
1542
1543       else
1544          DR := Allocate (Count);
1545
1546          if Count < SR.Last then
1547             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1548
1549          else
1550             for J in 1 .. Count - SR.Last loop
1551                DR.Data (J) := Pad;
1552             end loop;
1553
1554             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1555          end if;
1556
1557          DR.Last := Count;
1558       end if;
1559
1560       return (AF.Controlled with Reference => DR);
1561    end Tail;
1562
1563    procedure Tail
1564      (Source : in out Unbounded_Wide_Wide_String;
1565       Count  : Natural;
1566       Pad    : Wide_Wide_Character := Wide_Wide_Space)
1567    is
1568       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1569       DR : Shared_Wide_Wide_String_Access;
1570
1571       procedure Common
1572         (SR    : Shared_Wide_Wide_String_Access;
1573          DR    : Shared_Wide_Wide_String_Access;
1574          Count : Natural);
1575       --  Common code of tail computation. SR/DR can point to the same object
1576
1577       ------------
1578       -- Common --
1579       ------------
1580
1581       procedure Common
1582         (SR    : Shared_Wide_Wide_String_Access;
1583          DR    : Shared_Wide_Wide_String_Access;
1584          Count : Natural) is
1585       begin
1586          if Count < SR.Last then
1587             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1588
1589          else
1590             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1591
1592             for J in 1 .. Count - SR.Last loop
1593                DR.Data (J) := Pad;
1594             end loop;
1595          end if;
1596
1597          DR.Last := Count;
1598       end Common;
1599
1600    begin
1601       --  Result is empty string, reuse empty shared string
1602
1603       if Count = 0 then
1604          Reference (Empty_Shared_Wide_Wide_String'Access);
1605          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1606          Unreference (SR);
1607
1608       --  Length of the result is the same with length of the source string,
1609       --  reuse source shared string.
1610
1611       elsif Count = SR.Last then
1612          null;
1613
1614       --  Try to reuse existent shared string
1615
1616       elsif Can_Be_Reused (SR, Count) then
1617          Common (SR, SR, Count);
1618
1619       --  Otherwise allocate new shared string and fill it
1620
1621       else
1622          DR := Allocate (Count);
1623          Common (SR, DR, Count);
1624          Source.Reference := DR;
1625          Unreference (SR);
1626       end if;
1627    end Tail;
1628
1629    --------------------
1630    -- To_Wide_Wide_String --
1631    --------------------
1632
1633    function To_Wide_Wide_String
1634      (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is
1635    begin
1636       return Source.Reference.Data (1 .. Source.Reference.Last);
1637    end To_Wide_Wide_String;
1638
1639    ------------------------------
1640    -- To_Unbounded_Wide_Wide_String --
1641    ------------------------------
1642
1643    function To_Unbounded_Wide_Wide_String
1644      (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
1645    is
1646       DR : constant Shared_Wide_Wide_String_Access := Allocate (Source'Length);
1647    begin
1648       DR.Data (1 .. Source'Length) := Source;
1649       DR.Last := Source'Length;
1650       return (AF.Controlled with Reference => DR);
1651    end To_Unbounded_Wide_Wide_String;
1652
1653    function To_Unbounded_Wide_Wide_String
1654      (Length : Natural) return Unbounded_Wide_Wide_String
1655    is
1656       DR : constant Shared_Wide_Wide_String_Access := Allocate (Length);
1657    begin
1658       DR.Last := Length;
1659       return (AF.Controlled with Reference => DR);
1660    end To_Unbounded_Wide_Wide_String;
1661
1662    ---------------
1663    -- Translate --
1664    ---------------
1665
1666    function Translate
1667      (Source  : Unbounded_Wide_Wide_String;
1668       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1669       return Unbounded_Wide_Wide_String
1670    is
1671       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1672       DR : Shared_Wide_Wide_String_Access;
1673
1674    begin
1675       --  Nothing to translate, reuse empty shared string
1676
1677       if SR.Last = 0 then
1678          Reference (Empty_Shared_Wide_Wide_String'Access);
1679          DR := Empty_Shared_Wide_Wide_String'Access;
1680
1681       --  Otherwise, allocate new shared string and fill it
1682
1683       else
1684          DR := Allocate (SR.Last);
1685
1686          for J in 1 .. SR.Last loop
1687             DR.Data (J) := Value (Mapping, SR.Data (J));
1688          end loop;
1689
1690          DR.Last := SR.Last;
1691       end if;
1692
1693       return (AF.Controlled with Reference => DR);
1694    end Translate;
1695
1696    procedure Translate
1697      (Source  : in out Unbounded_Wide_Wide_String;
1698       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1699    is
1700       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1701       DR : Shared_Wide_Wide_String_Access;
1702
1703    begin
1704       --  Nothing to translate
1705
1706       if SR.Last = 0 then
1707          null;
1708
1709       --  Try to reuse shared string
1710
1711       elsif Can_Be_Reused (SR, SR.Last) then
1712          for J in 1 .. SR.Last loop
1713             SR.Data (J) := Value (Mapping, SR.Data (J));
1714          end loop;
1715
1716       --  Otherwise, allocate new shared string
1717
1718       else
1719          DR := Allocate (SR.Last);
1720
1721          for J in 1 .. SR.Last loop
1722             DR.Data (J) := Value (Mapping, SR.Data (J));
1723          end loop;
1724
1725          DR.Last := SR.Last;
1726          Source.Reference := DR;
1727          Unreference (SR);
1728       end if;
1729    end Translate;
1730
1731    function Translate
1732      (Source  : Unbounded_Wide_Wide_String;
1733       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1734       return Unbounded_Wide_Wide_String
1735    is
1736       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1737       DR : Shared_Wide_Wide_String_Access;
1738
1739    begin
1740       --  Nothing to translate, reuse empty shared string
1741
1742       if SR.Last = 0 then
1743          Reference (Empty_Shared_Wide_Wide_String'Access);
1744          DR := Empty_Shared_Wide_Wide_String'Access;
1745
1746       --  Otherwise, allocate new shared string and fill it
1747
1748       else
1749          DR := Allocate (SR.Last);
1750
1751          for J in 1 .. SR.Last loop
1752             DR.Data (J) := Mapping.all (SR.Data (J));
1753          end loop;
1754
1755          DR.Last := SR.Last;
1756       end if;
1757
1758       return (AF.Controlled with Reference => DR);
1759
1760    exception
1761       when others =>
1762          Unreference (DR);
1763
1764          raise;
1765    end Translate;
1766
1767    procedure Translate
1768      (Source  : in out Unbounded_Wide_Wide_String;
1769       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1770    is
1771       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1772       DR : Shared_Wide_Wide_String_Access;
1773
1774    begin
1775       --  Nothing to translate
1776
1777       if SR.Last = 0 then
1778          null;
1779
1780       --  Try to reuse shared string
1781
1782       elsif Can_Be_Reused (SR, SR.Last) then
1783          for J in 1 .. SR.Last loop
1784             SR.Data (J) := Mapping.all (SR.Data (J));
1785          end loop;
1786
1787       --  Otherwise allocate new shared string and fill it
1788
1789       else
1790          DR := Allocate (SR.Last);
1791
1792          for J in 1 .. SR.Last loop
1793             DR.Data (J) := Mapping.all (SR.Data (J));
1794          end loop;
1795
1796          DR.Last := SR.Last;
1797          Source.Reference := DR;
1798          Unreference (SR);
1799       end if;
1800
1801    exception
1802       when others =>
1803          if DR /= null then
1804             Unreference (DR);
1805          end if;
1806
1807          raise;
1808    end Translate;
1809
1810    ----------
1811    -- Trim --
1812    ----------
1813
1814    function Trim
1815      (Source : Unbounded_Wide_Wide_String;
1816       Side   : Trim_End) return Unbounded_Wide_Wide_String
1817    is
1818       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1819       DL   : Natural;
1820       DR   : Shared_Wide_Wide_String_Access;
1821       Low  : Natural;
1822       High : Natural;
1823
1824    begin
1825       Low := Index_Non_Blank (Source, Forward);
1826
1827       --  All blanks, reuse empty shared string
1828
1829       if Low = 0 then
1830          Reference (Empty_Shared_Wide_Wide_String'Access);
1831          DR := Empty_Shared_Wide_Wide_String'Access;
1832
1833       else
1834          case Side is
1835             when Left =>
1836                High := SR.Last;
1837                DL   := SR.Last - Low + 1;
1838
1839             when Right =>
1840                Low  := 1;
1841                High := Index_Non_Blank (Source, Backward);
1842                DL   := High;
1843
1844             when Both =>
1845                High := Index_Non_Blank (Source, Backward);
1846                DL   := High - Low + 1;
1847          end case;
1848
1849          --  Length of the result is the same as length of the source string,
1850          --  reuse source shared string.
1851
1852          if DL = SR.Last then
1853             Reference (SR);
1854             DR := SR;
1855
1856          --  Otherwise, allocate new shared string
1857
1858          else
1859             DR := Allocate (DL);
1860             DR.Data (1 .. DL) := SR.Data (Low .. High);
1861             DR.Last := DL;
1862          end if;
1863       end if;
1864
1865       return (AF.Controlled with Reference => DR);
1866    end Trim;
1867
1868    procedure Trim
1869      (Source : in out Unbounded_Wide_Wide_String;
1870       Side   : Trim_End)
1871    is
1872       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1873       DL   : Natural;
1874       DR   : Shared_Wide_Wide_String_Access;
1875       Low  : Natural;
1876       High : Natural;
1877
1878    begin
1879       Low := Index_Non_Blank (Source, Forward);
1880
1881       --  All blanks, reuse empty shared string
1882
1883       if Low = 0 then
1884          Reference (Empty_Shared_Wide_Wide_String'Access);
1885          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1886          Unreference (SR);
1887
1888       else
1889          case Side is
1890             when Left =>
1891                High := SR.Last;
1892                DL   := SR.Last - Low + 1;
1893
1894             when Right =>
1895                Low  := 1;
1896                High := Index_Non_Blank (Source, Backward);
1897                DL   := High;
1898
1899             when Both =>
1900                High := Index_Non_Blank (Source, Backward);
1901                DL   := High - Low + 1;
1902          end case;
1903
1904          --  Length of the result is the same as length of the source string,
1905          --  nothing to do.
1906
1907          if DL = SR.Last then
1908             null;
1909
1910          --  Try to reuse existent shared string
1911
1912          elsif Can_Be_Reused (SR, DL) then
1913             SR.Data (1 .. DL) := SR.Data (Low .. High);
1914             SR.Last := DL;
1915
1916          --  Otherwise, allocate new shared string
1917
1918          else
1919             DR := Allocate (DL);
1920             DR.Data (1 .. DL) := SR.Data (Low .. High);
1921             DR.Last := DL;
1922             Source.Reference := DR;
1923             Unreference (SR);
1924          end if;
1925       end if;
1926    end Trim;
1927
1928    function Trim
1929      (Source : Unbounded_Wide_Wide_String;
1930       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1931       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1932       return Unbounded_Wide_Wide_String
1933    is
1934       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1935       DL   : Natural;
1936       DR   : Shared_Wide_Wide_String_Access;
1937       Low  : Natural;
1938       High : Natural;
1939
1940    begin
1941       Low := Index (Source, Left, Outside, Forward);
1942
1943       --  Source includes only characters from Left set, reuse empty shared
1944       --  string.
1945
1946       if Low = 0 then
1947          Reference (Empty_Shared_Wide_Wide_String'Access);
1948          DR := Empty_Shared_Wide_Wide_String'Access;
1949
1950       else
1951          High := Index (Source, Right, Outside, Backward);
1952          DL   := Integer'Max (0, High - Low + 1);
1953
1954          --  Source includes only characters from Right set or result string
1955          --  is empty, reuse empty shared string.
1956
1957          if High = 0 or else DL = 0 then
1958             Reference (Empty_Shared_Wide_Wide_String'Access);
1959             DR := Empty_Shared_Wide_Wide_String'Access;
1960
1961          --  Otherwise, allocate new shared string and fill it
1962
1963          else
1964             DR := Allocate (DL);
1965             DR.Data (1 .. DL) := SR.Data (Low .. High);
1966             DR.Last := DL;
1967          end if;
1968       end if;
1969
1970       return (AF.Controlled with Reference => DR);
1971    end Trim;
1972
1973    procedure Trim
1974      (Source : in out Unbounded_Wide_Wide_String;
1975       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1976       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1977    is
1978       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1979       DL   : Natural;
1980       DR   : Shared_Wide_Wide_String_Access;
1981       Low  : Natural;
1982       High : Natural;
1983
1984    begin
1985       Low := Index (Source, Left, Outside, Forward);
1986
1987       --  Source includes only characters from Left set, reuse empty shared
1988       --  string.
1989
1990       if Low = 0 then
1991          Reference (Empty_Shared_Wide_Wide_String'Access);
1992          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1993          Unreference (SR);
1994
1995       else
1996          High := Index (Source, Right, Outside, Backward);
1997          DL   := Integer'Max (0, High - Low + 1);
1998
1999          --  Source includes only characters from Right set or result string
2000          --  is empty, reuse empty shared string.
2001
2002          if High = 0 or else DL = 0 then
2003             Reference (Empty_Shared_Wide_Wide_String'Access);
2004             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
2005             Unreference (SR);
2006
2007          --  Try to reuse existent shared string
2008
2009          elsif Can_Be_Reused (SR, DL) then
2010             SR.Data (1 .. DL) := SR.Data (Low .. High);
2011             SR.Last := DL;
2012
2013          --  Otherwise, allocate new shared string and fill it
2014
2015          else
2016             DR := Allocate (DL);
2017             DR.Data (1 .. DL) := SR.Data (Low .. High);
2018             DR.Last := DL;
2019             Source.Reference := DR;
2020             Unreference (SR);
2021          end if;
2022       end if;
2023    end Trim;
2024
2025    ---------------------
2026    -- Unbounded_Slice --
2027    ---------------------
2028
2029    function Unbounded_Slice
2030      (Source : Unbounded_Wide_Wide_String;
2031       Low    : Positive;
2032       High   : Natural) return Unbounded_Wide_Wide_String
2033    is
2034       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
2035       DL : Natural;
2036       DR : Shared_Wide_Wide_String_Access;
2037
2038    begin
2039       --  Check bounds
2040
2041       if Low > SR.Last + 1 or else High > SR.Last then
2042          raise Index_Error;
2043
2044       --  Result is empty slice, reuse empty shared string
2045
2046       elsif Low > High then
2047          Reference (Empty_Shared_Wide_Wide_String'Access);
2048          DR := Empty_Shared_Wide_Wide_String'Access;
2049
2050       --  Otherwise, allocate new shared string and fill it
2051
2052       else
2053          DL := High - Low + 1;
2054          DR := Allocate (DL);
2055          DR.Data (1 .. DL) := SR.Data (Low .. High);
2056          DR.Last := DL;
2057       end if;
2058
2059       return (AF.Controlled with Reference => DR);
2060    end Unbounded_Slice;
2061
2062    procedure Unbounded_Slice
2063      (Source : Unbounded_Wide_Wide_String;
2064       Target : out Unbounded_Wide_Wide_String;
2065       Low    : Positive;
2066       High   : Natural)
2067    is
2068       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
2069       TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
2070       DL : Natural;
2071       DR : Shared_Wide_Wide_String_Access;
2072
2073    begin
2074       --  Check bounds
2075
2076       if Low > SR.Last + 1 or else High > SR.Last then
2077          raise Index_Error;
2078
2079       --  Result is empty slice, reuse empty shared string
2080
2081       elsif Low > High then
2082          Reference (Empty_Shared_Wide_Wide_String'Access);
2083          Target.Reference := Empty_Shared_Wide_Wide_String'Access;
2084          Unreference (TR);
2085
2086       else
2087          DL := High - Low + 1;
2088
2089          --  Try to reuse existent shared string
2090
2091          if Can_Be_Reused (TR, DL) then
2092             TR.Data (1 .. DL) := SR.Data (Low .. High);
2093             TR.Last := DL;
2094
2095          --  Otherwise, allocate new shared string and fill it
2096
2097          else
2098             DR := Allocate (DL);
2099             DR.Data (1 .. DL) := SR.Data (Low .. High);
2100             DR.Last := DL;
2101             Target.Reference := DR;
2102             Unreference (TR);
2103          end if;
2104       end if;
2105    end Unbounded_Slice;
2106
2107    -----------------
2108    -- Unreference --
2109    -----------------
2110
2111    procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
2112       use Interfaces;
2113
2114       procedure Free is
2115         new Ada.Unchecked_Deallocation
2116               (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access);
2117
2118       Aux : Shared_Wide_Wide_String_Access := Item;
2119
2120    begin
2121       if Sync_Sub_And_Fetch (Aux.Counter'Access, 1) = 0 then
2122
2123          --  Reference counter of Empty_Shared_Wide_Wide_String must never
2124          --  reach zero.
2125
2126          pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access);
2127
2128          Free (Aux);
2129       end if;
2130    end Unreference;
2131
2132 end Ada.Strings.Wide_Wide_Unbounded;