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