gcc/ada/a-stwiun-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 _ 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_Search;
  33 with Ada.Unchecked_Deallocation;
  34
  35 package body Ada.Strings.Wide_Unbounded is
  36
  37    use Ada.Strings.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_String;
  75       Right : Unbounded_Wide_String) return Unbounded_Wide_String
  76    is
  77       LR : constant Shared_Wide_String_Access := Left.Reference;
  78       RR : constant Shared_Wide_String_Access := Right.Reference;
  79       DL : constant Natural := LR.Last + RR.Last;
  80       DR : Shared_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_String'Access);
  87          DR := Empty_Shared_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_String;
 115       Right : Wide_String) return Unbounded_Wide_String
 116    is
 117       LR : constant Shared_Wide_String_Access := Left.Reference;
 118       DL : constant Natural := LR.Last + Right'Length;
 119       DR : Shared_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_String'Access);
 126          DR := Empty_Shared_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_String;
 148       Right : Unbounded_Wide_String) return Unbounded_Wide_String
 149    is
 150       RR : constant Shared_Wide_String_Access := Right.Reference;
 151       DL : constant Natural := Left'Length + RR.Last;
 152       DR : Shared_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_String'Access);
 159          DR := Empty_Shared_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_String;
 181       Right : Wide_Character) return Unbounded_Wide_String
 182    is
 183       LR : constant Shared_Wide_String_Access := Left.Reference;
 184       DL : constant Natural := LR.Last + 1;
 185       DR : Shared_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_Character;
 198       Right : Unbounded_Wide_String) return Unbounded_Wide_String
 199    is
 200       RR : constant Shared_Wide_String_Access := Right.Reference;
 201       DL : constant Natural := 1 + RR.Last;
 202       DR : Shared_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_Character) return Unbounded_Wide_String
 220    is
 221       DR : Shared_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_String'Access);
 228          DR := Empty_Shared_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_String) return Unbounded_Wide_String
 248    is
 249       DL : constant Natural := Left * Right'Length;
 250       DR : Shared_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_String'Access);
 258          DR := Empty_Shared_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_String) return Unbounded_Wide_String
 280    is
 281       RR : constant Shared_Wide_String_Access := Right.Reference;
 282       DL : constant Natural := Left * RR.Last;
 283       DR : Shared_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_String'Access);
 291          DR := Empty_Shared_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_String;
 322       Right : Unbounded_Wide_String) return Boolean
 323    is
 324       LR : constant Shared_Wide_String_Access := Left.Reference;
 325       RR : constant Shared_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_String;
 332       Right : Wide_String) return Boolean
 333    is
 334       LR : constant Shared_Wide_String_Access := Left.Reference;
 335    begin
 336       return LR.Data (1 .. LR.Last) < Right;
 337    end "<";
 338
 339    function "<"
 340      (Left  : Wide_String;
 341       Right : Unbounded_Wide_String) return Boolean
 342    is
 343       RR : constant Shared_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_String;
 354       Right : Unbounded_Wide_String) return Boolean
 355    is
 356       LR : constant Shared_Wide_String_Access := Left.Reference;
 357       RR : constant Shared_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_String;
 367       Right : Wide_String) return Boolean
 368    is
 369       LR : constant Shared_Wide_String_Access := Left.Reference;
 370    begin
 371       return LR.Data (1 .. LR.Last) <= Right;
 372    end "<=";
 373
 374    function "<="
 375      (Left  : Wide_String;
 376       Right : Unbounded_Wide_String) return Boolean
 377    is
 378       RR : constant Shared_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_String;
 389       Right : Unbounded_Wide_String) return Boolean
 390    is
 391       LR : constant Shared_Wide_String_Access := Left.Reference;
 392       RR : constant Shared_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_String;
 401       Right : Wide_String) return Boolean
 402    is
 403       LR : constant Shared_Wide_String_Access := Left.Reference;
 404    begin
 405       return LR.Data (1 .. LR.Last) = Right;
 406    end "=";
 407
 408    function "="
 409      (Left  : Wide_String;
 410       Right : Unbounded_Wide_String) return Boolean
 411    is
 412       RR : constant Shared_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_String;
 423       Right : Unbounded_Wide_String) return Boolean
 424    is
 425       LR : constant Shared_Wide_String_Access := Left.Reference;
 426       RR : constant Shared_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_String;
 433       Right : Wide_String) return Boolean
 434    is
 435       LR : constant Shared_Wide_String_Access := Left.Reference;
 436    begin
 437       return LR.Data (1 .. LR.Last) > Right;
 438    end ">";
 439
 440    function ">"
 441      (Left  : Wide_String;
 442       Right : Unbounded_Wide_String) return Boolean
 443    is
 444       RR : constant Shared_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_String;
 455       Right : Unbounded_Wide_String) return Boolean
 456    is
 457       LR : constant Shared_Wide_String_Access := Left.Reference;
 458       RR : constant Shared_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_String;
 468       Right : Wide_String) return Boolean
 469    is
 470       LR : constant Shared_Wide_String_Access := Left.Reference;
 471    begin
 472       return LR.Data (1 .. LR.Last) >= Right;
 473    end ">=";
 474
 475    function ">="
 476      (Left  : Wide_String;
 477       Right : Unbounded_Wide_String) return Boolean
 478    is
 479       RR : constant Shared_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_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_String'Size / Standard'Storage_Unit;
 500       --  Total size of all static components
 501
 502       Element_Size : constant Natural :=
 503                        Wide_Character'Size / Standard'Storage_Unit;
 504
 505    begin
 506       return
 507         (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
 508           * Min_Mul_Alloc - Static_Size) / Element_Size;
 509    end Aligned_Max_Length;
 510
 511    --------------
 512    -- Allocate --
 513    --------------
 514
 515    function Allocate (Max_Length : Natural) return Shared_Wide_String_Access is
 516    begin
 517       --  Empty string requested, return shared empty string
 518
 519       if Max_Length = 0 then
 520          Reference (Empty_Shared_Wide_String'Access);
 521          return Empty_Shared_Wide_String'Access;
 522
 523       --  Otherwise, allocate requested space (and probably some more room)
 524
 525       else
 526          return new Shared_Wide_String (Aligned_Max_Length (Max_Length));
 527       end if;
 528    end Allocate;
 529
 530    ------------
 531    -- Append --
 532    ------------
 533
 534    procedure Append
 535      (Source   : in out Unbounded_Wide_String;
 536       New_Item : Unbounded_Wide_String)
 537    is
 538       SR  : constant Shared_Wide_String_Access := Source.Reference;
 539       NR  : constant Shared_Wide_String_Access := New_Item.Reference;
 540       DL  : constant Natural                   := SR.Last + NR.Last;
 541       DR  : Shared_Wide_String_Access;
 542
 543    begin
 544       --  Source is an empty string, reuse New_Item data
 545
 546       if SR.Last = 0 then
 547          Reference (NR);
 548          Source.Reference := NR;
 549          Unreference (SR);
 550
 551       --  New_Item is empty string, nothing to do
 552
 553       elsif NR.Last = 0 then
 554          null;
 555
 556       --  Try to reuse existent shared string
 557
 558       elsif Can_Be_Reused (SR, DL) then
 559          SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 560          SR.Last := DL;
 561
 562       --  Otherwise, allocate new one and fill it
 563
 564       else
 565          DR := Allocate (DL + DL / Growth_Factor);
 566          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 567          DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 568          DR.Last := DL;
 569          Source.Reference := DR;
 570          Unreference (SR);
 571       end if;
 572    end Append;
 573
 574    procedure Append
 575      (Source   : in out Unbounded_Wide_String;
 576       New_Item : Wide_String)
 577    is
 578       SR : constant Shared_Wide_String_Access := Source.Reference;
 579       DL : constant Natural                   := SR.Last + New_Item'Length;
 580       DR : Shared_Wide_String_Access;
 581
 582    begin
 583       --  New_Item is an empty string, nothing to do
 584
 585       if New_Item'Length = 0 then
 586          null;
 587
 588       --  Try to reuse existing shared string
 589
 590       elsif Can_Be_Reused (SR, DL) then
 591          SR.Data (SR.Last + 1 .. DL) := New_Item;
 592          SR.Last := DL;
 593
 594       --  Otherwise, allocate new one and fill it
 595
 596       else
 597          DR := Allocate (DL + DL / Growth_Factor);
 598          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 599          DR.Data (SR.Last + 1 .. DL) := New_Item;
 600          DR.Last := DL;
 601          Source.Reference := DR;
 602          Unreference (SR);
 603       end if;
 604    end Append;
 605
 606    procedure Append
 607      (Source   : in out Unbounded_Wide_String;
 608       New_Item : Wide_Character)
 609    is
 610       SR : constant Shared_Wide_String_Access := Source.Reference;
 611       DL : constant Natural := SR.Last + 1;
 612       DR : Shared_Wide_String_Access;
 613
 614    begin
 615       --  Try to reuse existing shared string
 616
 617       if Can_Be_Reused (SR, SR.Last + 1) then
 618          SR.Data (SR.Last + 1) := New_Item;
 619          SR.Last := SR.Last + 1;
 620
 621       --  Otherwise, allocate new one and fill it
 622
 623       else
 624          DR := Allocate (DL + DL / Growth_Factor);
 625          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 626          DR.Data (DL) := New_Item;
 627          DR.Last := DL;
 628          Source.Reference := DR;
 629          Unreference (SR);
 630       end if;
 631    end Append;
 632
 633    -------------------
 634    -- Can_Be_Reused --
 635    -------------------
 636
 637    function Can_Be_Reused
 638      (Item   : Shared_Wide_String_Access;
 639       Length : Natural) return Boolean
 640    is
 641       use Interfaces;
 642    begin
 643       return
 644         Item.Counter = 1
 645           and then Item.Max_Length >= Length
 646           and then Item.Max_Length <=
 647                      Aligned_Max_Length (Length + Length / Growth_Factor);
 648    end Can_Be_Reused;
 649
 650    -----------
 651    -- Count --
 652    -----------
 653
 654    function Count
 655      (Source  : Unbounded_Wide_String;
 656       Pattern : Wide_String;
 657       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
 658       return Natural
 659    is
 660       SR : constant Shared_Wide_String_Access := Source.Reference;
 661    begin
 662       return Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 663    end Count;
 664
 665    function Count
 666      (Source  : Unbounded_Wide_String;
 667       Pattern : Wide_String;
 668       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
 669    is
 670       SR : constant Shared_Wide_String_Access := Source.Reference;
 671    begin
 672       return Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 673    end Count;
 674
 675    function Count
 676      (Source : Unbounded_Wide_String;
 677       Set    : Wide_Maps.Wide_Character_Set) return Natural
 678    is
 679       SR : constant Shared_Wide_String_Access := Source.Reference;
 680    begin
 681       return Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
 682    end Count;
 683
 684    ------------
 685    -- Delete --
 686    ------------
 687
 688    function Delete
 689      (Source  : Unbounded_Wide_String;
 690       From    : Positive;
 691       Through : Natural) return Unbounded_Wide_String
 692    is
 693       SR : constant Shared_Wide_String_Access := Source.Reference;
 694       DL : Natural;
 695       DR : Shared_Wide_String_Access;
 696
 697    begin
 698       --  Empty slice is deleted, use the same shared string
 699
 700       if From > Through then
 701          Reference (SR);
 702          DR := SR;
 703
 704       --  Index is out of range
 705
 706       elsif Through > SR.Last then
 707          raise Index_Error;
 708
 709       --  Compute size of the result
 710
 711       else
 712          DL := SR.Last - (Through - From + 1);
 713
 714          --  Result is an empty string, reuse shared empty string
 715
 716          if DL = 0 then
 717             Reference (Empty_Shared_Wide_String'Access);
 718             DR := Empty_Shared_Wide_String'Access;
 719
 720          --  Otherwise, allocate new shared string and fill it
 721
 722          else
 723             DR := Allocate (DL);
 724             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 725             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 726             DR.Last := DL;
 727          end if;
 728       end if;
 729
 730       return (AF.Controlled with Reference => DR);
 731    end Delete;
 732
 733    procedure Delete
 734      (Source  : in out Unbounded_Wide_String;
 735       From    : Positive;
 736       Through : Natural)
 737    is
 738       SR : constant Shared_Wide_String_Access := Source.Reference;
 739       DL : Natural;
 740       DR : Shared_Wide_String_Access;
 741
 742    begin
 743       --  Nothing changed, return
 744
 745       if From > Through then
 746          null;
 747
 748       --  Through is outside of the range
 749
 750       elsif Through > SR.Last then
 751          raise Index_Error;
 752
 753       else
 754          DL := SR.Last - (Through - From + 1);
 755
 756          --  Result is empty, reuse shared empty string
 757
 758          if DL = 0 then
 759             Reference (Empty_Shared_Wide_String'Access);
 760             Source.Reference := Empty_Shared_Wide_String'Access;
 761             Unreference (SR);
 762
 763          --  Try to reuse existent shared string
 764
 765          elsif Can_Be_Reused (SR, DL) then
 766             SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 767             SR.Last := DL;
 768
 769          --  Otherwise, allocate new shared string
 770
 771          else
 772             DR := Allocate (DL);
 773             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 774             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 775             DR.Last := DL;
 776             Source.Reference := DR;
 777             Unreference (SR);
 778          end if;
 779       end if;
 780    end Delete;
 781
 782    -------------
 783    -- Element --
 784    -------------
 785
 786    function Element
 787      (Source : Unbounded_Wide_String;
 788       Index  : Positive) return Wide_Character
 789    is
 790       SR : constant Shared_Wide_String_Access := Source.Reference;
 791    begin
 792       if Index <= SR.Last then
 793          return SR.Data (Index);
 794       else
 795          raise Index_Error;
 796       end if;
 797    end Element;
 798
 799    --------------
 800    -- Finalize --
 801    --------------
 802
 803    procedure Finalize (Object : in out Unbounded_Wide_String) is
 804       SR : constant Shared_Wide_String_Access := Object.Reference;
 805
 806    begin
 807       if SR /= null then
 808
 809          --  The same controlled object can be finalized several times for
 810          --  some reason. As per 7.6.1(24) this should have no ill effect,
 811          --  so we need to add a guard for the case of finalizing the same
 812          --  object twice.
 813
 814          Object.Reference := null;
 815          Unreference (SR);
 816       end if;
 817    end Finalize;
 818
 819    ----------------
 820    -- Find_Token --
 821    ----------------
 822
 823    procedure Find_Token
 824      (Source : Unbounded_Wide_String;
 825       Set    : Wide_Maps.Wide_Character_Set;
 826       Test   : Strings.Membership;
 827       First  : out Positive;
 828       Last   : out Natural)
 829    is
 830       SR : constant Shared_Wide_String_Access := Source.Reference;
 831    begin
 832       Wide_Search.Find_Token (SR.Data (1 .. SR.Last), Set, Test, First, Last);
 833    end Find_Token;
 834
 835    ----------
 836    -- Free --
 837    ----------
 838
 839    procedure Free (X : in out Wide_String_Access) is
 840       procedure Deallocate is
 841          new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
 842    begin
 843       Deallocate (X);
 844    end Free;
 845
 846    ----------
 847    -- Head --
 848    ----------
 849
 850    function Head
 851      (Source : Unbounded_Wide_String;
 852       Count  : Natural;
 853       Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
 854    is
 855       SR : constant Shared_Wide_String_Access := Source.Reference;
 856       DR : Shared_Wide_String_Access;
 857
 858    begin
 859       --  Result is empty, reuse shared empty string
 860
 861       if Count = 0 then
 862          Reference (Empty_Shared_Wide_String'Access);
 863          DR := Empty_Shared_Wide_String'Access;
 864
 865       --  Length of the string is the same as requested, reuse source shared
 866       --  string.
 867
 868       elsif Count = SR.Last then
 869          Reference (SR);
 870          DR := SR;
 871
 872       --  Otherwise, allocate new shared string and fill it
 873
 874       else
 875          DR := Allocate (Count);
 876
 877          --  Length of the source string is more than requested, copy
 878          --  corresponding slice.
 879
 880          if Count < SR.Last then
 881             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 882
 883          --  Length of the source string is less then requested, copy all
 884          --  contents and fill others by Pad character.
 885
 886          else
 887             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 888
 889             for J in SR.Last + 1 .. Count loop
 890                DR.Data (J) := Pad;
 891             end loop;
 892          end if;
 893
 894          DR.Last := Count;
 895       end if;
 896
 897       return (AF.Controlled with Reference => DR);
 898    end Head;
 899
 900    procedure Head
 901      (Source : in out Unbounded_Wide_String;
 902       Count  : Natural;
 903       Pad    : Wide_Character := Wide_Space)
 904    is
 905       SR : constant Shared_Wide_String_Access := Source.Reference;
 906       DR : Shared_Wide_String_Access;
 907
 908    begin
 909       --  Result is empty, reuse empty shared string
 910
 911       if Count = 0 then
 912          Reference (Empty_Shared_Wide_String'Access);
 913          Source.Reference := Empty_Shared_Wide_String'Access;
 914          Unreference (SR);
 915
 916       --  Result is same with source string, reuse source shared string
 917
 918       elsif Count = SR.Last then
 919          null;
 920
 921       --  Try to reuse existent shared string
 922
 923       elsif Can_Be_Reused (SR, Count) then
 924          if Count > SR.Last then
 925             for J in SR.Last + 1 .. Count loop
 926                SR.Data (J) := Pad;
 927             end loop;
 928          end if;
 929
 930          SR.Last := Count;
 931
 932       --  Otherwise, allocate new shared string and fill it
 933
 934       else
 935          DR := Allocate (Count);
 936
 937          --  Length of the source string is greater then requested, copy
 938          --  corresponding slice.
 939
 940          if Count < SR.Last then
 941             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 942
 943          --  Length of the source string is less the requested, copy all
 944          --  exists data and fill others by Pad character.
 945
 946          else
 947             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 948
 949             for J in SR.Last + 1 .. Count loop
 950                DR.Data (J) := Pad;
 951             end loop;
 952          end if;
 953
 954          DR.Last := Count;
 955          Source.Reference := DR;
 956          Unreference (SR);
 957       end if;
 958    end Head;
 959
 960    -----------
 961    -- Index --
 962    -----------
 963
 964    function Index
 965      (Source  : Unbounded_Wide_String;
 966       Pattern : Wide_String;
 967       Going   : Strings.Direction := Strings.Forward;
 968       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
 969       return Natural
 970    is
 971       SR : constant Shared_Wide_String_Access := Source.Reference;
 972    begin
 973       return Wide_Search.Index
 974         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 975    end Index;
 976
 977    function Index
 978      (Source  : Unbounded_Wide_String;
 979       Pattern : Wide_String;
 980       Going   : Direction := Forward;
 981       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
 982    is
 983       SR : constant Shared_Wide_String_Access := Source.Reference;
 984    begin
 985       return Wide_Search.Index
 986         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 987    end Index;
 988
 989    function Index
 990      (Source : Unbounded_Wide_String;
 991       Set    : Wide_Maps.Wide_Character_Set;
 992       Test   : Strings.Membership := Strings.Inside;
 993       Going  : Strings.Direction  := Strings.Forward) return Natural
 994    is
 995       SR : constant Shared_Wide_String_Access := Source.Reference;
 996    begin
 997       return Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
 998    end Index;
 999
1000    function Index
1001      (Source  : Unbounded_Wide_String;
1002       Pattern : Wide_String;
1003       From    : Positive;
1004       Going   : Direction := Forward;
1005       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
1006       return Natural
1007    is
1008       SR : constant Shared_Wide_String_Access := Source.Reference;
1009    begin
1010       return Wide_Search.Index
1011         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1012    end Index;
1013
1014    function Index
1015      (Source  : Unbounded_Wide_String;
1016       Pattern : Wide_String;
1017       From    : Positive;
1018       Going   : Direction := Forward;
1019       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
1020    is
1021       SR : constant Shared_Wide_String_Access := Source.Reference;
1022    begin
1023       return Wide_Search.Index
1024         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1025    end Index;
1026
1027    function Index
1028      (Source  : Unbounded_Wide_String;
1029       Set     : Wide_Maps.Wide_Character_Set;
1030       From    : Positive;
1031       Test    : Membership := Inside;
1032       Going   : Direction := Forward) return Natural
1033    is
1034       SR : constant Shared_Wide_String_Access := Source.Reference;
1035    begin
1036       return Wide_Search.Index
1037         (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1038    end Index;
1039
1040    ---------------------
1041    -- Index_Non_Blank --
1042    ---------------------
1043
1044    function Index_Non_Blank
1045      (Source : Unbounded_Wide_String;
1046       Going  : Strings.Direction := Strings.Forward) return Natural
1047    is
1048       SR : constant Shared_Wide_String_Access := Source.Reference;
1049    begin
1050       return Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1051    end Index_Non_Blank;
1052
1053    function Index_Non_Blank
1054      (Source : Unbounded_Wide_String;
1055       From   : Positive;
1056       Going  : Direction := Forward) return Natural
1057    is
1058       SR : constant Shared_Wide_String_Access := Source.Reference;
1059    begin
1060       return Wide_Search.Index_Non_Blank
1061         (SR.Data (1 .. SR.Last), From, Going);
1062    end Index_Non_Blank;
1063
1064    ----------------
1065    -- Initialize --
1066    ----------------
1067
1068    procedure Initialize (Object : in out Unbounded_Wide_String) is
1069    begin
1070       Reference (Object.Reference);
1071    end Initialize;
1072
1073    ------------
1074    -- Insert --
1075    ------------
1076
1077    function Insert
1078      (Source   : Unbounded_Wide_String;
1079       Before   : Positive;
1080       New_Item : Wide_String) return Unbounded_Wide_String
1081    is
1082       SR : constant Shared_Wide_String_Access := Source.Reference;
1083       DL : constant Natural := SR.Last + New_Item'Length;
1084       DR : Shared_Wide_String_Access;
1085
1086    begin
1087       --  Check index first
1088
1089       if Before > SR.Last + 1 then
1090          raise Index_Error;
1091       end if;
1092
1093       --  Result is empty, reuse empty shared string
1094
1095       if DL = 0 then
1096          Reference (Empty_Shared_Wide_String'Access);
1097          DR := Empty_Shared_Wide_String'Access;
1098
1099       --  Inserted string is empty, reuse source shared string
1100
1101       elsif New_Item'Length = 0 then
1102          Reference (SR);
1103          DR := SR;
1104
1105       --  Otherwise, allocate new shared string and fill it
1106
1107       else
1108          DR := Allocate (DL + DL / Growth_Factor);
1109          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1110          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1111          DR.Data (Before + New_Item'Length .. DL) :=
1112            SR.Data (Before .. SR.Last);
1113          DR.Last := DL;
1114       end if;
1115
1116       return (AF.Controlled with Reference => DR);
1117    end Insert;
1118
1119    procedure Insert
1120      (Source   : in out Unbounded_Wide_String;
1121       Before   : Positive;
1122       New_Item : Wide_String)
1123    is
1124       SR : constant Shared_Wide_String_Access := Source.Reference;
1125       DL : constant Natural                   := SR.Last + New_Item'Length;
1126       DR : Shared_Wide_String_Access;
1127
1128    begin
1129       --  Check bounds
1130
1131       if Before > SR.Last + 1 then
1132          raise Index_Error;
1133       end if;
1134
1135       --  Result is empty string, reuse empty shared string
1136
1137       if DL = 0 then
1138          Reference (Empty_Shared_Wide_String'Access);
1139          Source.Reference := Empty_Shared_Wide_String'Access;
1140          Unreference (SR);
1141
1142       --  Inserted string is empty, nothing to do
1143
1144       elsif New_Item'Length = 0 then
1145          null;
1146
1147       --  Try to reuse existent shared string first
1148
1149       elsif Can_Be_Reused (SR, DL) then
1150          SR.Data (Before + New_Item'Length .. DL) :=
1151            SR.Data (Before .. SR.Last);
1152          SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1153          SR.Last := DL;
1154
1155       --  Otherwise, allocate new shared string and fill it
1156
1157       else
1158          DR := Allocate (DL + DL / Growth_Factor);
1159          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1160          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1161          DR.Data (Before + New_Item'Length .. DL) :=
1162            SR.Data (Before .. SR.Last);
1163          DR.Last := DL;
1164          Source.Reference := DR;
1165          Unreference (SR);
1166       end if;
1167    end Insert;
1168
1169    ------------
1170    -- Length --
1171    ------------
1172
1173    function Length (Source : Unbounded_Wide_String) return Natural is
1174    begin
1175       return Source.Reference.Last;
1176    end Length;
1177
1178    ---------------
1179    -- Overwrite --
1180    ---------------
1181
1182    function Overwrite
1183      (Source   : Unbounded_Wide_String;
1184       Position : Positive;
1185       New_Item : Wide_String) return Unbounded_Wide_String
1186    is
1187       SR : constant Shared_Wide_String_Access := Source.Reference;
1188       DL : Natural;
1189       DR : Shared_Wide_String_Access;
1190
1191    begin
1192       --  Check bounds
1193
1194       if Position > SR.Last + 1 then
1195          raise Index_Error;
1196       end if;
1197
1198       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1199
1200       --  Result is empty string, reuse empty shared string
1201
1202       if DL = 0 then
1203          Reference (Empty_Shared_Wide_String'Access);
1204          DR := Empty_Shared_Wide_String'Access;
1205
1206       --  Result is same with source string, reuse source shared string
1207
1208       elsif New_Item'Length = 0 then
1209          Reference (SR);
1210          DR := SR;
1211
1212       --  Otherwise, allocate new shared string and fill it
1213
1214       else
1215          DR := Allocate (DL);
1216          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1217          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1218          DR.Data (Position + New_Item'Length .. DL) :=
1219            SR.Data (Position + New_Item'Length .. SR.Last);
1220          DR.Last := DL;
1221       end if;
1222
1223       return (AF.Controlled with Reference => DR);
1224    end Overwrite;
1225
1226    procedure Overwrite
1227      (Source    : in out Unbounded_Wide_String;
1228       Position  : Positive;
1229       New_Item  : Wide_String)
1230    is
1231       SR : constant Shared_Wide_String_Access := Source.Reference;
1232       DL : Natural;
1233       DR : Shared_Wide_String_Access;
1234
1235    begin
1236       --  Bounds check
1237
1238       if Position > SR.Last + 1 then
1239          raise Index_Error;
1240       end if;
1241
1242       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1243
1244       --  Result is empty string, reuse empty shared string
1245
1246       if DL = 0 then
1247          Reference (Empty_Shared_Wide_String'Access);
1248          Source.Reference := Empty_Shared_Wide_String'Access;
1249          Unreference (SR);
1250
1251       --  String unchanged, nothing to do
1252
1253       elsif New_Item'Length = 0 then
1254          null;
1255
1256       --  Try to reuse existent shared string
1257
1258       elsif Can_Be_Reused (SR, DL) then
1259          SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1260          SR.Last := DL;
1261
1262       --  Otherwise allocate new shared string and fill it
1263
1264       else
1265          DR := Allocate (DL);
1266          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1267          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1268          DR.Data (Position + New_Item'Length .. DL) :=
1269            SR.Data (Position + New_Item'Length .. SR.Last);
1270          DR.Last := DL;
1271          Source.Reference := DR;
1272          Unreference (SR);
1273       end if;
1274    end Overwrite;
1275
1276    ---------------
1277    -- Reference --
1278    ---------------
1279
1280    procedure Reference (Item : not null Shared_Wide_String_Access) is
1281    begin
1282       Sync_Add_And_Fetch (Item.Counter'Access, 1);
1283    end Reference;
1284
1285    ---------------------
1286    -- Replace_Element --
1287    ---------------------
1288
1289    procedure Replace_Element
1290      (Source : in out Unbounded_Wide_String;
1291       Index  : Positive;
1292       By     : Wide_Character)
1293    is
1294       SR : constant Shared_Wide_String_Access := Source.Reference;
1295       DR : Shared_Wide_String_Access;
1296
1297    begin
1298       --  Bounds check.
1299
1300       if Index <= SR.Last then
1301
1302          --  Try to reuse existent shared string
1303
1304          if Can_Be_Reused (SR, SR.Last) then
1305             SR.Data (Index) := By;
1306
1307          --  Otherwise allocate new shared string and fill it
1308
1309          else
1310             DR := Allocate (SR.Last);
1311             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1312             DR.Data (Index) := By;
1313             DR.Last := SR.Last;
1314             Source.Reference := DR;
1315             Unreference (SR);
1316          end if;
1317
1318       else
1319          raise Index_Error;
1320       end if;
1321    end Replace_Element;
1322
1323    -------------------
1324    -- Replace_Slice --
1325    -------------------
1326
1327    function Replace_Slice
1328      (Source : Unbounded_Wide_String;
1329       Low    : Positive;
1330       High   : Natural;
1331       By     : Wide_String) return Unbounded_Wide_String
1332    is
1333       SR : constant Shared_Wide_String_Access := Source.Reference;
1334       DL : Natural;
1335       DR : Shared_Wide_String_Access;
1336
1337    begin
1338       --  Check bounds
1339
1340       if Low > SR.Last + 1 then
1341          raise Index_Error;
1342       end if;
1343
1344       --  Do replace operation when removed slice is not empty
1345
1346       if High >= Low then
1347          DL := By'Length + SR.Last + Low - High - 1;
1348
1349          --  Result is empty string, reuse empty shared string
1350
1351          if DL = 0 then
1352             Reference (Empty_Shared_Wide_String'Access);
1353             DR := Empty_Shared_Wide_String'Access;
1354
1355          --  Otherwise allocate new shared string and fill it
1356
1357          else
1358             DR := Allocate (DL);
1359             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1360             DR.Data (Low .. Low + By'Length - 1) := By;
1361             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1362             DR.Last := DL;
1363          end if;
1364
1365          return (AF.Controlled with Reference => DR);
1366
1367       --  Otherwise just insert string
1368
1369       else
1370          return Insert (Source, Low, By);
1371       end if;
1372    end Replace_Slice;
1373
1374    procedure Replace_Slice
1375      (Source : in out Unbounded_Wide_String;
1376       Low    : Positive;
1377       High   : Natural;
1378       By     : Wide_String)
1379    is
1380       SR : constant Shared_Wide_String_Access := Source.Reference;
1381       DL : Natural;
1382       DR : Shared_Wide_String_Access;
1383
1384    begin
1385       --  Bounds check
1386
1387       if Low > SR.Last + 1 then
1388          raise Index_Error;
1389       end if;
1390
1391       --  Do replace operation only when replaced slice is not empty
1392
1393       if High >= Low then
1394          DL := By'Length + SR.Last + Low - High - 1;
1395
1396          --  Result is empty string, reuse empty shared string
1397
1398          if DL = 0 then
1399             Reference (Empty_Shared_Wide_String'Access);
1400             Source.Reference := Empty_Shared_Wide_String'Access;
1401             Unreference (SR);
1402
1403          --  Try to reuse existent shared string
1404
1405          elsif Can_Be_Reused (SR, DL) then
1406             SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1407             SR.Data (Low .. Low + By'Length - 1) := By;
1408             SR.Last := DL;
1409
1410          --  Otherwise allocate new shared string and fill it
1411
1412          else
1413             DR := Allocate (DL);
1414             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1415             DR.Data (Low .. Low + By'Length - 1) := By;
1416             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1417             DR.Last := DL;
1418             Source.Reference := DR;
1419             Unreference (SR);
1420          end if;
1421
1422       --  Otherwise just insert item
1423
1424       else
1425          Insert (Source, Low, By);
1426       end if;
1427    end Replace_Slice;
1428
1429    -------------------------------
1430    -- Set_Unbounded_Wide_String --
1431    -------------------------------
1432
1433    procedure Set_Unbounded_Wide_String
1434      (Target : out Unbounded_Wide_String;
1435       Source : Wide_String)
1436    is
1437       TR : constant Shared_Wide_String_Access := Target.Reference;
1438       DR : Shared_Wide_String_Access;
1439
1440    begin
1441       --  In case of empty string, reuse empty shared string
1442
1443       if Source'Length = 0 then
1444          Reference (Empty_Shared_Wide_String'Access);
1445          Target.Reference := Empty_Shared_Wide_String'Access;
1446
1447       else
1448          --  Try to reuse existent shared string
1449
1450          if Can_Be_Reused (TR, Source'Length) then
1451             Reference (TR);
1452             DR := TR;
1453
1454          --  Otherwise allocate new shared string
1455
1456          else
1457             DR := Allocate (Source'Length);
1458             Target.Reference := DR;
1459          end if;
1460
1461          DR.Data (1 .. Source'Length) := Source;
1462          DR.Last := Source'Length;
1463       end if;
1464
1465       Unreference (TR);
1466    end Set_Unbounded_Wide_String;
1467
1468    -----------
1469    -- Slice --
1470    -----------
1471
1472    function Slice
1473      (Source : Unbounded_Wide_String;
1474       Low    : Positive;
1475       High   : Natural) return Wide_String
1476    is
1477       SR : constant Shared_Wide_String_Access := Source.Reference;
1478
1479    begin
1480       --  Note: test of High > Length is in accordance with AI95-00128
1481
1482       if Low > SR.Last + 1 or else High > SR.Last then
1483          raise Index_Error;
1484
1485       else
1486          return SR.Data (Low .. High);
1487       end if;
1488    end Slice;
1489
1490    ----------
1491    -- Tail --
1492    ----------
1493
1494    function Tail
1495      (Source : Unbounded_Wide_String;
1496       Count  : Natural;
1497       Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
1498    is
1499       SR : constant Shared_Wide_String_Access := Source.Reference;
1500       DR : Shared_Wide_String_Access;
1501
1502    begin
1503       --  For empty result reuse empty shared string
1504
1505       if Count = 0 then
1506          Reference (Empty_Shared_Wide_String'Access);
1507          DR := Empty_Shared_Wide_String'Access;
1508
1509       --  Result is hole source string, reuse source shared string
1510
1511       elsif Count = SR.Last then
1512          Reference (SR);
1513          DR := SR;
1514
1515       --  Otherwise allocate new shared string and fill it
1516
1517       else
1518          DR := Allocate (Count);
1519
1520          if Count < SR.Last then
1521             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1522
1523          else
1524             for J in 1 .. Count - SR.Last loop
1525                DR.Data (J) := Pad;
1526             end loop;
1527
1528             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1529          end if;
1530
1531          DR.Last := Count;
1532       end if;
1533
1534       return (AF.Controlled with Reference => DR);
1535    end Tail;
1536
1537    procedure Tail
1538      (Source : in out Unbounded_Wide_String;
1539       Count  : Natural;
1540       Pad    : Wide_Character := Wide_Space)
1541    is
1542       SR : constant Shared_Wide_String_Access := Source.Reference;
1543       DR : Shared_Wide_String_Access;
1544
1545       procedure Common
1546         (SR    : Shared_Wide_String_Access;
1547          DR    : Shared_Wide_String_Access;
1548          Count : Natural);
1549       --  Common code of tail computation. SR/DR can point to the same object
1550
1551       ------------
1552       -- Common --
1553       ------------
1554
1555       procedure Common
1556         (SR    : Shared_Wide_String_Access;
1557          DR    : Shared_Wide_String_Access;
1558          Count : Natural) is
1559       begin
1560          if Count < SR.Last then
1561             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1562
1563          else
1564             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1565
1566             for J in 1 .. Count - SR.Last loop
1567                DR.Data (J) := Pad;
1568             end loop;
1569          end if;
1570
1571          DR.Last := Count;
1572       end Common;
1573
1574    begin
1575       --  Result is empty string, reuse empty shared string
1576
1577       if Count = 0 then
1578          Reference (Empty_Shared_Wide_String'Access);
1579          Source.Reference := Empty_Shared_Wide_String'Access;
1580          Unreference (SR);
1581
1582       --  Length of the result is the same with length of the source string,
1583       --  reuse source shared string.
1584
1585       elsif Count = SR.Last then
1586          null;
1587
1588       --  Try to reuse existent shared string
1589
1590       elsif Can_Be_Reused (SR, Count) then
1591          Common (SR, SR, Count);
1592
1593       --  Otherwise allocate new shared string and fill it
1594
1595       else
1596          DR := Allocate (Count);
1597          Common (SR, DR, Count);
1598          Source.Reference := DR;
1599          Unreference (SR);
1600       end if;
1601    end Tail;
1602
1603    --------------------
1604    -- To_Wide_String --
1605    --------------------
1606
1607    function To_Wide_String
1608      (Source : Unbounded_Wide_String) return Wide_String is
1609    begin
1610       return Source.Reference.Data (1 .. Source.Reference.Last);
1611    end To_Wide_String;
1612
1613    ------------------------------
1614    -- To_Unbounded_Wide_String --
1615    ------------------------------
1616
1617    function To_Unbounded_Wide_String
1618      (Source : Wide_String) return Unbounded_Wide_String
1619    is
1620       DR : constant Shared_Wide_String_Access := Allocate (Source'Length);
1621    begin
1622       DR.Data (1 .. Source'Length) := Source;
1623       DR.Last := Source'Length;
1624       return (AF.Controlled with Reference => DR);
1625    end To_Unbounded_Wide_String;
1626
1627    function To_Unbounded_Wide_String
1628      (Length : Natural) return Unbounded_Wide_String
1629    is
1630       DR : constant Shared_Wide_String_Access := Allocate (Length);
1631    begin
1632       DR.Last := Length;
1633       return (AF.Controlled with Reference => DR);
1634    end To_Unbounded_Wide_String;
1635
1636    ---------------
1637    -- Translate --
1638    ---------------
1639
1640    function Translate
1641      (Source  : Unbounded_Wide_String;
1642       Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String
1643    is
1644       SR : constant Shared_Wide_String_Access := Source.Reference;
1645       DR : Shared_Wide_String_Access;
1646
1647    begin
1648       --  Nothing to translate, reuse empty shared string
1649
1650       if SR.Last = 0 then
1651          Reference (Empty_Shared_Wide_String'Access);
1652          DR := Empty_Shared_Wide_String'Access;
1653
1654       --  Otherwise, allocate new shared string and fill it
1655
1656       else
1657          DR := Allocate (SR.Last);
1658
1659          for J in 1 .. SR.Last loop
1660             DR.Data (J) := Value (Mapping, SR.Data (J));
1661          end loop;
1662
1663          DR.Last := SR.Last;
1664       end if;
1665
1666       return (AF.Controlled with Reference => DR);
1667    end Translate;
1668
1669    procedure Translate
1670      (Source  : in out Unbounded_Wide_String;
1671       Mapping : Wide_Maps.Wide_Character_Mapping)
1672    is
1673       SR : constant Shared_Wide_String_Access := Source.Reference;
1674       DR : Shared_Wide_String_Access;
1675
1676    begin
1677       --  Nothing to translate
1678
1679       if SR.Last = 0 then
1680          null;
1681
1682       --  Try to reuse shared string
1683
1684       elsif Can_Be_Reused (SR, SR.Last) then
1685          for J in 1 .. SR.Last loop
1686             SR.Data (J) := Value (Mapping, SR.Data (J));
1687          end loop;
1688
1689       --  Otherwise, allocate new shared string
1690
1691       else
1692          DR := Allocate (SR.Last);
1693
1694          for J in 1 .. SR.Last loop
1695             DR.Data (J) := Value (Mapping, SR.Data (J));
1696          end loop;
1697
1698          DR.Last := SR.Last;
1699          Source.Reference := DR;
1700          Unreference (SR);
1701       end if;
1702    end Translate;
1703
1704    function Translate
1705      (Source  : Unbounded_Wide_String;
1706       Mapping : Wide_Maps.Wide_Character_Mapping_Function)
1707       return Unbounded_Wide_String
1708    is
1709       SR : constant Shared_Wide_String_Access := Source.Reference;
1710       DR : Shared_Wide_String_Access;
1711
1712    begin
1713       --  Nothing to translate, reuse empty shared string
1714
1715       if SR.Last = 0 then
1716          Reference (Empty_Shared_Wide_String'Access);
1717          DR := Empty_Shared_Wide_String'Access;
1718
1719       --  Otherwise, allocate new shared string and fill it
1720
1721       else
1722          DR := Allocate (SR.Last);
1723
1724          for J in 1 .. SR.Last loop
1725             DR.Data (J) := Mapping.all (SR.Data (J));
1726          end loop;
1727
1728          DR.Last := SR.Last;
1729       end if;
1730
1731       return (AF.Controlled with Reference => DR);
1732
1733    exception
1734       when others =>
1735          Unreference (DR);
1736
1737          raise;
1738    end Translate;
1739
1740    procedure Translate
1741      (Source  : in out Unbounded_Wide_String;
1742       Mapping : Wide_Maps.Wide_Character_Mapping_Function)
1743    is
1744       SR : constant Shared_Wide_String_Access := Source.Reference;
1745       DR : Shared_Wide_String_Access;
1746
1747    begin
1748       --  Nothing to translate
1749
1750       if SR.Last = 0 then
1751          null;
1752
1753       --  Try to reuse shared string
1754
1755       elsif Can_Be_Reused (SR, SR.Last) then
1756          for J in 1 .. SR.Last loop
1757             SR.Data (J) := Mapping.all (SR.Data (J));
1758          end loop;
1759
1760       --  Otherwise allocate new shared string and fill it
1761
1762       else
1763          DR := Allocate (SR.Last);
1764
1765          for J in 1 .. SR.Last loop
1766             DR.Data (J) := Mapping.all (SR.Data (J));
1767          end loop;
1768
1769          DR.Last := SR.Last;
1770          Source.Reference := DR;
1771          Unreference (SR);
1772       end if;
1773
1774    exception
1775       when others =>
1776          if DR /= null then
1777             Unreference (DR);
1778          end if;
1779
1780          raise;
1781    end Translate;
1782
1783    ----------
1784    -- Trim --
1785    ----------
1786
1787    function Trim
1788      (Source : Unbounded_Wide_String;
1789       Side   : Trim_End) return Unbounded_Wide_String
1790    is
1791       SR   : constant Shared_Wide_String_Access := Source.Reference;
1792       DL   : Natural;
1793       DR   : Shared_Wide_String_Access;
1794       Low  : Natural;
1795       High : Natural;
1796
1797    begin
1798       Low := Index_Non_Blank (Source, Forward);
1799
1800       --  All blanks, reuse empty shared string
1801
1802       if Low = 0 then
1803          Reference (Empty_Shared_Wide_String'Access);
1804          DR := Empty_Shared_Wide_String'Access;
1805
1806       else
1807          case Side is
1808             when Left =>
1809                High := SR.Last;
1810                DL   := SR.Last - Low + 1;
1811
1812             when Right =>
1813                Low  := 1;
1814                High := Index_Non_Blank (Source, Backward);
1815                DL   := High;
1816
1817             when Both =>
1818                High := Index_Non_Blank (Source, Backward);
1819                DL   := High - Low + 1;
1820          end case;
1821
1822          --  Length of the result is the same as length of the source string,
1823          --  reuse source shared string.
1824
1825          if DL = SR.Last then
1826             Reference (SR);
1827             DR := SR;
1828
1829          --  Otherwise, allocate new shared string
1830
1831          else
1832             DR := Allocate (DL);
1833             DR.Data (1 .. DL) := SR.Data (Low .. High);
1834             DR.Last := DL;
1835          end if;
1836       end if;
1837
1838       return (AF.Controlled with Reference => DR);
1839    end Trim;
1840
1841    procedure Trim
1842      (Source : in out Unbounded_Wide_String;
1843       Side   : Trim_End)
1844    is
1845       SR   : constant Shared_Wide_String_Access := Source.Reference;
1846       DL   : Natural;
1847       DR   : Shared_Wide_String_Access;
1848       Low  : Natural;
1849       High : Natural;
1850
1851    begin
1852       Low := Index_Non_Blank (Source, Forward);
1853
1854       --  All blanks, reuse empty shared string
1855
1856       if Low = 0 then
1857          Reference (Empty_Shared_Wide_String'Access);
1858          Source.Reference := Empty_Shared_Wide_String'Access;
1859          Unreference (SR);
1860
1861       else
1862          case Side is
1863             when Left =>
1864                High := SR.Last;
1865                DL   := SR.Last - Low + 1;
1866
1867             when Right =>
1868                Low  := 1;
1869                High := Index_Non_Blank (Source, Backward);
1870                DL   := High;
1871
1872             when Both =>
1873                High := Index_Non_Blank (Source, Backward);
1874                DL   := High - Low + 1;
1875          end case;
1876
1877          --  Length of the result is the same as length of the source string,
1878          --  nothing to do.
1879
1880          if DL = SR.Last then
1881             null;
1882
1883          --  Try to reuse existent shared string
1884
1885          elsif Can_Be_Reused (SR, DL) then
1886             SR.Data (1 .. DL) := SR.Data (Low .. High);
1887             SR.Last := DL;
1888
1889          --  Otherwise, allocate new shared string
1890
1891          else
1892             DR := Allocate (DL);
1893             DR.Data (1 .. DL) := SR.Data (Low .. High);
1894             DR.Last := DL;
1895             Source.Reference := DR;
1896             Unreference (SR);
1897          end if;
1898       end if;
1899    end Trim;
1900
1901    function Trim
1902      (Source : Unbounded_Wide_String;
1903       Left   : Wide_Maps.Wide_Character_Set;
1904       Right  : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String
1905    is
1906       SR   : constant Shared_Wide_String_Access := Source.Reference;
1907       DL   : Natural;
1908       DR   : Shared_Wide_String_Access;
1909       Low  : Natural;
1910       High : Natural;
1911
1912    begin
1913       Low := Index (Source, Left, Outside, Forward);
1914
1915       --  Source includes only characters from Left set, reuse empty shared
1916       --  string.
1917
1918       if Low = 0 then
1919          Reference (Empty_Shared_Wide_String'Access);
1920          DR := Empty_Shared_Wide_String'Access;
1921
1922       else
1923          High := Index (Source, Right, Outside, Backward);
1924          DL   := Integer'Max (0, High - Low + 1);
1925
1926          --  Source includes only characters from Right set or result string
1927          --  is empty, reuse empty shared string.
1928
1929          if High = 0 or else DL = 0 then
1930             Reference (Empty_Shared_Wide_String'Access);
1931             DR := Empty_Shared_Wide_String'Access;
1932
1933          --  Otherwise, allocate new shared string and fill it
1934
1935          else
1936             DR := Allocate (DL);
1937             DR.Data (1 .. DL) := SR.Data (Low .. High);
1938             DR.Last := DL;
1939          end if;
1940       end if;
1941
1942       return (AF.Controlled with Reference => DR);
1943    end Trim;
1944
1945    procedure Trim
1946      (Source : in out Unbounded_Wide_String;
1947       Left   : Wide_Maps.Wide_Character_Set;
1948       Right  : Wide_Maps.Wide_Character_Set)
1949    is
1950       SR   : constant Shared_Wide_String_Access := Source.Reference;
1951       DL   : Natural;
1952       DR   : Shared_Wide_String_Access;
1953       Low  : Natural;
1954       High : Natural;
1955
1956    begin
1957       Low := Index (Source, Left, Outside, Forward);
1958
1959       --  Source includes only characters from Left set, reuse empty shared
1960       --  string.
1961
1962       if Low = 0 then
1963          Reference (Empty_Shared_Wide_String'Access);
1964          Source.Reference := Empty_Shared_Wide_String'Access;
1965          Unreference (SR);
1966
1967       else
1968          High := Index (Source, Right, Outside, Backward);
1969          DL   := Integer'Max (0, High - Low + 1);
1970
1971          --  Source includes only characters from Right set or result string
1972          --  is empty, reuse empty shared string.
1973
1974          if High = 0 or else DL = 0 then
1975             Reference (Empty_Shared_Wide_String'Access);
1976             Source.Reference := Empty_Shared_Wide_String'Access;
1977             Unreference (SR);
1978
1979          --  Try to reuse existent shared string
1980
1981          elsif Can_Be_Reused (SR, DL) then
1982             SR.Data (1 .. DL) := SR.Data (Low .. High);
1983             SR.Last := DL;
1984
1985          --  Otherwise, allocate new shared string and fill it
1986
1987          else
1988             DR := Allocate (DL);
1989             DR.Data (1 .. DL) := SR.Data (Low .. High);
1990             DR.Last := DL;
1991             Source.Reference := DR;
1992             Unreference (SR);
1993          end if;
1994       end if;
1995    end Trim;
1996
1997    ---------------------
1998    -- Unbounded_Slice --
1999    ---------------------
2000
2001    function Unbounded_Slice
2002      (Source : Unbounded_Wide_String;
2003       Low    : Positive;
2004       High   : Natural) return Unbounded_Wide_String
2005    is
2006       SR : constant Shared_Wide_String_Access := Source.Reference;
2007       DL : Natural;
2008       DR : Shared_Wide_String_Access;
2009
2010    begin
2011       --  Check bounds
2012
2013       if Low > SR.Last + 1 or else High > SR.Last then
2014          raise Index_Error;
2015
2016       --  Result is empty slice, reuse empty shared string
2017
2018       elsif Low > High then
2019          Reference (Empty_Shared_Wide_String'Access);
2020          DR := Empty_Shared_Wide_String'Access;
2021
2022       --  Otherwise, allocate new shared string and fill it
2023
2024       else
2025          DL := High - Low + 1;
2026          DR := Allocate (DL);
2027          DR.Data (1 .. DL) := SR.Data (Low .. High);
2028          DR.Last := DL;
2029       end if;
2030
2031       return (AF.Controlled with Reference => DR);
2032    end Unbounded_Slice;
2033
2034    procedure Unbounded_Slice
2035      (Source : Unbounded_Wide_String;
2036       Target : out Unbounded_Wide_String;
2037       Low    : Positive;
2038       High   : Natural)
2039    is
2040       SR : constant Shared_Wide_String_Access := Source.Reference;
2041       TR : constant Shared_Wide_String_Access := Target.Reference;
2042       DL : Natural;
2043       DR : Shared_Wide_String_Access;
2044
2045    begin
2046       --  Check bounds
2047
2048       if Low > SR.Last + 1 or else High > SR.Last then
2049          raise Index_Error;
2050
2051       --  Result is empty slice, reuse empty shared string
2052
2053       elsif Low > High then
2054          Reference (Empty_Shared_Wide_String'Access);
2055          Target.Reference := Empty_Shared_Wide_String'Access;
2056          Unreference (TR);
2057
2058       else
2059          DL := High - Low + 1;
2060
2061          --  Try to reuse existent shared string
2062
2063          if Can_Be_Reused (TR, DL) then
2064             TR.Data (1 .. DL) := SR.Data (Low .. High);
2065             TR.Last := DL;
2066
2067          --  Otherwise, allocate new shared string and fill it
2068
2069          else
2070             DR := Allocate (DL);
2071             DR.Data (1 .. DL) := SR.Data (Low .. High);
2072             DR.Last := DL;
2073             Target.Reference := DR;
2074             Unreference (TR);
2075          end if;
2076       end if;
2077    end Unbounded_Slice;
2078
2079    -----------------
2080    -- Unreference --
2081    -----------------
2082
2083    procedure Unreference (Item : not null Shared_Wide_String_Access) is
2084       use Interfaces;
2085
2086       procedure Free is
2087         new Ada.Unchecked_Deallocation
2088               (Shared_Wide_String, Shared_Wide_String_Access);
2089
2090       Aux : Shared_Wide_String_Access := Item;
2091
2092    begin
2093       if Sync_Sub_And_Fetch (Aux.Counter'Access, 1) = 0 then
2094
2095          --  Reference counter of Empty_Shared_Wide_String must never reach
2096          --  zero.
2097
2098          pragma Assert (Aux /= Empty_Shared_Wide_String'Access);
2099
2100          Free (Aux);
2101       end if;
2102    end Unreference;
2103
2104 end Ada.Strings.Wide_Unbounded;