Patchwork [Ada] Optimization of the Lock-free implementation of protected object

login
register
mail settings
Submitter Arnaud Charlet
Date July 12, 2012, 10:43 a.m.
Message ID <20120712104340.GA18806@adacore.com>
Download mbox | patch
Permalink /patch/170635/
State New
Headers show

Comments

Arnaud Charlet - July 12, 2012, 10:43 a.m.
The optimization of the expansion of protected procedure for the lock-free
implementation brings the following changes:
- Several renamings in order to match GCC built-in function wordings.
- Expected_Comp declaration moved to the the declarations list of the procedure
- GCC built-in operation__sync_bool_compare_and_swap replaced by
  __sync_val_compare_and_swap.
- Don't use an atomic compare and swap if Expected_Comp = Desired_Comp

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-07-12  Vincent Pucci  <pucci@adacore.com>

	* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
	Atomic_Load_N replaced by Lock_Free_Read_N. Atomic_Compare_Exchange_N
	replaced by Lock_Free_Try_Write_N.
	Renaming of several local variables. For
	procedure, Expected_Comp declaration moved to the declaration
	list of the procedure.
	* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
	RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
	RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
	RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64,
	RE_Atomic_Synchronize, RE_Relaxed removed.  RE_Lock_Free_Read_8,
	RE_Lock_Free_Read_16, RE_Lock_Free_Read_32, RE_Lock_Free_Read_64,
	RE_Lock_Free_Try_Write_8, RE_Lock_Free_Try_Write_16,
	RE_Lock_Free_Try_Write_32, RE_Lock_Free_Try_Write_64 added.
	* s-atopri.adb: New file.
	* s-atopri.ads (Atomic_Compare_Exchange_8): Renaming of
	parameters.  Import primitive __sync_val_compare_and_swap_1.
	(Atomic_Compare_Exchange_16): Renaming of parameters.
	Import primitive __sync_val_compare_and_swap_2.
	(Atomic_Compare_Exchange_32): Renaming of parameters.
	Import primitive __sync_val_compare_and_swap_4.
	(Atomic_Compare_Exchange_64): Renaming of parameters.  Import
	primitive __sync_val_compare_and_swap_8.
	(Atomic_Load_8): Ptr renames parameter X.
	(Atomic_Load_16): Ptr renames parameter X.
	(Atomic_Load_32): Ptr renames parameter X.
	(Atomic_Load_64): Ptr renames parameter X.
	(Lock_Free_Read_8): New routine.
	(Lock_Free_Read_16): New routine.
	(Lock_Free_Read_32): New routine.
	(Lock_Free_Read_64): New routine.
	(Lock_Free_Try_Write_8): New routine.
	(Lock_Free_Try_Write_16): New routine.
	(Lock_Free_Try_Write_32): New routine.
	(Lock_Free_Try_Write_64): New routine.
Iain Sandoe - July 16, 2012, 4:54 p.m.
Hello Arnaud,

On 12 Jul 2012, at 11:43, Arnaud Charlet wrote:

> The optimization of the expansion of protected procedure for the lock-free
> implementation brings the following changes:
> - Several renamings in order to match GCC built-in function wordings.
> - Expected_Comp declaration moved to the the declarations list of the procedure
> - GCC built-in operation__sync_bool_compare_and_swap replaced by
>  __sync_val_compare_and_swap.
> - Don't use an atomic compare and swap if Expected_Comp = Desired_Comp
> 
> Tested on x86_64-pc-linux-gnu, committed on trunk
> 
> 2012-07-12  Vincent Pucci  <pucci@adacore.com>
> 
> 	* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
> 	Atomic_Load_N replaced by Lock_Free_Read_N. Atomic_Compare_Exchange_N
> 	replaced by Lock_Free_Try_Write_N.
> 	Renaming of several local variables. For
> 	procedure, Expected_Comp declaration moved to the declaration
> 	list of the procedure.
> 	* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
> 	RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
> 	RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
> 	RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64,
> 	RE_Atomic_Synchronize, RE_Relaxed removed.  RE_Lock_Free_Read_8,
> 	RE_Lock_Free_Read_16, RE_Lock_Free_Read_32, RE_Lock_Free_Read_64,
> 	RE_Lock_Free_Try_Write_8, RE_Lock_Free_Try_Write_16,
> 	RE_Lock_Free_Try_Write_32, RE_Lock_Free_Try_Write_64 added.
> 	* s-atopri.adb: New file.
> 	* s-atopri.ads (Atomic_Compare_Exchange_8): Renaming of
> 	parameters.  Import primitive __sync_val_compare_and_swap_1.
> 	(Atomic_Compare_Exchange_16): Renaming of parameters.
> 	Import primitive __sync_val_compare_and_swap_2.
> 	(Atomic_Compare_Exchange_32): Renaming of parameters.
> 	Import primitive __sync_val_compare_and_swap_4.
> 	(Atomic_Compare_Exchange_64): Renaming of parameters.  Import
> 	primitive __sync_val_compare_and_swap_8.
> 	(Atomic_Load_8): Ptr renames parameter X.
> 	(Atomic_Load_16): Ptr renames parameter X.
> 	(Atomic_Load_32): Ptr renames parameter X.
> 	(Atomic_Load_64): Ptr renames parameter X.
> 	(Lock_Free_Read_8): New routine.
> 	(Lock_Free_Read_16): New routine.
> 	(Lock_Free_Read_32): New routine.
> 	(Lock_Free_Read_64): New routine.
> 	(Lock_Free_Try_Write_8): New routine.
> 	(Lock_Free_Try_Write_16): New routine.
> 	(Lock_Free_Try_Write_32): New routine.
> 	(Lock_Free_Try_Write_64): New routine.

http://gcc.gnu.org/ml/gcc-cvs/2012-07/msg00341.html

This breaks ada bootstrap on powerpc-darwin9 with :
 Undefined symbols:
  "___sync_val_compare_and_swap_8", referenced from:
      _system__atomic_primitives__lock_free_try_write_64 in s-atopri.o
  "___atomic_load_8", referenced from:
      _system__atomic_primitives__lock_free_read_64 in s-atopri.o
ld: symbol(s) not found

(and, I assume any other target without __sync_val_compare_and_swap_8 builtin or library fall-back).

If you think this is a target bug, let me know and I'll try and delve further.
thanks
Iain
Arnaud Charlet - July 16, 2012, 5:46 p.m.
> http://gcc.gnu.org/ml/gcc-cvs/2012-07/msg00341.html
> 
> This breaks ada bootstrap on powerpc-darwin9 with :
>  Undefined symbols:
>   "___sync_val_compare_and_swap_8", referenced from:
>       _system__atomic_primitives__lock_free_try_write_64 in
>       s-atopri.o
>   "___atomic_load_8", referenced from:
>       _system__atomic_primitives__lock_free_read_64 in s-atopri.o
> ld: symbol(s) not found
> 
> (and, I assume any other target without __sync_val_compare_and_swap_8
> builtin or library fall-back).

Right. We are working on a patch to fix this issue, so this should be
addressed soon, thanks for the note!

Arno

Patch

Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 189436)
+++ exp_ch9.adb	(working copy)
@@ -2955,30 +2955,40 @@ 
    --  manner:
 
    --    procedure P (...) is
+   --       Expected_Comp : constant Comp_Type :=
+   --                         Comp_Type
+   --                           (System.Atomic_Primitives.Lock_Free_Read_N
+   --                              (_Object.Comp'Address));
    --    begin
    --       loop
    --          declare
    --             <original declarations before the object renaming declaration
    --              of Comp>
-   --             Saved_Comp   : constant ... :=
-   --                              Atomic_Load (_Object.Comp'Address, Relaxed);
-   --             Current_Comp : ... := Saved_Comp;
-   --             Comp         : Comp_Type renames Current_Comp;
+   --
+   --             Desired_Comp : Comp_Type := Expected_Comp;
+   --             Comp         : Comp_Type renames Desired_Comp;
+   --
    --             <original delarations after the object renaming declaration
    --              of Comp>
+   --
    --          begin
    --             <original statements>
-   --             exit when Atomic_Compare
-   --                         (_Object.Comp, Saved_Comp, Current_Comp);
+   --             exit when System.Atomic_Primitives.Lock_Free_Try_Write_N
+   --                         (_Object.Comp'Address,
+   --                          Interfaces.Unsigned_N (Expected_Comp),
+   --                          Interfaces.Unsigned_N (Desired_Comp));
    --          end;
-   --          <<L0>>
    --       end loop;
    --    end P;
 
    --  Each return and raise statement of P is transformed into an atomic
    --  status check:
 
-   --    if Atomic_Compare (_Object.Comp, Saved_Comp, Current_Comp) then
+   --    if System.Atomic_Primitives.Lock_Free_Try_Write_N
+   --         (_Object.Comp'Address,
+   --          Interfaces.Unsigned_N (Expected_Comp),
+   --          Interfaces.Unsigned_N (Desired_Comp));
+   --    then
    --       <original statement>
    --    else
    --       goto L0;
@@ -2991,10 +3001,16 @@ 
    --    function F (...) return ... is
    --       <original declarations before the object renaming declaration
    --        of Comp>
-   --       Saved_Comp : constant ... := Atomic_Load (_Object.Comp'Address);
-   --       Comp       : Comp_Type renames Saved_Comp;
+   --
+   --       Expected_Comp : constant Comp_Type :=
+   --                         Comp_Type
+   --                           (System.Atomic_Primitives.Lock_Free_Read_N
+   --                              (_Object.Comp'Address));
+   --       Comp          : Comp_Type renames Expected_Comp;
+   --
    --       <original delarations after the object renaming declaration of
    --        Comp>
+   --
    --    begin
    --       <original statements>
    --    end F;
@@ -3003,11 +3019,6 @@ 
      (N        : Node_Id;
       Prot_Typ : Node_Id) return Node_Id
    is
-      Is_Procedure : constant Boolean    :=
-                       Ekind (Corresponding_Spec (N)) = E_Procedure;
-      Loc          : constant Source_Ptr := Sloc (N);
-      Label_Id     : Entity_Id := Empty;
-
       function Referenced_Component (N : Node_Id) return Entity_Id;
       --  Subprograms which meet the lock-free implementation criteria are
       --  allowed to reference only one unique component. Return the prival
@@ -3068,9 +3079,10 @@ 
 
       --  Local variables
 
-      Comp          : constant Entity_Id := Referenced_Component (N);
-      Hand_Stmt_Seq : Node_Id            := Handled_Statement_Sequence (N);
-      Decls         : List_Id            := Declarations (N);
+      Comp          : constant Entity_Id  := Referenced_Component (N);
+      Loc           : constant Source_Ptr := Sloc (N);
+      Hand_Stmt_Seq : Node_Id             := Handled_Statement_Sequence (N);
+      Decls         : List_Id             := Declarations (N);
 
    --  Start of processing for Build_Lock_Free_Unprotected_Subprogram_Body
 
@@ -3088,20 +3100,25 @@ 
             Comp_Decl    : constant Node_Id   := Parent (Comp);
             Comp_Sel_Nam : constant Node_Id   := Name (Comp_Decl);
             Comp_Type    : constant Entity_Id := Etype (Comp);
-            Block_Decls  : List_Id;
-            Compare      : Entity_Id;
-            Current_Comp : Entity_Id;
-            Decl         : Node_Id;
-            Label        : Node_Id;
-            Load         : Entity_Id;
-            Load_Params  : List_Id;
-            Saved_Comp   : Entity_Id;
-            Stmt         : Node_Id;
-            Stmts        : List_Id :=
-                             New_Copy_List (Statements (Hand_Stmt_Seq));
-            Typ_Size     : Int;
-            Unsigned     : Entity_Id;
 
+            Is_Procedure : constant Boolean :=
+                             Ekind (Corresponding_Spec (N)) = E_Procedure;
+            --  Indicates if N is a protected procedure body
+
+            Block_Decls   : List_Id;
+            Try_Write     : Entity_Id;
+            Desired_Comp  : Entity_Id;
+            Decl          : Node_Id;
+            Label         : Node_Id;
+            Label_Id      : Entity_Id := Empty;
+            Read          : Entity_Id;
+            Expected_Comp : Entity_Id;
+            Stmt          : Node_Id;
+            Stmts         : List_Id :=
+                              New_Copy_List (Statements (Hand_Stmt_Seq));
+            Typ_Size      : Int;
+            Unsigned      : Entity_Id;
+
             function Process_Node (N : Node_Id) return Traverse_Result;
             --  Transform a single node if it is a return statement, a raise
             --  statement or a reference to Comp.
@@ -3110,10 +3127,10 @@ 
             --  Given a statement sequence Stmts, wrap any return or raise
             --  statements in the following manner:
             --
-            --    if System.Atomic_Primitives.Atomic_Compare_Exchange
-            --         (Comp'Address,
-            --          Interfaces.Unsigned (Saved_Comp),
-            --          Interfaces.Unsigned (Current_Comp))
+            --    if System.Atomic_Primitives.Lock_Free_Try_Write_N
+            --         (_Object.Comp'Address,
+            --          Interfaces.Unsigned_N (Expected_Comp),
+            --          Interfaces.Unsigned_N (Desired_Comp))
             --    then
             --       <Stmt>;
             --    else
@@ -3149,10 +3166,10 @@ 
 
                   --  Generate:
 
-                  --    if System.Atomic_Primitives.Atomic_Compare_Exchange
-                  --         (Comp'Address,
-                  --          Interfaces.Unsigned (Saved_Comp),
-                  --          Interfaces.Unsigned (Current_Comp))
+                  --    if System.Atomic_Primitives.Lock_Free_Try_Write_N
+                  --         (_Object.Comp'Address,
+                  --          Interfaces.Unsigned_N (Expected_Comp),
+                  --          Interfaces.Unsigned_N (Desired_Comp))
                   --    then
                   --       <Stmt>;
                   --    else
@@ -3164,17 +3181,17 @@ 
                       Condition =>
                         Make_Function_Call (Loc,
                           Name                   =>
-                            New_Reference_To (Compare, Loc),
+                            New_Reference_To (Try_Write, Loc),
                           Parameter_Associations => New_List (
                             Make_Attribute_Reference (Loc,
                               Prefix         => Relocate_Node (Comp_Sel_Nam),
                               Attribute_Name => Name_Address),
 
                             Unchecked_Convert_To (Unsigned,
-                              New_Reference_To (Saved_Comp, Loc)),
+                              New_Reference_To (Expected_Comp, Loc)),
 
                             Unchecked_Convert_To (Unsigned,
-                              New_Reference_To (Current_Comp, Loc)))),
+                              New_Reference_To (Desired_Comp, Loc)))),
 
                       Then_Statements => New_List (Relocate_Node (Stmt)),
 
@@ -3253,67 +3270,53 @@ 
 
             case Typ_Size is
                when 8 =>
-                  Compare  := RTE (RE_Atomic_Compare_Exchange_8);
-                  Load     := RTE (RE_Atomic_Load_8);
-                  Unsigned := RTE (RE_Uint8);
+                  Try_Write := RTE (RE_Lock_Free_Try_Write_8);
+                  Read      := RTE (RE_Lock_Free_Read_8);
+                  Unsigned  := RTE (RE_Uint8);
 
                when 16 =>
-                  Compare  := RTE (RE_Atomic_Compare_Exchange_16);
-                  Load     := RTE (RE_Atomic_Load_16);
-                  Unsigned := RTE (RE_Uint16);
+                  Try_Write := RTE (RE_Lock_Free_Try_Write_16);
+                  Read      := RTE (RE_Lock_Free_Read_16);
+                  Unsigned  := RTE (RE_Uint16);
 
                when 32 =>
-                  Compare  := RTE (RE_Atomic_Compare_Exchange_32);
-                  Load     := RTE (RE_Atomic_Load_32);
-                  Unsigned := RTE (RE_Uint32);
+                  Try_Write := RTE (RE_Lock_Free_Try_Write_32);
+                  Read      := RTE (RE_Lock_Free_Read_32);
+                  Unsigned  := RTE (RE_Uint32);
 
                when 64 =>
-                  Compare  := RTE (RE_Atomic_Compare_Exchange_64);
-                  Load     := RTE (RE_Atomic_Load_64);
-                  Unsigned := RTE (RE_Uint64);
+                  Try_Write := RTE (RE_Lock_Free_Try_Write_64);
+                  Read      := RTE (RE_Lock_Free_Read_64);
+                  Unsigned  := RTE (RE_Uint64);
 
                when others =>
                   raise Program_Error;
             end case;
 
             --  Generate:
-            --    For functions:
 
-            --       Saved_Comp : constant Comp_Type :=
-            --                      Comp_Type (Atomic_Load (Comp'Address));
+            --  Expected_Comp : constant Comp_Type :=
+            --                    Comp_Type
+            --                      (System.Atomic_Primitives.Lock_Free_Read_N
+            --                         (_Object.Comp'Address));
 
-            --    For procedures:
-
-            --       Saved_Comp : constant Comp_Type :=
-            --                      Comp_Type (Atomic_Load (Comp'Address),
-            --                                             Relaxed);
-
-            Saved_Comp :=
+            Expected_Comp :=
               Make_Defining_Identifier (Loc,
                 New_External_Name (Chars (Comp), Suffix => "_saved"));
 
-            Load_Params := New_List (
-              Make_Attribute_Reference (Loc,
-                Prefix         => Relocate_Node (Comp_Sel_Nam),
-                Attribute_Name => Name_Address));
-
-            --  For protected procedures, set the memory model to be relaxed
-
-            if Is_Procedure then
-               Append_To (Load_Params,
-                 New_Reference_To (RTE (RE_Relaxed), Loc));
-            end if;
-
             Decl :=
               Make_Object_Declaration (Loc,
-                Defining_Identifier => Saved_Comp,
-                Constant_Present    => True,
+                Defining_Identifier => Expected_Comp,
                 Object_Definition   => New_Reference_To (Comp_Type, Loc),
+                Constant_Present    => True,
                 Expression          =>
                   Unchecked_Convert_To (Comp_Type,
                     Make_Function_Call (Loc,
-                      Name                   => New_Reference_To (Load, Loc),
-                      Parameter_Associations => Load_Params)));
+                      Name                   => New_Reference_To (Read, Loc),
+                      Parameter_Associations => New_List (
+                        Make_Attribute_Reference (Loc,
+                          Prefix         => Relocate_Node (Comp_Sel_Nam),
+                          Attribute_Name => Name_Address)))));
 
             --  Protected procedures
 
@@ -3322,37 +3325,35 @@ 
 
                Block_Decls := Decls;
 
-               --  Reset the declarations list of the protected procedure to be
-               --  an empty list.
+               --  Reset the declarations list of the protected procedure to
+               --  contain only Decl.
 
-               Decls := Empty_List;
+               Decls := New_List (Decl);
 
                --  Generate:
-               --    Current_Comp : Comp_Type := Saved_Comp;
+               --    Desired_Comp : Comp_Type := Expected_Comp;
 
-               Current_Comp :=
+               Desired_Comp :=
                  Make_Defining_Identifier (Loc,
                    New_External_Name (Chars (Comp), Suffix => "_current"));
 
-               --  Insert the declarations of Saved_Comp and Current_Comp in
+               --  Insert the declarations of Expected_Comp and Desired_Comp in
                --  the block declarations right before the renaming of the
                --  protected component.
 
-               Insert_Before (Comp_Decl, Decl);
-
                Insert_Before (Comp_Decl,
                  Make_Object_Declaration (Loc,
-                   Defining_Identifier => Current_Comp,
+                   Defining_Identifier => Desired_Comp,
                    Object_Definition   => New_Reference_To (Comp_Type, Loc),
                    Expression          =>
-                     New_Reference_To (Saved_Comp, Loc)));
+                     New_Reference_To (Expected_Comp, Loc)));
 
             --  Protected function
 
             else
-               Current_Comp := Saved_Comp;
+               Desired_Comp := Expected_Comp;
 
-               --  Insert the declaration of Saved_Comp in the function
+               --  Insert the declaration of Expected_Comp in the function
                --  declarations right before the renaming of the protected
                --  component.
 
@@ -3360,10 +3361,10 @@ 
             end if;
 
             --  Rewrite the protected component renaming declaration to be a
-            --  renaming of Current_Comp.
+            --  renaming of Desired_Comp.
 
             --  Generate:
-            --    Comp : Comp_Type renames Current_Comp;
+            --    Comp : Comp_Type renames Desired_Comp;
 
             Rewrite (Comp_Decl,
               Make_Object_Renaming_Declaration (Loc,
@@ -3372,7 +3373,7 @@ 
                 Subtype_Mark      =>
                   New_Occurrence_Of (Comp_Type, Loc),
                 Name              =>
-                  New_Reference_To (Current_Comp, Loc)));
+                  New_Reference_To (Desired_Comp, Loc)));
 
             --  Wrap any return or raise statements in Stmts in same the manner
             --  described in Process_Stmts.
@@ -3381,10 +3382,10 @@ 
 
             --  Generate:
 
-            --    exit when System.Atomic_Primitives.Atomic_Compare_Exchange
-            --                (Comp'Address,
-            --                 Interfaces.Unsigned (Saved_Comp),
-            --                 Interfaces.Unsigned (Current_Comp))
+            --    exit when System.Atomic_Primitives.Lock_Free_Try_Write_N
+            --                (_Object.Comp'Address,
+            --                 Interfaces.Unsigned_N (Expected_Comp),
+            --                 Interfaces.Unsigned_N (Desired_Comp))
 
             if Is_Procedure then
                Stmt :=
@@ -3392,17 +3393,17 @@ 
                    Condition =>
                      Make_Function_Call (Loc,
                        Name                   =>
-                         New_Reference_To (Compare, Loc),
+                         New_Reference_To (Try_Write, Loc),
                        Parameter_Associations => New_List (
                          Make_Attribute_Reference (Loc,
                            Prefix         => Relocate_Node (Comp_Sel_Nam),
                            Attribute_Name => Name_Address),
 
                          Unchecked_Convert_To (Unsigned,
-                           New_Reference_To (Saved_Comp, Loc)),
+                           New_Reference_To (Expected_Comp, Loc)),
 
                          Unchecked_Convert_To (Unsigned,
-                           New_Reference_To (Current_Comp, Loc)))));
+                           New_Reference_To (Desired_Comp, Loc)))));
 
                --  Small optimization: transform the default return statement
                --  of a procedure into the atomic exit statement.
@@ -3439,9 +3440,6 @@ 
             if Is_Procedure then
                Stmts :=
                  New_List (
-                   Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To (RTE (RE_Atomic_Synchronize), Loc)),
                    Make_Loop_Statement (Loc,
                      Statements => New_List (
                        Make_Block_Statement (Loc,
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 189431)
+++ rtsfind.ads	(working copy)
@@ -731,16 +731,14 @@ 
      RE_Assert_Failure,                  -- System.Assertions
      RE_Raise_Assert_Failure,            -- System.Assertions
 
-     RE_Atomic_Compare_Exchange_8,       -- System.Atomic_Primitives
-     RE_Atomic_Compare_Exchange_16,      -- System.Atomic_Primitives
-     RE_Atomic_Compare_Exchange_32,      -- System.Atomic_Primitives
-     RE_Atomic_Compare_Exchange_64,      -- System.Atomic_Primitives
-     RE_Atomic_Load_8,                   -- System.Atomic_Primitives
-     RE_Atomic_Load_16,                  -- System.Atomic_Primitives
-     RE_Atomic_Load_32,                  -- System.Atomic_Primitives
-     RE_Atomic_Load_64,                  -- System.Atomic_Primitives
-     RE_Atomic_Synchronize,              -- System.Atomic_Primitives
-     RE_Relaxed,                         -- System.Atomic_Primitives
+     RE_Lock_Free_Read_8,                -- System.Atomic_Primitives
+     RE_Lock_Free_Read_16,               -- System.Atomic_Primitives
+     RE_Lock_Free_Read_32,               -- System.Atomic_Primitives
+     RE_Lock_Free_Read_64,               -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_8,           -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_16,          -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_32,          -- System.Atomic_Primitives
+     RE_Lock_Free_Try_Write_64,          -- System.Atomic_Primitives
      RE_Uint8,                           -- System.Atomic_Primitives
      RE_Uint16,                          -- System.Atomic_Primitives
      RE_Uint32,                          -- System.Atomic_Primitives
@@ -1955,16 +1953,14 @@ 
      RE_Assert_Failure                   => System_Assertions,
      RE_Raise_Assert_Failure             => System_Assertions,
 
-     RE_Atomic_Compare_Exchange_8        => System_Atomic_Primitives,
-     RE_Atomic_Compare_Exchange_16       => System_Atomic_Primitives,
-     RE_Atomic_Compare_Exchange_32       => System_Atomic_Primitives,
-     RE_Atomic_Compare_Exchange_64       => System_Atomic_Primitives,
-     RE_Atomic_Load_8                    => System_Atomic_Primitives,
-     RE_Atomic_Load_16                   => System_Atomic_Primitives,
-     RE_Atomic_Load_32                   => System_Atomic_Primitives,
-     RE_Atomic_Load_64                   => System_Atomic_Primitives,
-     RE_Atomic_Synchronize               => System_Atomic_Primitives,
-     RE_Relaxed                          => System_Atomic_Primitives,
+     RE_Lock_Free_Read_8                 => System_Atomic_Primitives,
+     RE_Lock_Free_Read_16                => System_Atomic_Primitives,
+     RE_Lock_Free_Read_32                => System_Atomic_Primitives,
+     RE_Lock_Free_Read_64                => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_8            => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_16           => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_32           => System_Atomic_Primitives,
+     RE_Lock_Free_Try_Write_64           => System_Atomic_Primitives,
      RE_Uint8                            => System_Atomic_Primitives,
      RE_Uint16                           => System_Atomic_Primitives,
      RE_Uint32                           => System_Atomic_Primitives,
Index: s-atopri.adb
===================================================================
--- s-atopri.adb	(revision 0)
+++ s-atopri.adb	(revision 0)
@@ -0,0 +1,128 @@ 
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . A T O M I C _ P R I M I T I V E S            --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--              Copyright (C) 2012, Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body System.Atomic_Primitives is
+   ---------------------------
+   -- Lock_Free_Try_Write_8 --
+   ---------------------------
+
+   function Lock_Free_Try_Write_8
+      (Ptr       : Address;
+       Expected  : in out uint8;
+       Desired   : uint8) return Boolean
+   is
+      Actual : uint8;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_8 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_8;
+
+   ----------------------------
+   -- Lock_Free_Try_Write_16 --
+   ----------------------------
+
+   function Lock_Free_Try_Write_16
+      (Ptr       : Address;
+       Expected  : in out uint16;
+       Desired   : uint16) return Boolean
+   is
+      Actual : uint16;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_16 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_16;
+
+   ----------------------------
+   -- Lock_Free_Try_Write_32 --
+   ----------------------------
+
+   function Lock_Free_Try_Write_32
+      (Ptr       : Address;
+       Expected  : in out uint32;
+       Desired   : uint32) return Boolean
+   is
+      Actual : uint32;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_32 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_32;
+
+   ----------------------------
+   -- Lock_Free_Try_Write_64 --
+   ----------------------------
+
+   function Lock_Free_Try_Write_64
+      (Ptr       : Address;
+       Expected  : in out uint64;
+       Desired   : uint64) return Boolean
+   is
+      Actual : uint64;
+
+   begin
+      if Expected /= Desired then
+         Actual := Atomic_Compare_Exchange_64 (Ptr, Expected, Desired);
+
+         if Actual /= Expected then
+            Expected := Actual;
+            return False;
+         end if;
+      end if;
+
+      return True;
+   end Lock_Free_Try_Write_64;
+end System.Atomic_Primitives;
Index: s-atopri.ads
===================================================================
--- s-atopri.ads	(revision 189431)
+++ s-atopri.ads	(working copy)
@@ -29,11 +29,10 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package contains atomic primitives defined from gcc built-in functions
+--  This package contains both atomic primitives defined from gcc built-in
+--  functions and operations used by the compiler to generate the lock-free
+--  implementation of protected objects.
 
---  For now, these operations are only used by the compiler to generate the
---  lock-free implementation of protected objects.
-
 package System.Atomic_Primitives is
    pragma Preelaborate;
 
@@ -59,19 +58,24 @@ 
 
    subtype Mem_Model is Integer range Relaxed .. Last;
 
+   ------------------------------------
+   -- GCC built-in atomic primitives --
+   ------------------------------------
+
    function Atomic_Compare_Exchange_8
-     (X             : Address;
-      X_Old         : uint8;
-      X_Copy        : uint8) return Boolean;
+     (Ptr      : Address;
+      Expected : uint8;
+      Desired  : uint8) return uint8;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_8,
-                  "__sync_bool_compare_and_swap_1");
+                  "__sync_val_compare_and_swap_1");
 
    --  ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
    --  function Atomic_Compare_Exchange_8
-   --    (X             : Address;
-   --     X_Old         : Address;
-   --     X_Copy        : uint8;
+   --    (Ptr           : Address;
+   --     Expected      : Address;
+   --     Desired       : uint8;
+   --     Weak          : Boolean   := False;
    --     Success_Model : Mem_Model := Seq_Cst;
    --     Failure_Model : Mem_Model := Seq_Cst) return Boolean;
    --  pragma Import (Intrinsic,
@@ -79,49 +83,100 @@ 
    --                 "__atomic_compare_exchange_1");
 
    function Atomic_Compare_Exchange_16
-     (X             : Address;
-      X_Old         : uint16;
-      X_Copy        : uint16) return Boolean;
+     (Ptr      : Address;
+      Expected : uint16;
+      Desired  : uint16) return uint16;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_16,
-                  "__sync_bool_compare_and_swap_2");
+                  "__sync_val_compare_and_swap_2");
 
    function Atomic_Compare_Exchange_32
-     (X             : Address;
-      X_Old         : uint32;
-      X_Copy        : uint32) return Boolean;
+     (Ptr      : Address;
+      Expected : uint32;
+      Desired  : uint32) return uint32;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_32,
-                  "__sync_bool_compare_and_swap_4");
+                  "__sync_val_compare_and_swap_4");
 
    function Atomic_Compare_Exchange_64
-     (X             : Address;
-      X_Old         : uint64;
-      X_Copy        : uint64) return Boolean;
+     (Ptr      : Address;
+      Expected : uint64;
+      Desired  : uint64) return uint64;
    pragma Import (Intrinsic,
                   Atomic_Compare_Exchange_64,
-                  "__sync_bool_compare_and_swap_8");
+                  "__sync_val_compare_and_swap_8");
 
    function Atomic_Load_8
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint8;
    pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
 
    function Atomic_Load_16
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint16;
    pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
 
    function Atomic_Load_32
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint32;
    pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
 
    function Atomic_Load_64
-     (X     : Address;
+     (Ptr   : Address;
       Model : Mem_Model := Seq_Cst) return uint64;
    pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
 
-   procedure Atomic_Synchronize;
-   pragma Import (Intrinsic, Atomic_Synchronize, "__sync_synchronize");
+   --------------------------
+   -- Lock-free operations --
+   --------------------------
+
+   --  The lock-free implementation uses two atomic instructions for the
+   --  expansion of protected operations:
+
+   --  * Lock_Free_Read_N atomically loads the value of the protected component
+   --    accessed by the current protected operation.
+
+   --  * Lock_Free_Try_Write_N tries to write the the Desired value into Ptr
+   --    only if Expected and Desired mismatch.
+
+   function Lock_Free_Read_8 (Ptr : Address) return uint8 is
+     (Atomic_Load_8 (Ptr, Acquire));
+
+   function Lock_Free_Read_16 (Ptr : Address) return uint16 is
+      (Atomic_Load_16 (Ptr, Acquire));
+
+   function Lock_Free_Read_32 (Ptr : Address) return uint32 is
+      (Atomic_Load_32 (Ptr, Acquire));
+
+   function Lock_Free_Read_64 (Ptr : Address) return uint64 is
+      (Atomic_Load_64 (Ptr, Acquire));
+
+   function Lock_Free_Try_Write_8
+      (Ptr       : Address;
+       Expected  : in out uint8;
+       Desired   : uint8) return Boolean;
+
+   function Lock_Free_Try_Write_16
+      (Ptr       : Address;
+       Expected  : in out uint16;
+       Desired   : uint16) return Boolean;
+
+   function Lock_Free_Try_Write_32
+      (Ptr       : Address;
+       Expected  : in out uint32;
+       Desired   : uint32) return Boolean;
+
+   function Lock_Free_Try_Write_64
+      (Ptr       : Address;
+       Expected  : in out uint64;
+       Desired   : uint64) return Boolean;
+
+   pragma Inline (Lock_Free_Read_8);
+   pragma Inline (Lock_Free_Read_16);
+   pragma Inline (Lock_Free_Read_32);
+   pragma Inline (Lock_Free_Read_64);
+   pragma Inline (Lock_Free_Try_Write_8);
+   pragma Inline (Lock_Free_Try_Write_16);
+   pragma Inline (Lock_Free_Try_Write_32);
+   pragma Inline (Lock_Free_Try_Write_64);
 end System.Atomic_Primitives;