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

-- Turbo_Private.Atomic, x86 version

-- TODO: CPUID
-- 486+ is expected currently
-- Does anybody program in Ada on 386? 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

-- Fetch -> Get
-- Store -> Set
-- Exchange -> Swap


with System, Interfaces;

use System, Interfaces;

package Turbo_Private.Atomic is
   pragma Preelaborate;

   type Atomic_Integer_32 is limited private;

   type Atomic_Unsigned_32 is limited private;

   -- Improperly aligned 32bit values can actually be
   -- handled in an atomic way via cmpxchg8b
   -- I don't want to bother with these cases

   -- procedure Memory_Barrier;

   function Get (Source : in Atomic_Integer_32)
      return Integer_32;
   function Get (Source : not null access Atomic_Integer_32)
      return Integer_32;

   procedure Set (Target : not null access Atomic_Integer_32;
      Item : Integer_32);
   procedure Set (Target : in out Atomic_Integer_32;
      Item : Integer_32);

   function Create (Item : Integer_32) return Atomic_Integer_32;

   function Swap (Target : not null access Atomic_Integer_32;
      Item : Integer_32) return Integer_32;
   
   function Compare_Swap (Target : not null access Atomic_Integer_32;
      Comparand, New_Item : Integer_32) return Boolean;
   function Compare_Swap (Target : not null access Atomic_Integer_32;
      Comparand, New_Item : Integer_32) return Integer_32;
   function Compare_Swap (Target : not null access Atomic_Integer_32;
      Comparand, New_Item : Integer_32; Fetched : not null access Integer_32)
      return Boolean;

   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);

private

   type Atomic_Integer_32 is limited record
      Item : aliased Integer_32;
      pragma Atomic (Item);
   end record;
   
   for Atomic_Integer_32'Size use 32;
   for Atomic_Integer_32'Alignment use 4;

   type Atomic_Unsigned_32 is limited record
      Item : aliased Unsigned_32;
      pragma Atomic (Item);
   end record;

   for Atomic_Unsigned_32'Size use 32;
   for Atomic_Unsigned_32'Alignment use 4;

end Turbo_Private.Atomic;
