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 <pu...@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.
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;
