--------------------------------
-- Ivan Levashew aka OCTAGRAM --
--         Barnaul, 2009-2010 --
--------------------------------

-- Turbo_Private.Atomic, x86 version

-- 586+ is expected currently
-- I tried to add 386/486 support code, but
-- failed due to Atomic_Problem

-- Does anybody program in Ada on 386/486? Let me know.

-- Several operations (e. g. Inc_Get) must be
-- rewritten using CAS on 386.

-- Implementation is partial.

-- TODO: Release/Aquire counterparts

-- Modern x86 CPUs has lfence, sfence, mfence insns.
-- I have noticed they are only used on x86_64 (but not on x86).
-- Is it possible to use "?fence" to implement Aquire/Release sematic?

-- TODO: Unsigned_32
-- TODO: _Addr, _64, _16, _8
-- TODO: Atomic_Boolean, Atomic_Address

with System, Interfaces,
   Turbo_Private.Bits,
   Turbo_Private.Atomic_Integer_32_Package,
   Turbo_Private.Atomic_Unsigned_32_Package,
   Turbo_Private.Atomic_Integer_64_Package,
   Turbo_Private.Atomic_Unsigned_64_Package,
   Turbo_Private.Atomic_Integer_Addr_Package,
   Turbo_Private.Atomic_Unsigned_Addr_Package;

use System, Interfaces,
   Turbo_Private.Bits;

package Turbo_Private.Atomic is
   pragma Preelaborate;

   -----------------------
   -- Atomic_Integer_32 --
   -----------------------

   type Atomic_Integer_32 is new
      Turbo_Private.Atomic_Integer_32_Package.Atomic_Type_32;

   -- workaround for Limited_Problem
   function Create (Item : Integer_32) return Atomic_Integer_32;
   pragma Inline (Create);

   function Lazy_Create (Item : Integer_32) return Atomic_Integer_32;
   pragma Inline (Lazy_Create);

   function "+" (Item : Integer_32) return Atomic_Integer_32
      renames Lazy_Create;
   pragma Inline ("+");

   function Inc_Get (Addend : not null access Atomic_Integer_32)
      return Integer_32;
   function Get_Inc (Addend : not null access Atomic_Integer_32)
      return Integer_32;
   procedure Inc (Addend : in out Atomic_Integer_32);
   procedure Inc (Addend : not null access Atomic_Integer_32);

   function Inc_Get (Addend : not null access Atomic_Integer_32;
      Item : Integer_32) return Integer_32;
   function Get_Inc (Addend : not null access Atomic_Integer_32;
      Item : Integer_32) return Integer_32;
   procedure Inc (Addend : in out Atomic_Integer_32;
      Item : Integer_32);
   procedure Inc (Addend : not null access Atomic_Integer_32;
      Item : Integer_32);

   function Dec_Get (Addend : not null access Atomic_Integer_32)
      return Integer_32;
   function Get_Dec (Addend : not null access Atomic_Integer_32)
      return Integer_32;
   procedure Dec (Addend : in out Atomic_Integer_32);
   procedure Dec (Addend : not null access Atomic_Integer_32);

   function Dec_Get (Addend : not null access Atomic_Integer_32;
      Item : Integer_32) return Integer_32;
   function Get_Dec (Addend : not null access Atomic_Integer_32;
      Item : Integer_32) return Integer_32;
   procedure Dec (Addend : in out Atomic_Integer_32;
      Item : Integer_32);
   procedure Dec (Addend : not null access Atomic_Integer_32;
      Item : Integer_32);

   ------------------------
   -- Atomic_Unsigned_32 --
   ------------------------

   type Atomic_Unsigned_32 is new
      Turbo_Private.Atomic_Unsigned_32_Package.Atomic_Type_32;

   -- workaround for Limited_Problem
   function Create (Item : Unsigned_32) return Atomic_Unsigned_32;
   pragma Inline (Create);

   function Lazy_Create (Item : Unsigned_32) return Atomic_Unsigned_32;
   pragma Inline (Lazy_Create);

   function "+" (Item : Unsigned_32) return Atomic_Unsigned_32
      renames Lazy_Create;
   pragma Inline ("+");

   function Inc_Get (Addend : not null access Atomic_Unsigned_32)
      return Unsigned_32;
   function Get_Inc (Addend : not null access Atomic_Unsigned_32)
      return Unsigned_32;
   procedure Inc (Addend : in out Atomic_Unsigned_32);
   procedure Inc (Addend : not null access Atomic_Unsigned_32);

   function Inc_Get (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32) return Unsigned_32;
   function Get_Inc (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32) return Unsigned_32;
   procedure Inc (Addend : in out Atomic_Unsigned_32;
      Item : Unsigned_32);
   procedure Inc (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32);

   pragma Inline (Inc_Get, Get_Inc, Inc);

   function Dec_Get (Addend : not null access Atomic_Unsigned_32)
      return Unsigned_32;
   function Get_Dec (Addend : not null access Atomic_Unsigned_32)
      return Unsigned_32;
   procedure Dec (Addend : in out Atomic_Unsigned_32);
   procedure Dec (Addend : not null access Atomic_Unsigned_32);

   function Dec_Get (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32) return Unsigned_32;
   function Get_Dec (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32) return Unsigned_32;
   procedure Dec (Addend : in out Atomic_Unsigned_32;
      Item : Unsigned_32);
   procedure Dec (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32);

   pragma Inline (Dec_Get, Get_Dec, Dec);

   procedure Do_And (Addend : in out Atomic_Unsigned_32;
      Item : Unsigned_32);
   procedure Do_And (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32);

   procedure Do_Or (Addend : in out Atomic_Unsigned_32;
      Item : Unsigned_32);
   procedure Do_Or (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32);

   procedure Do_Xor (Addend : in out Atomic_Unsigned_32;
      Item : Unsigned_32);
   procedure Do_Xor (Addend : not null access Atomic_Unsigned_32;
      Item : Unsigned_32);

   pragma Inline (Do_And, Do_Or, Do_Xor);

   -----------------------
   -- Atomic_Integer_64 --
   -----------------------

   type Atomic_Integer_64 is new
      Turbo_Private.Atomic_Integer_64_Package.Atomic_Type_64;

   -- workaround for Limited_Problem
   function Create (Item : Integer_64) return Atomic_Integer_64;
   pragma Inline (Create);

   function Lazy_Create (Item : Integer_64) return Atomic_Integer_64;
   pragma Inline (Lazy_Create);

   function "+" (Item : Integer_64) return Atomic_Integer_64
      renames Lazy_Create;
   pragma Inline ("+");

   function Inc_Get (Addend : not null access Atomic_Integer_64)
      return Integer_64;
   function Get_Inc (Addend : not null access Atomic_Integer_64)
      return Integer_64;
   procedure Inc (Addend : in out Atomic_Integer_64);
   procedure Inc (Addend : not null access Atomic_Integer_64);

   function Inc_Get (Addend : not null access Atomic_Integer_64;
      Item : Integer_64) return Integer_64;
   function Get_Inc (Addend : not null access Atomic_Integer_64;
      Item : Integer_64) return Integer_64;
   procedure Inc (Addend : in out Atomic_Integer_64;
      Item : Integer_64);
   procedure Inc (Addend : not null access Atomic_Integer_64;
      Item : Integer_64);

   function Dec_Get (Addend : not null access Atomic_Integer_64)
      return Integer_64;
   function Get_Dec (Addend : not null access Atomic_Integer_64)
      return Integer_64;
   procedure Dec (Addend : in out Atomic_Integer_64);
   procedure Dec (Addend : not null access Atomic_Integer_64);

   function Dec_Get (Addend : not null access Atomic_Integer_64;
      Item : Integer_64) return Integer_64;
   function Get_Dec (Addend : not null access Atomic_Integer_64;
      Item : Integer_64) return Integer_64;
   procedure Dec (Addend : in out Atomic_Integer_64;
      Item : Integer_64);
   procedure Dec (Addend : not null access Atomic_Integer_64;
      Item : Integer_64);

   ------------------------
   -- Atomic_Unsigned_64 --
   ------------------------

   type Atomic_Unsigned_64 is new
      Turbo_Private.Atomic_Unsigned_64_Package.Atomic_Type_64;

   -- workaround for Limited_Problem
   function Create (Item : Unsigned_64) return Atomic_Unsigned_64;
   pragma Inline (Create);

   function Lazy_Create (Item : Unsigned_64) return Atomic_Unsigned_64;
   pragma Inline (Lazy_Create);

   function "+" (Item : Unsigned_64) return Atomic_Unsigned_64
      renames Lazy_Create;
   pragma Inline ("+");

   function Inc_Get (Addend : not null access Atomic_Unsigned_64)
      return Unsigned_64;
   function Get_Inc (Addend : not null access Atomic_Unsigned_64)
      return Unsigned_64;
   procedure Inc (Addend : in out Atomic_Unsigned_64);
   procedure Inc (Addend : not null access Atomic_Unsigned_64);

   function Inc_Get (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64) return Unsigned_64;
   function Get_Inc (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64) return Unsigned_64;
   procedure Inc (Addend : in out Atomic_Unsigned_64;
      Item : Unsigned_64);
   procedure Inc (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64);

   pragma Inline (Inc_Get, Get_Inc, Inc);

   function Dec_Get (Addend : not null access Atomic_Unsigned_64)
      return Unsigned_64;
   function Get_Dec (Addend : not null access Atomic_Unsigned_64)
      return Unsigned_64;
   procedure Dec (Addend : in out Atomic_Unsigned_64);
   procedure Dec (Addend : not null access Atomic_Unsigned_64);

   function Dec_Get (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64) return Unsigned_64;
   function Get_Dec (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64) return Unsigned_64;
   procedure Dec (Addend : in out Atomic_Unsigned_64;
      Item : Unsigned_64);
   procedure Dec (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64);

   pragma Inline (Dec_Get, Get_Dec, Dec);

   procedure Do_And (Addend : in out Atomic_Unsigned_64;
      Item : Unsigned_64);
   procedure Do_And (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64);

   procedure Do_Or (Addend : in out Atomic_Unsigned_64;
      Item : Unsigned_64);
   procedure Do_Or (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64);

   procedure Do_Xor (Addend : in out Atomic_Unsigned_64;
      Item : Unsigned_64);
   procedure Do_Xor (Addend : not null access Atomic_Unsigned_64;
      Item : Unsigned_64);

   pragma Inline (Do_And, Do_Or, Do_Xor);

   -------------------------
   -- Atomic_Integer_Addr --
   -------------------------

   type Atomic_Integer_Addr is new
      Turbo_Private.Atomic_Integer_Addr_Package.Atomic_Type_32;

   -- workaround for Limited_Problem
   function Create (Item : Integer_Addr) return Atomic_Integer_Addr;
   pragma Inline (Create);

   function Lazy_Create (Item : Integer_Addr) return Atomic_Integer_Addr;
   pragma Inline (Lazy_Create);

   function "+" (Item : Integer_Addr) return Atomic_Integer_Addr
      renames Lazy_Create;
   pragma Inline ("+");

   function Inc_Get (Addend : not null access Atomic_Integer_Addr)
      return Integer_Addr;
   function Get_Inc (Addend : not null access Atomic_Integer_Addr)
      return Integer_Addr;
   procedure Inc (Addend : in out Atomic_Integer_Addr);
   procedure Inc (Addend : not null access Atomic_Integer_Addr);

   function Inc_Get (Addend : not null access Atomic_Integer_Addr;
      Item : Integer_Addr) return Integer_Addr;
   function Get_Inc (Addend : not null access Atomic_Integer_Addr;
      Item : Integer_Addr) return Integer_Addr;
   procedure Inc (Addend : in out Atomic_Integer_Addr;
      Item : Integer_Addr);
   procedure Inc (Addend : not null access Atomic_Integer_Addr;
      Item : Integer_Addr);

   function Dec_Get (Addend : not null access Atomic_Integer_Addr)
      return Integer_Addr;
   function Get_Dec (Addend : not null access Atomic_Integer_Addr)
      return Integer_Addr;
   procedure Dec (Addend : in out Atomic_Integer_Addr);
   procedure Dec (Addend : not null access Atomic_Integer_Addr);

   function Dec_Get (Addend : not null access Atomic_Integer_Addr;
      Item : Integer_Addr) return Integer_Addr;
   function Get_Dec (Addend : not null access Atomic_Integer_Addr;
      Item : Integer_Addr) return Integer_Addr;
   procedure Dec (Addend : in out Atomic_Integer_Addr;
      Item : Integer_Addr);
   procedure Dec (Addend : not null access Atomic_Integer_Addr;
      Item : Integer_Addr);

   --------------------------
   -- Atomic_Unsigned_Addr --
   --------------------------

   type Atomic_Unsigned_Addr is new
      Turbo_Private.Atomic_Unsigned_Addr_Package.Atomic_Type_32;

   -- workaround for Limited_Problem
   function Create (Item : Unsigned_Addr) return Atomic_Unsigned_Addr;
   pragma Inline (Create);

   function Lazy_Create (Item : Unsigned_Addr) return Atomic_Unsigned_Addr;
   pragma Inline (Lazy_Create);

   function "+" (Item : Unsigned_Addr) return Atomic_Unsigned_Addr
      renames Lazy_Create;
   pragma Inline ("+");

   function Inc_Get (Addend : not null access Atomic_Unsigned_Addr)
      return Unsigned_Addr;
   function Get_Inc (Addend : not null access Atomic_Unsigned_Addr)
      return Unsigned_Addr;
   procedure Inc (Addend : in out Atomic_Unsigned_Addr);
   procedure Inc (Addend : not null access Atomic_Unsigned_Addr);

   function Inc_Get (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr) return Unsigned_Addr;
   function Get_Inc (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr) return Unsigned_Addr;
   procedure Inc (Addend : in out Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);
   procedure Inc (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);

   pragma Inline (Inc_Get, Get_Inc, Inc);

   function Dec_Get (Addend : not null access Atomic_Unsigned_Addr)
      return Unsigned_Addr;
   function Get_Dec (Addend : not null access Atomic_Unsigned_Addr)
      return Unsigned_Addr;
   procedure Dec (Addend : in out Atomic_Unsigned_Addr);
   procedure Dec (Addend : not null access Atomic_Unsigned_Addr);

   function Dec_Get (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr) return Unsigned_Addr;
   function Get_Dec (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr) return Unsigned_Addr;
   procedure Dec (Addend : in out Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);
   procedure Dec (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);

   pragma Inline (Dec_Get, Get_Dec, Dec);

   procedure Do_And (Addend : in out Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);
   procedure Do_And (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);

   procedure Do_Or (Addend : in out Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);
   procedure Do_Or (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);

   procedure Do_Xor (Addend : in out Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);
   procedure Do_Xor (Addend : not null access Atomic_Unsigned_Addr;
      Item : Unsigned_Addr);

   pragma Inline (Do_And, Do_Or, Do_Xor);

end Turbo_Private.Atomic;
