--  with Interfaces.C;            use Interfaces.C;
--  with Interfaces.C.Strings;    use Interfaces.C.Strings;

--  with System;                  use System;
--  with System.Storage_Pools;    use System.Storage_Pools;
--  with System.Storage_Elements; use System.Storage_Elements;

-- O_Strings, native targets implementation

with Ada.Unchecked_Deallocation;

package body Jwa.Strings is

   procedure Free is new Ada.Unchecked_Deallocation
     (Object => String_8_Internal,
      Name => String_8_Internal_Ptr);

   ---------------------
   -- String_8.Adjust --
   ---------------------

   procedure Adjust (Object : in out String_8) is
   begin
      if Object.Ptr /= null then
         declare
            RC : Reference_Counter_Type renames Object.Ptr.Counter;
         begin
            RC.rc := RC.rc + 1;
         end;
      end if;
   end Adjust;

   -----------------------
   -- String_8.Finalize --
   -----------------------

   procedure Finalize (Object : in out String_8) is
      Delete : Boolean := False;
   begin
      if Object.Ptr /= null then
         declare
            RC : Reference_Counter_Type renames Object.Ptr.Counter;
         begin
            RC.rc := RC.rc - 1;
            Delete := RC.rc <= 0;
         end;
         if Delete then
            Free (Object.Ptr);
         end if;
      end if;
   end Finalize;

   ---------------------------------------
   -- String_8.Create ( : String_8_Ptr) --
   ---------------------------------------

   function Create (Ptr : String_8_Ptr) return String_8 is
   begin
      return Result : String_8 do
         if Ptr /= null and then Ptr.Length > 0 then
            Result.Ptr := new String_8_Internal (Ptr.Length);
            Result.Ptr.Data.chr := Ptr.chr;
         end if;
      end return;
   end Create;

   ---------------------------------
   -- String_8.Create ( : String) --
   ---------------------------------

   function Create (Source : String) return String_8 is
   begin
      return Result : String_8 do
         if Source'Length > 0 then
            Result.Ptr := new String_8_Internal (Source'Length);
            Result.Ptr.Data.chr := Source;
         end if;
      end return;
   end Create;

   ----------------------------------
   -- String_8.Create ( : Natural) --
   ----------------------------------

   function Create (Length : Natural) return String_8 is
   begin
      return Result : String_8 do
         if Length > 0 then
            Result.Ptr := new String_8_Internal (Length);
         end if;
      end return;
   end Create;

   ------------------------------------
   -- String_8.Set ( : String_8_Ptr) --
   ------------------------------------

   procedure Set (Target : out String_8; Ptr : String_8_Ptr) is
   begin
      if Ptr /= null and then Ptr.Length > 0 then
         Target.Ptr := new String_8_Internal (Ptr.Length);
         Target.Ptr.Data.chr := Ptr.chr;
      else
         Target.Ptr := null;
      end if;
   end Set;

   -------------------------------
   -- String_8.Set ( : String) --
   -------------------------------

   procedure Set (Target : out String_8; Source : String) is
   begin
      if Source'Length > 0 then
         Target.Ptr := new String_8_Internal (Source'Length);
         Target.Ptr.Data.chr := Source;
      else
         Target.Ptr := null;
      end if;
   end Set;

   -------------------------
   -- String_8.Set_Length --
   -------------------------

   procedure Set_Length (Target : in out String_8; Length : Natural) is
      Target_Copy : String_8 := Target;
      Target_Data : String_8_Ptr := Target.p;
      Target_Length : Natural := Target_Data.Length;
      Copy_Length : Natural := Natural'Min (Target_Length, Length);
   begin
      if Length = Target_Length then
         null;
      elsif Length = 0 then
         Target.Finalize;
      elsif Target_Length = 0 then
         Target.Finalize;
         Target.Ptr := new String_8_Internal (Length);
      else
         Target.Finalize;
         Target.Ptr := new String_8_Internal (Length);
         Target.Ptr.Data.chr (1 .. Copy_Length) :=
           Target_Data.chr (1 .. Copy_Length);
      end if;
   end Set_Length;

   ---------------------
   -- String_8.To_Ada --
   ---------------------

   function To_Ada (Source : String_8) return String is
   begin
      if Source.Ptr = null then
         return (1 .. 0 => <>);
      else
         return Source.Ptr.Data.chr;
      end if;
   end To_Ada;

   ---------------------
   -- String_8.Unique --
   ---------------------

   procedure Unique (Item : in out String_8) is
      Is_Shared : Boolean := True;
   begin
      if Item.Ptr /= null then
         declare
            RC : Reference_Counter_Type renames Item.Ptr.Counter;
         begin
            Is_Shared := RC.rc > 1;
         end;
         if Is_Shared then
            Item := String_8'(Create (Item.Ptr.Data'Access));
         end if;
      end if;
   end Unique;

   ----------------
   -- String_8.p --
   ----------------

   function p (Item : String_8) return String_8_Ptr is
   begin
      if Item.Ptr /= null then
         return Item.Ptr.Data'Access;
      else
         return Null_String_8_Ptr;
      end if;
   end p;

   --------------------------------------
   --                                  --
   --      Mere string facilities      --
   --                                  --
   --------------------------------------

   ---------------------
   -- String_8.Length --
   ---------------------

   function Length (Source : String_8) return Natural is
   begin
      if Source.Ptr = null then
         return 0;
      else
         return Source.Ptr.Length;
      end if;
   end Length;



end Jwa.Strings;
