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

-- no 386 support due to Atomic_Problem

with System.Machine_Code, Ada.Characters.Latin_1,
   Interfaces, Turbo_Private.CPUID, Ada.Unchecked_Conversion;

use  System.Machine_Code, Ada.Characters.Latin_1,
   Interfaces, Turbo_Private.CPUID;

-- Turbo_Private.Generic_Atomic_32, x86 version

package body Turbo_Private.Generic_Atomic_64 is

   type Split_Type_64 is record
      Low  : Unsigned_32;
      High : Unsigned_32;
   end record;
   
   for Split_Type_64'Size use 64;
   for Split_Type_64'Alignment use 8;

   function Split is new Ada.Unchecked_Conversion
     (Source => Type_64,
      Target => Split_Type_64);

   function Merge is new Ada.Unchecked_Conversion
     (Source => Split_Type_64,
      Target => Type_64);   

   ---------
   -- Get --
   ---------

   function Get (Source : in Atomic_Type_64)
      return Type_64
   is
      -- circumvent Source's read-onlyness
      Item : Type_64;
      for Item'Address use Source.Item'Address;
      pragma Import (Ada, Item); -- suppress initialization
      Fetched, Result : Type_64;
   begin
      Fetched := Source.Item;
      Asm (
         "1: "                         &
         "movl %%eax, %%ebx"           & LF & HT &
         "movl %%edx, %%ecx"           & LF & HT &
         "lock cmpxchg8b %0"           & LF & HT &
         "jne 1b",
         Outputs  => (Type_64'Asm_Output ("+m", Item),
                      Type_64'Asm_Output ("=A", Result)),
         Inputs   => Type_64'Asm_Input ("A", Fetched),
         Clobber  => "ebx, ecx",
         Volatile => True
      );
      return Result;
   end Get;

   ---------
   -- Get --
   ---------

   function Get (Source : not null access Atomic_Type_64)
      return Type_64
   is
      Fetched, Result : Type_64;
   begin
      Fetched := Source.Item;
      Asm (
         "1: "                         &
         "movl %%eax, %%ebx"           & LF & HT &
         "movl %%edx, %%ecx"           & LF & HT &
         "lock cmpxchg8b %0"           & LF & HT &
         "jne 1b",
         Outputs  => (Type_64'Asm_Output ("+m", Source.Item),
                      Type_64'Asm_Output ("=A", Result)),
         Inputs   => Type_64'Asm_Input ("A", Fetched),
         Clobber  => "ebx, ecx",
         Volatile => True
      );
      return Result;
   end Get;

   --------------
   -- Lazy_Get --
   --------------

   function Lazy_Get (Source : in Atomic_Type_64)
      return Type_64 is
   begin
      return Get (Source);
   end Lazy_Get;

   --------------
   -- Lazy_Get --
   --------------

   function Lazy_Get (Source : not null access Atomic_Type_64)
      return Type_64 is
   begin
      return Get (Source);
   end Lazy_Get;

   ---------
   -- Set --
   ---------

   procedure Set (Target : not null access Atomic_Type_64;
      Item : Type_64)
   is
      Dummy : Type_64;
      Fetched : Type_64;
      Split_Item : constant Split_Type_64 := Split (Item);
   begin
      Fetched := Target.Item;
      Asm (
         "1: "                         &
         "lock cmpxchg8b %0"           & LF & HT &
         "jne 1b",
         Outputs  => (Type_64'Asm_Output ("+m", Target.Item),
                      Type_64'Asm_Output ("=A", Dummy)),
         Inputs   => (Type_64'Asm_Input ("A", Fetched),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
   end Set;

   ---------
   -- Set --
   ---------

   procedure Set (Target : in out Atomic_Type_64;
      Item : Type_64)
   is
      Dummy : Type_64;
      Fetched : Type_64;
      Split_Item : constant Split_Type_64 := Split (Item);
   begin
      Fetched := Target.Item;
      Asm (
         "1: "                         &
         "lock cmpxchg8b %0"           & LF & HT &
         "jne 1b",
         Outputs  => (Type_64'Asm_Output ("+m", Target.Item),
                      Type_64'Asm_Output ("=A", Dummy)),
         Inputs   => (Type_64'Asm_Input ("A", Fetched),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
   end Set;

   --------------
   -- Lazy_Set --
   --------------

   procedure Lazy_Set (Target : not null access Atomic_Type_64;
      Item : Type_64) is
   begin
      Set (Target, Item);
   end Lazy_Set;

   --------------
   -- Lazy_Set --
   --------------

   procedure Lazy_Set (Target : in out Atomic_Type_64;
      Item : Type_64) is
   begin
      Set (Target, Item);
   end Lazy_Set;

   ------------
   -- Create --
   ------------

   function Create (Item : Type_64) return Atomic_Type_64 is
   begin
      return Result : Atomic_Type_64 do
         Set (Result, Item);
      end return;
   end Create;

   -----------------
   -- Lazy_Create --
   -----------------

   function Lazy_Create (Item : Type_64) return Atomic_Type_64 is
   begin
      return Result : Atomic_Type_64 do
         Set (Result, Item);
      end return;
   end Lazy_Create;

   ----------
   -- Swap --
   ----------

   function Swap (Target : not null access Atomic_Type_64;
      Item : Type_64) return Type_64
   is
      Result, Fetched : Type_64;
      Split_Item : constant Split_Type_64 := Split (Item);
   begin
      Fetched := Target.Item;
      Asm (
         "1: "                         &
         "lock cmpxchg8b %0"           & LF & HT &
         "jne 1b",
         Outputs  => (Type_64'Asm_Output ("+m", Target.Item),
                      Type_64'Asm_Output ("=A", Result)),
         Inputs   => (Type_64'Asm_Input ("A", Fetched),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
      return Result;
   end Swap;

   ------------------
   -- Compare_Swap --
   ------------------
   
   function Compare_Swap (Target : not null access Atomic_Type_64;
      Comparand, New_Item : Type_64) return Boolean
   is
      Dummy : Type_64;
      Result : Boolean;
      Split_Item : constant Split_Type_64 := Split (New_Item);
   begin
      Asm (
         "lock cmpxchg8b %0"           & LF & HT &
         "setzb %2",
         Outputs  => (Type_64'Asm_Output ("+m", Target.Item),
                      Type_64'Asm_Output ("=A", Dummy),
                      Boolean'Asm_Output ("=rm", Result)),
         Inputs   => (Type_64'Asm_Input ("A", Comparand),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
      return Result;
   end Compare_Swap;

   ------------------
   -- Compare_Swap --
   ------------------

   -- internal
   function Compare_Swap (Target : not null access Type_64;
      Comparand, New_Item : Type_64) return Type_64
   is
      Result : Type_64;
      Split_Item : constant Split_Type_64 := Split (New_Item);
   begin
      Asm (
         "lock cmpxchg8b %0",
         Outputs  => (Type_64'Asm_Output ("+m", Target.all),
                      Type_64'Asm_Output ("=A", Result)),
         Inputs   => (Type_64'Asm_Input ("A", Comparand),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
      return Result;
   end Compare_Swap;

   ------------------
   -- Compare_Swap --
   ------------------

   function Compare_Swap (Target : not null access Atomic_Type_64;
      Comparand, New_Item : Type_64) return Type_64
   is
      Result : Type_64;
      Split_Item : constant Split_Type_64 := Split (New_Item);
   begin
      Asm (
         "lock cmpxchg8b %0",
         Outputs  => (Type_64'Asm_Output ("+m", Target.Item),
                      Type_64'Asm_Output ("=A", Result)),
         Inputs   => (Type_64'Asm_Input ("A", Comparand),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
      return Result;
   end Compare_Swap;

   ------------------
   -- Compare_Swap --
   ------------------

   function Compare_Swap (Target : not null access Atomic_Type_64;
      Comparand, New_Item : Type_64; Fetched : not null access Type_64)
      return Boolean
   is
      Result : Boolean;
      Split_Item : constant Split_Type_64 := Split (New_Item);
   begin
      Asm (
         "lock cmpxchg8b %0"           & LF & HT &
         "setzb %2",
         Outputs  => (Type_64'Asm_Output ("+m", Target.Item),
                      Type_64'Asm_Output ("=A", Fetched.all),
                      Boolean'Asm_Output ("=rm", Result)),
         Inputs   => (Type_64'Asm_Input ("A", Comparand),
                      Unsigned_32'Asm_Input ("b", Split_Item.Low),
                      Unsigned_32'Asm_Input ("c", Split_Item.High)),
         Volatile => True
      );
      return Result;
   end Compare_Swap;

end Turbo_Private.Generic_Atomic_64;
