
-- 1: --------------------------------
-- 2: -- Ivan Levashew aka OCTAGRAM --
-- 3: --              Barnaul, 2009 --
-- 4: --------------------------------

-- 5:

-- 6: with Turbo_Private.Bits; use Turbo_Private.Bits;

-- 7: with Turbo_Private.Atomic; use Turbo_Private.Atomic;

-- 8: with System; use System;

-- 9: with System.Storage_Elements;

-- 10:

-- 11: with Turbo_Private.Memory; use Turbo_Private;

-- 12: with Turbo_Private.Memory.Standard;
with turbo_private;
with turbo_private.turbo_private__memory;
with turbo_private;
with system;
with turbo_private;
with turbo_private;
with turbo_private.turbo_private__bits;
use turbo_private.turbo_private__bits;
with turbo_private.turbo_private__atomic;
use turbo_private.turbo_private__atomic;
with system;
use system;
with system.system__storage_elements;
with turbo_private.turbo_private__memory;
use turbo_private;
with turbo_private.turbo_private__memory.
  turbo_private__memory__standard;
with system;
with ada.ada__tags;
with system.system__storage_elements;

-- 13:

-- 14: package body Turbo_Private.Strings is
package body turbo_private.turbo_private__strings is

-- 15:

-- 16:    type String_Prefix is record
   type turbo_private__strings__string_prefix is record

-- 17:       Counter : aliased Atomic_Unsigned_32;
      counter : aliased turbo_private__atomic__atomic_unsigned_32;

-- 18:       Length  : Unsigned_32;
      length : interfaces__unsigned_32;

-- 19:    end record;
   end record;

-- 20:

-- 21:    String_Prefix_Size : constant Unsigned_Addr := String_Prefix'Max_Size_In_Storage_Elements;
   freeze turbo_private__strings__string_prefix [
      procedure turbo_private__strings__string_prefixIP (_init : in
        out turbo_private__strings__string_prefix) is
      begin
         null;
         return;
      end turbo_private__strings__string_prefixIP;
   ]
   [constraint_error when
     not (turbo_private__strings__string_prefix'
       max_size_in_storage_elements in 0 .. 16#FFFF_FFFF#)
     "range check failed"]
   turbo_private__strings__string_prefix_size : constant
     turbo_private__bits__unsigned_addr :=
     turbo_private__bits__unsigned_addr(
     turbo_private__strings__string_prefix'max_size_in_storage_elements);

-- 22:
-- 23:    ------------
-- 24:    -- Adjust --
-- 25:    ------------

-- 26:

-- 27:    procedure Adjust (Object : in out String_8) is
   procedure turbo_private__strings__adjust (object : in out
     turbo_private__strings__string_8) is
      B_1 : label

-- 28:    begin
   begin

-- 29:       if Object.Item /= Null_Address then
      if not (object.item = system__null_address) then

-- 30:          declare
         B_1 : declare
            prefix : turbo_private__strings__string_prefix;

-- 31:             Prefix : String_Prefix;

-- 32:             for Prefix'Address use Object.Item - String_Prefix_Size;
            type turbo_private__strings__adjust__B_1__A1b__2 is access
              all system__address;
            freeze turbo_private__strings__adjust__B_1__A1b__2 []
            R2b : turbo_private__strings__adjust__B_1__A1b__2 :=
              turbo_private__bits__Osubtract (object.item,
              turbo_private__strings__string_prefix_size)'reference;
            for prefix'address use R2b.all;

-- 33:             pragma Import (Ada, Prefix);
            pragma import (ada, prefix);
            freeze prefix []
            [program_error when
              system__storage_elements__integer_address!(R2b.all) rem
                prefix'alignment /= 0
              "misaligned address value"]
         begin

-- 34:          begin

-- 35:             Inc (Prefix.Counter);
            turbo_private__atomic__inc__5 (prefix.counter);

-- 36:          end;
         end B_1;

-- 37:       end if;
      end if;

-- 38:    end Adjust;
      return;
   end turbo_private__strings__adjust;

-- 39:
-- 40:    --------------
-- 41:    -- Finalize --
-- 42:    --------------

-- 43:

-- 44:    procedure Finalize (Object : in out String_8) is
   procedure turbo_private__strings__finalize (object : in out
     turbo_private__strings__string_8) is
      prefix_address : system__address;
      new_counter_value : interfaces__unsigned_32;
      B_2 : label
   begin

-- 45:       Prefix_Address : Address;

-- 46:       New_Counter_Value : Unsigned_32;

-- 47:    begin

-- 48:       if Object.Item /= Null_Address then
      if not (object.item = system__null_address) then

-- 49:          Prefix_Address := Object.Item - String_Prefix_Size;
         prefix_address := turbo_private__bits__Osubtract (object.item,
           turbo_private__strings__string_prefix_size);

-- 50:          declare
         B_2 : declare
            prefix : turbo_private__strings__string_prefix;

-- 51:             Prefix : String_Prefix;

-- 52:             for Prefix'Address use Prefix_Address;
            for prefix'address use prefix_address;

-- 53:             pragma Import (Ada, Prefix);
            pragma import (ada, prefix);
            freeze prefix []
            [program_error when
              system__storage_elements__integer_address!(prefix_address) rem
                prefix'alignment /= 0
              "misaligned address value"]
         begin

-- 54:          begin

-- 55:             New_Counter_Value := Dec_Get (Prefix.Counter'Access);
            new_counter_value := turbo_private__atomic__dec_get__3 (
              prefix.counter'access, addendF => 3);

-- 56:          end;
         end B_2;

-- 57:          if New_Counter_Value = 0 then
         if new_counter_value = 0 then

-- 58:             Memory.Standard.Storage_Pool.Deallocate (Prefix_Address);
            [type turbo_private__strings__finalize__T5b__2 is procedure (
              pool : in out turbo_private__memory__Tturbo_storage_poolC,
              storage_address : system__address)]
            [subtype turbo_private__strings__finalize__T6b__2 is access
              turbo_private__strings__finalize__T5b__2]
            turbo_private__strings__finalize__T6b__2!(
              turbo_private__memory__turbo_storage_poolH!(
              turbo_private__memory.turbo_private__memory__standard.
              turbo_private__memory__standard__storage_pool._tag).all (
              8)).all (turbo_private__memory.
              turbo_private__memory__standard.
              turbo_private__memory__standard__storage_pool,
              prefix_address);

-- 59:          end if;
         end if;

-- 60:       end if;
      end if;

-- 61:    end Finalize;
      return;

-- 62:

-- 63:

-- 64:

-- 65: end Turbo_Private.Strings;
   end turbo_private__strings__finalize;
begin
   null;
end turbo_private.turbo_private__strings;
