URL https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stzunb-shared.adb] - Blame information for rev 717

Go to most recent revision | Details | Compare with Previous | View Log

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--      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       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Ada.Strings.Wide_Wide_Search;
with Ada.Unchecked_Deallocation;
 
package body Ada.Strings.Wide_Wide_Unbounded is
 
   use Ada.Strings.Wide_Wide_Maps;
 
   Growth_Factor : constant := 32;
   --  The growth factor controls how much extra space is allocated when
   --  we have to increase the size of an allocated unbounded string. By
   --  allocating extra space, we avoid the need to reallocate on every
   --  append, particularly important when a string is built up by repeated
   --  append operations of small pieces. This is expressed as a factor so
   --  32 means add 1/32 of the length of the string as growth space.
 
   Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
   --  Allocation will be done by a multiple of Min_Mul_Alloc. This causes
   --  no memory loss as most (all?) malloc implementations are obliged to
   --  align the returned memory on the maximum alignment as malloc does not
   --  know the target alignment.
 
   function Aligned_Max_Length (Max_Length : Natural) return Natural;
   --  Returns recommended length of the shared string which is greater or
   --  equal to specified length. Calculation take in sense alignment of
   --  the allocated memory segments to use memory effectively by
   --  Append/Insert/etc operations.
 
   ---------
   -- "&" --
   ---------
 
   function "&"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
      DL : constant Natural := LR.Last + RR.Last;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Result is an empty string, reuse shared empty string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Left string is empty, return Rigth string
 
      elsif LR.Last = 0 then
         Reference (RR);
         DR := RR;
 
      --  Right string is empty, return Left string
 
      elsif RR.Last = 0 then
         Reference (LR);
         DR := LR;
 
      --  Overwise, allocate new shared string and fill data
 
      else
         DR := Allocate (LR.Last + RR.Last);
         DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
         DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end "&";
 
   function "&"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      DL : constant Natural := LR.Last + Right'Length;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Result is an empty string, reuse shared empty string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Right is an empty string, return Left string
 
      elsif Right'Length = 0 then
         Reference (LR);
         DR := LR;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL);
         DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
         DR.Data (LR.Last + 1 .. DL) := Right;
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end "&";
 
   function "&"
     (Left  : Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
      DL : constant Natural := Left'Length + RR.Last;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Result is an empty string, reuse shared one
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Left is empty string, return Right string
 
      elsif Left'Length = 0 then
         Reference (RR);
         DR := RR;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL);
         DR.Data (1 .. Left'Length) := Left;
         DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end "&";
 
   function "&"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      DL : constant Natural := LR.Last + 1;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      DR := Allocate (DL);
      DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
      DR.Data (DL) := Right;
      DR.Last := DL;
 
      return (AF.Controlled with Reference => DR);
   end "&";
 
   function "&"
     (Left  : Wide_Wide_Character;
      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
      DL : constant Natural := 1 + RR.Last;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      DR := Allocate (DL);
      DR.Data (1) := Left;
      DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
      DR.Last := DL;
 
      return (AF.Controlled with Reference => DR);
   end "&";
 
   ---------
   -- "*" --
   ---------
 
   function "*"
     (Left  : Natural;
      Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
   is
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Result is an empty string, reuse shared empty string
 
      if Left = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (Left);
 
         for J in 1 .. Left loop
            DR.Data (J) := Right;
         end loop;
 
         DR.Last := Left;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end "*";
 
   function "*"
     (Left  : Natural;
      Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      DL : constant Natural := Left * Right'Length;
      DR : Shared_Wide_Wide_String_Access;
      K  : Positive;
 
   begin
      --  Result is an empty string, reuse shared empty string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL);
         K := 1;
 
         for J in 1 .. Left loop
            DR.Data (K .. K + Right'Length - 1) := Right;
            K := K + Right'Length;
         end loop;
 
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end "*";
 
   function "*"
     (Left  : Natural;
      Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
      DL : constant Natural := Left * RR.Last;
      DR : Shared_Wide_Wide_String_Access;
      K  : Positive;
 
   begin
      --  Result is an empty string, reuse shared empty string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Coefficient is one, just return string itself
 
      elsif Left = 1 then
         Reference (RR);
         DR := RR;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL);
         K := 1;
 
         for J in 1 .. Left loop
            DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
            K := K + RR.Last;
         end loop;
 
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end "*";
 
   ---------
   -- "<" --
   ---------
 
   function "<"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
   end "<";
 
   function "<"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
   begin
      return LR.Data (1 .. LR.Last) < Right;
   end "<";
 
   function "<"
     (Left  : Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return Left < RR.Data (1 .. RR.Last);
   end "<";
 
   ----------
   -- "<=" --
   ----------
 
   function "<="
     (Left  : Unbounded_Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 
   begin
      --  LR = RR means two strings shares shared string, thus they are equal
 
      return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
   end "<=";
 
   function "<="
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
   begin
      return LR.Data (1 .. LR.Last) <= Right;
   end "<=";
 
   function "<="
     (Left  : Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return Left <= RR.Data (1 .. RR.Last);
   end "<=";
 
   ---------
   -- "=" --
   ---------
 
   function "="
     (Left  : Unbounded_Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 
   begin
      return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
      --  LR = RR means two strings shares shared string, thus they are equal
   end "=";
 
   function "="
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
   begin
      return LR.Data (1 .. LR.Last) = Right;
   end "=";
 
   function "="
     (Left  : Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return Left = RR.Data (1 .. RR.Last);
   end "=";
 
   ---------
   -- ">" --
   ---------
 
   function ">"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
   end ">";
 
   function ">"
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
   begin
      return LR.Data (1 .. LR.Last) > Right;
   end ">";
 
   function ">"
     (Left  : Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return Left > RR.Data (1 .. RR.Last);
   end ">";
 
   ----------
   -- ">=" --
   ----------
 
   function ">="
     (Left  : Unbounded_Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 
   begin
      --  LR = RR means two strings shares shared string, thus they are equal
 
      return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
   end ">=";
 
   function ">="
     (Left  : Unbounded_Wide_Wide_String;
      Right : Wide_Wide_String) return Boolean
   is
      LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
   begin
      return LR.Data (1 .. LR.Last) >= Right;
   end ">=";
 
   function ">="
     (Left  : Wide_Wide_String;
      Right : Unbounded_Wide_Wide_String) return Boolean
   is
      RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
   begin
      return Left >= RR.Data (1 .. RR.Last);
   end ">=";
 
   ------------
   -- Adjust --
   ------------
 
   procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
   begin
      Reference (Object.Reference);
   end Adjust;
 
   ------------------------
   -- Aligned_Max_Length --
   ------------------------
 
   function Aligned_Max_Length (Max_Length : Natural) return Natural is
      Static_Size  : constant Natural :=
                       Empty_Shared_Wide_Wide_String'Size
                         / Standard'Storage_Unit;
      --  Total size of all static components
 
      Element_Size : constant Natural :=
                       Wide_Wide_Character'Size / Standard'Storage_Unit;
 
   begin
      return
        (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
          * Min_Mul_Alloc - Static_Size) / Element_Size;
   end Aligned_Max_Length;
 
   --------------
   -- Allocate --
   --------------
 
   function Allocate
     (Max_Length : Natural) return Shared_Wide_Wide_String_Access is
   begin
      --  Empty string requested, return shared empty string
 
      if Max_Length = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         return Empty_Shared_Wide_Wide_String'Access;
 
      --  Otherwise, allocate requested space (and probably some more room)
 
      else
         return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length));
      end if;
   end Allocate;
 
   ------------
   -- Append --
   ------------
 
   procedure Append
     (Source   : in out Unbounded_Wide_Wide_String;
      New_Item : Unbounded_Wide_Wide_String)
   is
      SR  : constant Shared_Wide_Wide_String_Access := Source.Reference;
      NR  : constant Shared_Wide_Wide_String_Access := New_Item.Reference;
      DL  : constant Natural              := SR.Last + NR.Last;
      DR  : Shared_Wide_Wide_String_Access;
 
   begin
      --  Source is an empty string, reuse New_Item data
 
      if SR.Last = 0 then
         Reference (NR);
         Source.Reference := NR;
         Unreference (SR);
 
      --  New_Item is empty string, nothing to do
 
      elsif NR.Last = 0 then
         null;
 
      --  Try to reuse existent shared string
 
      elsif Can_Be_Reused (SR, DL) then
         SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
         SR.Last := DL;
 
      --  Otherwise, allocate new one and fill it
 
      else
         DR := Allocate (DL + DL / Growth_Factor);
         DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
         DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
         DR.Last := DL;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Append;
 
   procedure Append
     (Source   : in out Unbounded_Wide_Wide_String;
      New_Item : Wide_Wide_String)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : constant Natural := SR.Last + New_Item'Length;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  New_Item is an empty string, nothing to do
 
      if New_Item'Length = 0 then
         null;
 
      --  Try to reuse existing shared string
 
      elsif Can_Be_Reused (SR, DL) then
         SR.Data (SR.Last + 1 .. DL) := New_Item;
         SR.Last := DL;
 
      --  Otherwise, allocate new one and fill it
 
      else
         DR := Allocate (DL + DL / Growth_Factor);
         DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
         DR.Data (SR.Last + 1 .. DL) := New_Item;
         DR.Last := DL;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Append;
 
   procedure Append
     (Source   : in out Unbounded_Wide_Wide_String;
      New_Item : Wide_Wide_Character)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : constant Natural := SR.Last + 1;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Try to reuse existing shared string
 
      if Can_Be_Reused (SR, SR.Last + 1) then
         SR.Data (SR.Last + 1) := New_Item;
         SR.Last := SR.Last + 1;
 
      --  Otherwise, allocate new one and fill it
 
      else
         DR := Allocate (DL + DL / Growth_Factor);
         DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
         DR.Data (DL) := New_Item;
         DR.Last := DL;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Append;
 
   -------------------
   -- Can_Be_Reused --
   -------------------
 
   function Can_Be_Reused
     (Item   : Shared_Wide_Wide_String_Access;
      Length : Natural) return Boolean is
   begin
      return
        System.Atomic_Counters.Is_One (Item.Counter)
          and then Item.Max_Length >= Length
          and then Item.Max_Length <=
                     Aligned_Max_Length (Length + Length / Growth_Factor);
   end Can_Be_Reused;
 
   -----------
   -- Count --
   -----------
 
   function Count
     (Source  : Unbounded_Wide_Wide_String;
      Pattern : Wide_Wide_String;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
                  Wide_Wide_Maps.Identity)
      return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
   end Count;
 
   function Count
     (Source  : Unbounded_Wide_Wide_String;
      Pattern : Wide_Wide_String;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
      return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
   end Count;
 
   function Count
     (Source : Unbounded_Wide_Wide_String;
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
   end Count;
 
   ------------
   -- Delete --
   ------------
 
   function Delete
     (Source  : Unbounded_Wide_Wide_String;
      From    : Positive;
      Through : Natural) return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Empty slice is deleted, use the same shared string
 
      if From > Through then
         Reference (SR);
         DR := SR;
 
      --  Index is out of range
 
      elsif Through > SR.Last then
         raise Index_Error;
 
      --  Compute size of the result
 
      else
         DL := SR.Last - (Through - From + 1);
 
         --  Result is an empty string, reuse shared empty string
 
         if DL = 0 then
            Reference (Empty_Shared_Wide_Wide_String'Access);
            DR := Empty_Shared_Wide_Wide_String'Access;
 
         --  Otherwise, allocate new shared string and fill it
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
            DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
            DR.Last := DL;
         end if;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Delete;
 
   procedure Delete
     (Source  : in out Unbounded_Wide_Wide_String;
      From    : Positive;
      Through : Natural)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Nothing changed, return
 
      if From > Through then
         null;
 
      --  Through is outside of the range
 
      elsif Through > SR.Last then
         raise Index_Error;
 
      else
         DL := SR.Last - (Through - From + 1);
 
         --  Result is empty, reuse shared empty string
 
         if DL = 0 then
            Reference (Empty_Shared_Wide_Wide_String'Access);
            Source.Reference := Empty_Shared_Wide_Wide_String'Access;
            Unreference (SR);
 
         --  Try to reuse existent shared string
 
         elsif Can_Be_Reused (SR, DL) then
            SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
            SR.Last := DL;
 
         --  Otherwise, allocate new shared string
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
            DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
            DR.Last := DL;
            Source.Reference := DR;
            Unreference (SR);
         end if;
      end if;
   end Delete;
 
   -------------
   -- Element --
   -------------
 
   function Element
     (Source : Unbounded_Wide_Wide_String;
      Index  : Positive) return Wide_Wide_Character
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      if Index <= SR.Last then
         return SR.Data (Index);
      else
         raise Index_Error;
      end if;
   end Element;
 
   --------------
   -- Finalize --
   --------------
 
   procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
      SR : constant Shared_Wide_Wide_String_Access := Object.Reference;
 
   begin
      if SR /= null then
 
         --  The same controlled object can be finalized several times for
         --  some reason. As per 7.6.1(24) this should have no ill effect,
         --  so we need to add a guard for the case of finalizing the same
         --  object twice.
 
         Object.Reference := null;
         Unreference (SR);
      end if;
   end Finalize;
 
   ----------------
   -- Find_Token --
   ----------------
 
   procedure Find_Token
     (Source : Unbounded_Wide_Wide_String;
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
      From   : Positive;
      Test   : Strings.Membership;
      First  : out Positive;
      Last   : out Natural)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      Wide_Wide_Search.Find_Token
        (SR.Data (From .. SR.Last), Set, Test, First, Last);
   end Find_Token;
 
   procedure Find_Token
     (Source : Unbounded_Wide_Wide_String;
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
      Test   : Strings.Membership;
      First  : out Positive;
      Last   : out Natural)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      Wide_Wide_Search.Find_Token
        (SR.Data (1 .. SR.Last), Set, Test, First, Last);
   end Find_Token;
 
   ----------
   -- Free --
   ----------
 
   procedure Free (X : in out Wide_Wide_String_Access) is
      procedure Deallocate is
         new Ada.Unchecked_Deallocation
               (Wide_Wide_String, Wide_Wide_String_Access);
   begin
      Deallocate (X);
   end Free;
 
   ----------
   -- Head --
   ----------
 
   function Head
     (Source : Unbounded_Wide_Wide_String;
      Count  : Natural;
      Pad    : Wide_Wide_Character := Wide_Wide_Space)
      return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Result is empty, reuse shared empty string
 
      if Count = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Length of the string is the same as requested, reuse source shared
      --  string.
 
      elsif Count = SR.Last then
         Reference (SR);
         DR := SR;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (Count);
 
         --  Length of the source string is more than requested, copy
         --  corresponding slice.
 
         if Count < SR.Last then
            DR.Data (1 .. Count) := SR.Data (1 .. Count);
 
         --  Length of the source string is less then requested, copy all
         --  contents and fill others by Pad character.
 
         else
            DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 
            for J in SR.Last + 1 .. Count loop
               DR.Data (J) := Pad;
            end loop;
         end if;
 
         DR.Last := Count;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Head;
 
   procedure Head
     (Source : in out Unbounded_Wide_Wide_String;
      Count  : Natural;
      Pad    : Wide_Wide_Character := Wide_Wide_Space)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Result is empty, reuse empty shared string
 
      if Count = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Source.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (SR);
 
      --  Result is same with source string, reuse source shared string
 
      elsif Count = SR.Last then
         null;
 
      --  Try to reuse existent shared string
 
      elsif Can_Be_Reused (SR, Count) then
         if Count > SR.Last then
            for J in SR.Last + 1 .. Count loop
               SR.Data (J) := Pad;
            end loop;
         end if;
 
         SR.Last := Count;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (Count);
 
         --  Length of the source string is greater then requested, copy
         --  corresponding slice.
 
         if Count < SR.Last then
            DR.Data (1 .. Count) := SR.Data (1 .. Count);
 
         --  Length of the source string is less the requested, copy all
         --  exists data and fill others by Pad character.
 
         else
            DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 
            for J in SR.Last + 1 .. Count loop
               DR.Data (J) := Pad;
            end loop;
         end if;
 
         DR.Last := Count;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Head;
 
   -----------
   -- Index --
   -----------
 
   function Index
     (Source  : Unbounded_Wide_Wide_String;
      Pattern : Wide_Wide_String;
      Going   : Strings.Direction := Strings.Forward;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
                  Wide_Wide_Maps.Identity)
      return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index
        (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
   end Index;
 
   function Index
     (Source  : Unbounded_Wide_Wide_String;
      Pattern : Wide_Wide_String;
      Going   : Direction := Forward;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
      return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index
        (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
   end Index;
 
   function Index
     (Source : Unbounded_Wide_Wide_String;
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
      Test   : Strings.Membership := Strings.Inside;
      Going  : Strings.Direction  := Strings.Forward) return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
   end Index;
 
   function Index
     (Source  : Unbounded_Wide_Wide_String;
      Pattern : Wide_Wide_String;
      From    : Positive;
      Going   : Direction := Forward;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
                  Wide_Wide_Maps.Identity)
      return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index
        (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
   end Index;
 
   function Index
     (Source  : Unbounded_Wide_Wide_String;
      Pattern : Wide_Wide_String;
      From    : Positive;
      Going   : Direction := Forward;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
      return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index
        (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
   end Index;
 
   function Index
     (Source  : Unbounded_Wide_Wide_String;
      Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
      From    : Positive;
      Test    : Membership := Inside;
      Going   : Direction := Forward) return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index
        (SR.Data (1 .. SR.Last), Set, From, Test, Going);
   end Index;
 
   ---------------------
   -- Index_Non_Blank --
   ---------------------
 
   function Index_Non_Blank
     (Source : Unbounded_Wide_Wide_String;
      Going  : Strings.Direction := Strings.Forward) return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
   end Index_Non_Blank;
 
   function Index_Non_Blank
     (Source : Unbounded_Wide_Wide_String;
      From   : Positive;
      Going  : Direction := Forward) return Natural
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
   begin
      return Wide_Wide_Search.Index_Non_Blank
        (SR.Data (1 .. SR.Last), From, Going);
   end Index_Non_Blank;
 
   ----------------
   -- Initialize --
   ----------------
 
   procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
   begin
      Reference (Object.Reference);
   end Initialize;
 
   ------------
   -- Insert --
   ------------
 
   function Insert
     (Source   : Unbounded_Wide_Wide_String;
      Before   : Positive;
      New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : constant Natural := SR.Last + New_Item'Length;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Check index first
 
      if Before > SR.Last + 1 then
         raise Index_Error;
      end if;
 
      --  Result is empty, reuse empty shared string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Inserted string is empty, reuse source shared string
 
      elsif New_Item'Length = 0 then
         Reference (SR);
         DR := SR;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL + DL / Growth_Factor);
         DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
         DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
         DR.Data (Before + New_Item'Length .. DL) :=
           SR.Data (Before .. SR.Last);
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Insert;
 
   procedure Insert
     (Source   : in out Unbounded_Wide_Wide_String;
      Before   : Positive;
      New_Item : Wide_Wide_String)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : constant Natural := SR.Last + New_Item'Length;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Check bounds
 
      if Before > SR.Last + 1 then
         raise Index_Error;
      end if;
 
      --  Result is empty string, reuse empty shared string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Source.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (SR);
 
      --  Inserted string is empty, nothing to do
 
      elsif New_Item'Length = 0 then
         null;
 
      --  Try to reuse existent shared string first
 
      elsif Can_Be_Reused (SR, DL) then
         SR.Data (Before + New_Item'Length .. DL) :=
           SR.Data (Before .. SR.Last);
         SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
         SR.Last := DL;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL + DL / Growth_Factor);
         DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
         DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
         DR.Data (Before + New_Item'Length .. DL) :=
           SR.Data (Before .. SR.Last);
         DR.Last := DL;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Insert;
 
   ------------
   -- Length --
   ------------
 
   function Length (Source : Unbounded_Wide_Wide_String) return Natural is
   begin
      return Source.Reference.Last;
   end Length;
 
   ---------------
   -- Overwrite --
   ---------------
 
   function Overwrite
     (Source   : Unbounded_Wide_Wide_String;
      Position : Positive;
      New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Check bounds
 
      if Position > SR.Last + 1 then
         raise Index_Error;
      end if;
 
      DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
 
      --  Result is empty string, reuse empty shared string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Result is same with source string, reuse source shared string
 
      elsif New_Item'Length = 0 then
         Reference (SR);
         DR := SR;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (DL);
         DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
         DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
         DR.Data (Position + New_Item'Length .. DL) :=
           SR.Data (Position + New_Item'Length .. SR.Last);
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Overwrite;
 
   procedure Overwrite
     (Source    : in out Unbounded_Wide_Wide_String;
      Position  : Positive;
      New_Item  : Wide_Wide_String)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Bounds check
 
      if Position > SR.Last + 1 then
         raise Index_Error;
      end if;
 
      DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
 
      --  Result is empty string, reuse empty shared string
 
      if DL = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Source.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (SR);
 
      --  String unchanged, nothing to do
 
      elsif New_Item'Length = 0 then
         null;
 
      --  Try to reuse existent shared string
 
      elsif Can_Be_Reused (SR, DL) then
         SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
         SR.Last := DL;
 
      --  Otherwise allocate new shared string and fill it
 
      else
         DR := Allocate (DL);
         DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
         DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
         DR.Data (Position + New_Item'Length .. DL) :=
           SR.Data (Position + New_Item'Length .. SR.Last);
         DR.Last := DL;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Overwrite;
 
   ---------------
   -- Reference --
   ---------------
 
   procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
   begin
      System.Atomic_Counters.Increment (Item.Counter);
   end Reference;
 
   ---------------------
   -- Replace_Element --
   ---------------------
 
   procedure Replace_Element
     (Source : in out Unbounded_Wide_Wide_String;
      Index  : Positive;
      By     : Wide_Wide_Character)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Bounds check
 
      if Index <= SR.Last then
 
         --  Try to reuse existent shared string
 
         if Can_Be_Reused (SR, SR.Last) then
            SR.Data (Index) := By;
 
         --  Otherwise allocate new shared string and fill it
 
         else
            DR := Allocate (SR.Last);
            DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
            DR.Data (Index) := By;
            DR.Last := SR.Last;
            Source.Reference := DR;
            Unreference (SR);
         end if;
 
      else
         raise Index_Error;
      end if;
   end Replace_Element;
 
   -------------------
   -- Replace_Slice --
   -------------------
 
   function Replace_Slice
     (Source : Unbounded_Wide_Wide_String;
      Low    : Positive;
      High   : Natural;
      By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Check bounds
 
      if Low > SR.Last + 1 then
         raise Index_Error;
      end if;
 
      --  Do replace operation when removed slice is not empty
 
      if High >= Low then
         DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
         --  This is the number of characters remaining in the string after
         --  replacing the slice.
 
         --  Result is empty string, reuse empty shared string
 
         if DL = 0 then
            Reference (Empty_Shared_Wide_Wide_String'Access);
            DR := Empty_Shared_Wide_Wide_String'Access;
 
         --  Otherwise allocate new shared string and fill it
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
            DR.Data (Low .. Low + By'Length - 1) := By;
            DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
            DR.Last := DL;
         end if;
 
         return (AF.Controlled with Reference => DR);
 
      --  Otherwise just insert string
 
      else
         return Insert (Source, Low, By);
      end if;
   end Replace_Slice;
 
   procedure Replace_Slice
     (Source : in out Unbounded_Wide_Wide_String;
      Low    : Positive;
      High   : Natural;
      By     : Wide_Wide_String)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Bounds check
 
      if Low > SR.Last + 1 then
         raise Index_Error;
      end if;
 
      --  Do replace operation only when replaced slice is not empty
 
      if High >= Low then
         DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
         --  This is the number of characters remaining in the string after
         --  replacing the slice.
 
         --  Result is empty string, reuse empty shared string
 
         if DL = 0 then
            Reference (Empty_Shared_Wide_Wide_String'Access);
            Source.Reference := Empty_Shared_Wide_Wide_String'Access;
            Unreference (SR);
 
         --  Try to reuse existent shared string
 
         elsif Can_Be_Reused (SR, DL) then
            SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
            SR.Data (Low .. Low + By'Length - 1) := By;
            SR.Last := DL;
 
         --  Otherwise allocate new shared string and fill it
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
            DR.Data (Low .. Low + By'Length - 1) := By;
            DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
            DR.Last := DL;
            Source.Reference := DR;
            Unreference (SR);
         end if;
 
      --  Otherwise just insert item
 
      else
         Insert (Source, Low, By);
      end if;
   end Replace_Slice;
 
   -------------------------------
   -- Set_Unbounded_Wide_Wide_String --
   -------------------------------
 
   procedure Set_Unbounded_Wide_Wide_String
     (Target : out Unbounded_Wide_Wide_String;
      Source : Wide_Wide_String)
   is
      TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  In case of empty string, reuse empty shared string
 
      if Source'Length = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Target.Reference := Empty_Shared_Wide_Wide_String'Access;
 
      else
         --  Try to reuse existent shared string
 
         if Can_Be_Reused (TR, Source'Length) then
            Reference (TR);
            DR := TR;
 
         --  Otherwise allocate new shared string
 
         else
            DR := Allocate (Source'Length);
            Target.Reference := DR;
         end if;
 
         DR.Data (1 .. Source'Length) := Source;
         DR.Last := Source'Length;
      end if;
 
      Unreference (TR);
   end Set_Unbounded_Wide_Wide_String;
 
   -----------
   -- Slice --
   -----------
 
   function Slice
     (Source : Unbounded_Wide_Wide_String;
      Low    : Positive;
      High   : Natural) return Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 
   begin
      --  Note: test of High > Length is in accordance with AI95-00128
 
      if Low > SR.Last + 1 or else High > SR.Last then
         raise Index_Error;
 
      else
         return SR.Data (Low .. High);
      end if;
   end Slice;
 
   ----------
   -- Tail --
   ----------
 
   function Tail
     (Source : Unbounded_Wide_Wide_String;
      Count  : Natural;
      Pad    : Wide_Wide_Character := Wide_Wide_Space)
      return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  For empty result reuse empty shared string
 
      if Count = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Result is hole source string, reuse source shared string
 
      elsif Count = SR.Last then
         Reference (SR);
         DR := SR;
 
      --  Otherwise allocate new shared string and fill it
 
      else
         DR := Allocate (Count);
 
         if Count < SR.Last then
            DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
 
         else
            for J in 1 .. Count - SR.Last loop
               DR.Data (J) := Pad;
            end loop;
 
            DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
         end if;
 
         DR.Last := Count;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Tail;
 
   procedure Tail
     (Source : in out Unbounded_Wide_Wide_String;
      Count  : Natural;
      Pad    : Wide_Wide_Character := Wide_Wide_Space)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
      procedure Common
        (SR    : Shared_Wide_Wide_String_Access;
         DR    : Shared_Wide_Wide_String_Access;
         Count : Natural);
      --  Common code of tail computation. SR/DR can point to the same object
 
      ------------
      -- Common --
      ------------
 
      procedure Common
        (SR    : Shared_Wide_Wide_String_Access;
         DR    : Shared_Wide_Wide_String_Access;
         Count : Natural) is
      begin
         if Count < SR.Last then
            DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
 
         else
            DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
 
            for J in 1 .. Count - SR.Last loop
               DR.Data (J) := Pad;
            end loop;
         end if;
 
         DR.Last := Count;
      end Common;
 
   begin
      --  Result is empty string, reuse empty shared string
 
      if Count = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Source.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (SR);
 
      --  Length of the result is the same with length of the source string,
      --  reuse source shared string.
 
      elsif Count = SR.Last then
         null;
 
      --  Try to reuse existent shared string
 
      elsif Can_Be_Reused (SR, Count) then
         Common (SR, SR, Count);
 
      --  Otherwise allocate new shared string and fill it
 
      else
         DR := Allocate (Count);
         Common (SR, DR, Count);
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Tail;
 
   --------------------
   -- To_Wide_Wide_String --
   --------------------
 
   function To_Wide_Wide_String
     (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is
   begin
      return Source.Reference.Data (1 .. Source.Reference.Last);
   end To_Wide_Wide_String;
 
   ------------------------------
   -- To_Unbounded_Wide_Wide_String --
   ------------------------------
 
   function To_Unbounded_Wide_Wide_String
     (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
   is
      DR : constant Shared_Wide_Wide_String_Access := Allocate (Source'Length);
   begin
      DR.Data (1 .. Source'Length) := Source;
      DR.Last := Source'Length;
      return (AF.Controlled with Reference => DR);
   end To_Unbounded_Wide_Wide_String;
 
   function To_Unbounded_Wide_Wide_String
     (Length : Natural) return Unbounded_Wide_Wide_String
   is
      DR : constant Shared_Wide_Wide_String_Access := Allocate (Length);
   begin
      DR.Last := Length;
      return (AF.Controlled with Reference => DR);
   end To_Unbounded_Wide_Wide_String;
 
   ---------------
   -- Translate --
   ---------------
 
   function Translate
     (Source  : Unbounded_Wide_Wide_String;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
      return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Nothing to translate, reuse empty shared string
 
      if SR.Last = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (SR.Last);
 
         for J in 1 .. SR.Last loop
            DR.Data (J) := Value (Mapping, SR.Data (J));
         end loop;
 
         DR.Last := SR.Last;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Translate;
 
   procedure Translate
     (Source  : in out Unbounded_Wide_Wide_String;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Nothing to translate
 
      if SR.Last = 0 then
         null;
 
      --  Try to reuse shared string
 
      elsif Can_Be_Reused (SR, SR.Last) then
         for J in 1 .. SR.Last loop
            SR.Data (J) := Value (Mapping, SR.Data (J));
         end loop;
 
      --  Otherwise, allocate new shared string
 
      else
         DR := Allocate (SR.Last);
 
         for J in 1 .. SR.Last loop
            DR.Data (J) := Value (Mapping, SR.Data (J));
         end loop;
 
         DR.Last := SR.Last;
         Source.Reference := DR;
         Unreference (SR);
      end if;
   end Translate;
 
   function Translate
     (Source  : Unbounded_Wide_Wide_String;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
      return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Nothing to translate, reuse empty shared string
 
      if SR.Last = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DR := Allocate (SR.Last);
 
         for J in 1 .. SR.Last loop
            DR.Data (J) := Mapping.all (SR.Data (J));
         end loop;
 
         DR.Last := SR.Last;
      end if;
 
      return (AF.Controlled with Reference => DR);
 
   exception
      when others =>
         Unreference (DR);
 
         raise;
   end Translate;
 
   procedure Translate
     (Source  : in out Unbounded_Wide_Wide_String;
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Nothing to translate
 
      if SR.Last = 0 then
         null;
 
      --  Try to reuse shared string
 
      elsif Can_Be_Reused (SR, SR.Last) then
         for J in 1 .. SR.Last loop
            SR.Data (J) := Mapping.all (SR.Data (J));
         end loop;
 
      --  Otherwise allocate new shared string and fill it
 
      else
         DR := Allocate (SR.Last);
 
         for J in 1 .. SR.Last loop
            DR.Data (J) := Mapping.all (SR.Data (J));
         end loop;
 
         DR.Last := SR.Last;
         Source.Reference := DR;
         Unreference (SR);
      end if;
 
   exception
      when others =>
         if DR /= null then
            Unreference (DR);
         end if;
 
         raise;
   end Translate;
 
   ----------
   -- Trim --
   ----------
 
   function Trim
     (Source : Unbounded_Wide_Wide_String;
      Side   : Trim_End) return Unbounded_Wide_Wide_String
   is
      SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL   : Natural;
      DR   : Shared_Wide_Wide_String_Access;
      Low  : Natural;
      High : Natural;
 
   begin
      Low := Index_Non_Blank (Source, Forward);
 
      --  All blanks, reuse empty shared string
 
      if Low = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      else
         case Side is
            when Left =>
               High := SR.Last;
               DL   := SR.Last - Low + 1;
 
            when Right =>
               Low  := 1;
               High := Index_Non_Blank (Source, Backward);
               DL   := High;
 
            when Both =>
               High := Index_Non_Blank (Source, Backward);
               DL   := High - Low + 1;
         end case;
 
         --  Length of the result is the same as length of the source string,
         --  reuse source shared string.
 
         if DL = SR.Last then
            Reference (SR);
            DR := SR;
 
         --  Otherwise, allocate new shared string
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. DL) := SR.Data (Low .. High);
            DR.Last := DL;
         end if;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Trim;
 
   procedure Trim
     (Source : in out Unbounded_Wide_Wide_String;
      Side   : Trim_End)
   is
      SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL   : Natural;
      DR   : Shared_Wide_Wide_String_Access;
      Low  : Natural;
      High : Natural;
 
   begin
      Low := Index_Non_Blank (Source, Forward);
 
      --  All blanks, reuse empty shared string
 
      if Low = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Source.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (SR);
 
      else
         case Side is
            when Left =>
               High := SR.Last;
               DL   := SR.Last - Low + 1;
 
            when Right =>
               Low  := 1;
               High := Index_Non_Blank (Source, Backward);
               DL   := High;
 
            when Both =>
               High := Index_Non_Blank (Source, Backward);
               DL   := High - Low + 1;
         end case;
 
         --  Length of the result is the same as length of the source string,
         --  nothing to do.
 
         if DL = SR.Last then
            null;
 
         --  Try to reuse existent shared string
 
         elsif Can_Be_Reused (SR, DL) then
            SR.Data (1 .. DL) := SR.Data (Low .. High);
            SR.Last := DL;
 
         --  Otherwise, allocate new shared string
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. DL) := SR.Data (Low .. High);
            DR.Last := DL;
            Source.Reference := DR;
            Unreference (SR);
         end if;
      end if;
   end Trim;
 
   function Trim
     (Source : Unbounded_Wide_Wide_String;
      Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
      Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
      return Unbounded_Wide_Wide_String
   is
      SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL   : Natural;
      DR   : Shared_Wide_Wide_String_Access;
      Low  : Natural;
      High : Natural;
 
   begin
      Low := Index (Source, Left, Outside, Forward);
 
      --  Source includes only characters from Left set, reuse empty shared
      --  string.
 
      if Low = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      else
         High := Index (Source, Right, Outside, Backward);
         DL   := Integer'Max (0, High - Low + 1);
 
         --  Source includes only characters from Right set or result string
         --  is empty, reuse empty shared string.
 
         if High = 0 or else DL = 0 then
            Reference (Empty_Shared_Wide_Wide_String'Access);
            DR := Empty_Shared_Wide_Wide_String'Access;
 
         --  Otherwise, allocate new shared string and fill it
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. DL) := SR.Data (Low .. High);
            DR.Last := DL;
         end if;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Trim;
 
   procedure Trim
     (Source : in out Unbounded_Wide_Wide_String;
      Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
      Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
   is
      SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL   : Natural;
      DR   : Shared_Wide_Wide_String_Access;
      Low  : Natural;
      High : Natural;
 
   begin
      Low := Index (Source, Left, Outside, Forward);
 
      --  Source includes only characters from Left set, reuse empty shared
      --  string.
 
      if Low = 0 then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Source.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (SR);
 
      else
         High := Index (Source, Right, Outside, Backward);
         DL   := Integer'Max (0, High - Low + 1);
 
         --  Source includes only characters from Right set or result string
         --  is empty, reuse empty shared string.
 
         if High = 0 or else DL = 0 then
            Reference (Empty_Shared_Wide_Wide_String'Access);
            Source.Reference := Empty_Shared_Wide_Wide_String'Access;
            Unreference (SR);
 
         --  Try to reuse existent shared string
 
         elsif Can_Be_Reused (SR, DL) then
            SR.Data (1 .. DL) := SR.Data (Low .. High);
            SR.Last := DL;
 
         --  Otherwise, allocate new shared string and fill it
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. DL) := SR.Data (Low .. High);
            DR.Last := DL;
            Source.Reference := DR;
            Unreference (SR);
         end if;
      end if;
   end Trim;
 
   ---------------------
   -- Unbounded_Slice --
   ---------------------
 
   function Unbounded_Slice
     (Source : Unbounded_Wide_Wide_String;
      Low    : Positive;
      High   : Natural) return Unbounded_Wide_Wide_String
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Check bounds
 
      if Low > SR.Last + 1 or else High > SR.Last then
         raise Index_Error;
 
      --  Result is empty slice, reuse empty shared string
 
      elsif Low > High then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         DR := Empty_Shared_Wide_Wide_String'Access;
 
      --  Otherwise, allocate new shared string and fill it
 
      else
         DL := High - Low + 1;
         DR := Allocate (DL);
         DR.Data (1 .. DL) := SR.Data (Low .. High);
         DR.Last := DL;
      end if;
 
      return (AF.Controlled with Reference => DR);
   end Unbounded_Slice;
 
   procedure Unbounded_Slice
     (Source : Unbounded_Wide_Wide_String;
      Target : out Unbounded_Wide_Wide_String;
      Low    : Positive;
      High   : Natural)
   is
      SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
      TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
      DL : Natural;
      DR : Shared_Wide_Wide_String_Access;
 
   begin
      --  Check bounds
 
      if Low > SR.Last + 1 or else High > SR.Last then
         raise Index_Error;
 
      --  Result is empty slice, reuse empty shared string
 
      elsif Low > High then
         Reference (Empty_Shared_Wide_Wide_String'Access);
         Target.Reference := Empty_Shared_Wide_Wide_String'Access;
         Unreference (TR);
 
      else
         DL := High - Low + 1;
 
         --  Try to reuse existent shared string
 
         if Can_Be_Reused (TR, DL) then
            TR.Data (1 .. DL) := SR.Data (Low .. High);
            TR.Last := DL;
 
         --  Otherwise, allocate new shared string and fill it
 
         else
            DR := Allocate (DL);
            DR.Data (1 .. DL) := SR.Data (Low .. High);
            DR.Last := DL;
            Target.Reference := DR;
            Unreference (TR);
         end if;
      end if;
   end Unbounded_Slice;
 
   -----------------
   -- Unreference --
   -----------------
 
   procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
 
      procedure Free is
        new Ada.Unchecked_Deallocation
              (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access);
 
      Aux : Shared_Wide_Wide_String_Access := Item;
 
   begin
      if System.Atomic_Counters.Decrement (Aux.Counter) then
 
         --  Reference counter of Empty_Shared_Wide_Wide_String must never
         --  reach zero.
 
         pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access);
 
         Free (Aux);
      end if;
   end Unreference;
 
end Ada.Strings.Wide_Wide_Unbounded;
Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stzunb-shared.adb] - Blame information for rev 717

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
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-2011, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. --`
17			`-- --`
18			`-- As a special exception under Section 7 of GPL version 3, you are granted --`
19			`-- additional permissions described in the GCC Runtime Library Exception, --`
20			`-- version 3.1, as published by the Free Software Foundation. --`
21			`-- --`
22			`-- You should have received a copy of the GNU General Public License and --`
23			`-- a copy of the GCC Runtime Library Exception along with this program; --`
24			`-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --`
25			`-- <http://www.gnu.org/licenses/>. --`
26			`-- --`
27			`-- GNAT was originally developed by the GNAT team at New York University. --`
28			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
29			`-- --`
30			`------------------------------------------------------------------------------`
31
32			`with Ada.Strings.Wide_Wide_Search;`
33			`with Ada.Unchecked_Deallocation;`
34
35			`package body Ada.Strings.Wide_Wide_Unbounded is`
36
37			`use Ada.Strings.Wide_Wide_Maps;`
38
39			`Growth_Factor : constant := 32;`
40			`-- The growth factor controls how much extra space is allocated when`