diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-12 10:33:23 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-12 10:33:23 +0000 |
commit | d0a9ea3b8db53d62a69562a2765b44df9197033c (patch) | |
tree | fb8c68ef22595e504bcebbd574dc5416017bbb2b /gcc/ada/exp_ch9.adb | |
parent | 9e6a9b40004161fc096e7017a523d25f050731ec (diff) | |
download | ppe42-gcc-d0a9ea3b8db53d62a69562a2765b44df9197033c.tar.gz ppe42-gcc-d0a9ea3b8db53d62a69562a2765b44df9197033c.zip |
2012-07-12 Thomas Quinot <quinot@adacore.com>
* s-bytswa.adb (Swapped2.Bswap16): Remove local function,
no longer needed.
2012-07-12 Javier Miranda <miranda@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): For
attributes 'access, 'unchecked_access and 'unrestricted_access,
iff the current instance reference is located in a protected
subprogram or entry then rewrite the access attribute to be the
name of the "_object" parameter.
2012-07-12 Tristan Gingold <gingold@adacore.com>
* raise.h: Revert previous patch: structure is used in init.c
by vms.
2012-07-12 Vincent Celier <celier@adacore.com>
* make.adb (Binding_Phase): If --subdirs was used, but not
-P, change the working directory to the specified subdirectory
before invoking gnatbind.
(Linking_Phase): If --subdirs was used, but not -P, change the working
directory to the specified subdirectory before invoking gnatlink.
2012-07-12 Vincent Pucci <pucci@adacore.com>
* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
For a procedure, instead of replacing each Comp reference by a
reference to Current_Comp, make a renaming Comp of Current_Comp
that rewrites the original renaming generated by the compiler
during the analysis. Move the declarations of the procedure
inside the generated block.
(Process_Stmts): Moved in the body
of Build_Lock_Free_Unprotected_Subprogram_Body.
(Process_Node):
Moved in the body of Build_Lock_Free_Unprotected_Subprogram_Body.
* sem_ch9.adb (Allows_Lock_Free_Implementation): Restrict any
non-elementary out parameters in protected procedures.
2012-07-12 Thomas Quinot <quinot@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
Scalar_Storage_Order): Attribute applies to base type only.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189435 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_ch9.adb')
-rw-r--r-- | gcc/ada/exp_ch9.adb | 387 |
1 files changed, 204 insertions, 183 deletions
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index e95db771798..bf1cbc48f23 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2955,26 +2955,30 @@ package body Exp_Ch9 is -- manner: -- procedure P (...) is - -- <original declarations> -- begin -- loop -- declare + -- <original declarations before the object renaming declaration + -- of Comp> -- Saved_Comp : constant ... := - -- Atomic_Load (Comp'Address, Relaxed); + -- Atomic_Load (_Object.Comp'Address, Relaxed); -- Current_Comp : ... := Saved_Comp; + -- Comp : Comp_Type renames Current_Comp; + -- <original delarations after the object renaming declaration + -- of Comp> -- begin -- <original statements> - -- exit when Atomic_Compare (Comp, Saved_Comp, Current_Comp); + -- exit when Atomic_Compare + -- (_Object.Comp, Saved_Comp, Current_Comp); -- end; -- <<L0>> -- end loop; -- end P; - -- References to Comp which appear in the original statements are replaced - -- with references to Current_Comp. Each return and raise statement of P is - -- transformed into an atomic status check: + -- Each return and raise statement of P is transformed into an atomic + -- status check: - -- if Atomic_Compare (Comp, Saved_Comp, Current_Comp) then + -- if Atomic_Compare (_Object.Comp, Saved_Comp, Current_Comp) then -- <original statement> -- else -- goto L0; @@ -2985,15 +2989,16 @@ package body Exp_Ch9 is -- manner: -- function F (...) return ... is - -- <original declarations> - -- Saved_Comp : constant ... := Atomic_Load (Comp'Address); + -- <original declarations before the object renaming declaration + -- of Comp> + -- Saved_Comp : constant ... := Atomic_Load (_Object.Comp'Address); + -- Comp : Comp_Type renames Saved_Comp; + -- <original delarations after the object renaming declaration of + -- Comp> -- begin -- <original statements> -- end F; - -- References to Comp which appear in the original statements are replaced - -- with references to Saved_Comp. - function Build_Lock_Free_Unprotected_Subprogram_Body (N : Node_Id; Prot_Typ : Node_Id) return Node_Id @@ -3003,162 +3008,11 @@ package body Exp_Ch9 is Loc : constant Source_Ptr := Sloc (N); Label_Id : Entity_Id := Empty; - procedure Process_Stmts - (Stmts : List_Id; - Compare : Entity_Id; - Unsigned : Entity_Id; - Comp : Entity_Id; - Saved_Comp : Entity_Id; - Current_Comp : Entity_Id); - -- 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)) - -- then - -- <Stmt>; - -- else - -- goto L0; - -- end if; - -- - -- Replace all references to Comp with a reference to Current_Comp. - 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 -- of the said component. - ------------------- - -- Process_Stmts -- - ------------------- - - procedure Process_Stmts - (Stmts : List_Id; - Compare : Entity_Id; - Unsigned : Entity_Id; - Comp : Entity_Id; - Saved_Comp : Entity_Id; - Current_Comp : Entity_Id) - is - 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. - - ------------------ - -- Process_Node -- - ------------------ - - function Process_Node (N : Node_Id) return Traverse_Result is - - procedure Wrap_Statement (Stmt : Node_Id); - -- Wrap an arbitrary statement inside an if statement where the - -- condition does an atomic check on the state of the object. - - -------------------- - -- Wrap_Statement -- - -------------------- - - procedure Wrap_Statement (Stmt : Node_Id) is - begin - -- The first time through, create the declaration of a label - -- which is used to skip the remainder of source statements if - -- the state of the object has changed. - - if No (Label_Id) then - Label_Id := - Make_Identifier (Loc, New_External_Name ('L', 0)); - Set_Entity (Label_Id, - Make_Defining_Identifier (Loc, Chars (Label_Id))); - end if; - - -- Generate: - - -- if System.Atomic_Primitives.Atomic_Compare_Exchange - -- (Comp'Address, - -- Interfaces.Unsigned (Saved_Comp), - -- Interfaces.Unsigned (Current_Comp)) - -- then - -- <Stmt>; - -- else - -- goto L0; - -- end if; - - Rewrite (Stmt, - Make_If_Statement (Loc, - Condition => - Make_Function_Call (Loc, - Name => - New_Reference_To (Compare, Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Comp, Loc), - Attribute_Name => Name_Address), - - Unchecked_Convert_To (Unsigned, - New_Reference_To (Saved_Comp, Loc)), - - Unchecked_Convert_To (Unsigned, - New_Reference_To (Current_Comp, Loc)))), - - Then_Statements => New_List (Relocate_Node (Stmt)), - - Else_Statements => New_List ( - Make_Goto_Statement (Loc, - Name => New_Reference_To (Entity (Label_Id), Loc))))); - end Wrap_Statement; - - -- Start of processing for Process_Node - - begin - -- Wrap each return and raise statement that appear inside a - -- procedure. Skip the last return statement which is added by - -- default since it is transformed into an exit statement. - - if Is_Procedure - and then Nkind_In (N, N_Simple_Return_Statement, - N_Extended_Return_Statement, - N_Raise_Statement) - and then Nkind (Last (Stmts)) /= N_Simple_Return_Statement - then - Wrap_Statement (N); - return Skip; - - -- Replace all references to the original component by a reference - -- to the current state of the component. - - elsif Nkind (N) = N_Identifier - and then Present (Entity (N)) - and then Entity (N) = Comp - then - Rewrite (N, Make_Identifier (Loc, Chars (Current_Comp))); - return Skip; - end if; - - -- Force reanalysis - - Set_Analyzed (N, False); - - return OK; - end Process_Node; - - procedure Process_Nodes is new Traverse_Proc (Process_Node); - - -- Local variables - - Stmt : Node_Id; - - -- Start of processing for Process_Stmts - - begin - Stmt := First (Stmts); - while Present (Stmt) loop - Process_Nodes (Stmt); - Next (Stmt); - end loop; - end Process_Stmts; - -------------------------- -- Referenced_Component -- -------------------------- @@ -3214,20 +3068,25 @@ package body Exp_Ch9 is -- Local variables - Comp : constant Entity_Id := Referenced_Component (N); - Decls : constant List_Id := Declarations (N); - Stmts : List_Id; + Comp : constant Entity_Id := Referenced_Component (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 begin - Stmts := New_Copy_List (Statements (Handled_Statement_Sequence (N))); + -- Add renamings for the protection object, discriminals, privals and + -- the entry index constant for use by debugger. + + Debug_Private_Data_Declarations (Decls); -- Perform the lock-free expansion when the subprogram references a -- protected component. if Present (Comp) then declare + 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; @@ -3238,9 +3097,138 @@ package body Exp_Ch9 is 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; + 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. + + procedure Process_Stmts (Stmts : List_Id); + -- 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)) + -- then + -- <Stmt>; + -- else + -- goto L0; + -- end if; + + ------------------ + -- Process_Node -- + ------------------ + + function Process_Node (N : Node_Id) return Traverse_Result is + + procedure Wrap_Statement (Stmt : Node_Id); + -- Wrap an arbitrary statement inside an if statement where the + -- condition does an atomic check on the state of the object. + + -------------------- + -- Wrap_Statement -- + -------------------- + + procedure Wrap_Statement (Stmt : Node_Id) is + begin + -- The first time through, create the declaration of a label + -- which is used to skip the remainder of source statements + -- if the state of the object has changed. + + if No (Label_Id) then + Label_Id := + Make_Identifier (Loc, New_External_Name ('L', 0)); + Set_Entity (Label_Id, + Make_Defining_Identifier (Loc, Chars (Label_Id))); + end if; + + -- Generate: + + -- if System.Atomic_Primitives.Atomic_Compare_Exchange + -- (Comp'Address, + -- Interfaces.Unsigned (Saved_Comp), + -- Interfaces.Unsigned (Current_Comp)) + -- then + -- <Stmt>; + -- else + -- goto L0; + -- end if; + + Rewrite (Stmt, + Make_If_Statement (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Reference_To (Compare, 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)), + + Unchecked_Convert_To (Unsigned, + New_Reference_To (Current_Comp, Loc)))), + + Then_Statements => New_List (Relocate_Node (Stmt)), + + Else_Statements => New_List ( + Make_Goto_Statement (Loc, + Name => + New_Reference_To (Entity (Label_Id), Loc))))); + end Wrap_Statement; + + -- Start of processing for Process_Node + + begin + -- Wrap each return and raise statement that appear inside a + -- procedure. Skip the last return statement which is added by + -- default since it is transformed into an exit statement. + + if Is_Procedure + and then ((Nkind (N) = N_Simple_Return_Statement + and then N /= Last (Stmts)) + or else Nkind (N) = N_Extended_Return_Statement + or else (Nkind_In (N, N_Raise_Constraint_Error, + N_Raise_Program_Error, + N_Raise_Statement, + N_Raise_Storage_Error) + and then Comes_From_Source (N))) + then + Wrap_Statement (N); + return Skip; + end if; + + -- Force reanalysis + + Set_Analyzed (N, False); + + return OK; + end Process_Node; + + procedure Process_Nodes is new Traverse_Proc (Process_Node); + + ------------------- + -- Process_Stmts -- + ------------------- + + procedure Process_Stmts (Stmts : List_Id) is + Stmt : Node_Id; + + begin + Stmt := First (Stmts); + while Present (Stmt) loop + Process_Nodes (Stmt); + Next (Stmt); + end loop; + end Process_Stmts; + begin -- Get the type size @@ -3305,7 +3293,7 @@ package body Exp_Ch9 is Load_Params := New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Comp, Loc), + Prefix => Relocate_Node (Comp_Sel_Nam), Attribute_Name => Name_Address)); -- For protected procedures, set the memory model to be relaxed @@ -3329,7 +3317,14 @@ package body Exp_Ch9 is -- Protected procedures if Is_Procedure then - Block_Decls := New_List (Decl); + -- Move the original declarations inside the generated block + + Block_Decls := Decls; + + -- Reset the declarations list of the protected procedure to be + -- an empty list. + + Decls := Empty_List; -- Generate: -- Current_Comp : Comp_Type := Saved_Comp; @@ -3338,21 +3333,50 @@ package body Exp_Ch9 is Make_Defining_Identifier (Loc, New_External_Name (Chars (Comp), Suffix => "_current")); - Append_To (Block_Decls, + -- Insert the declarations of Saved_Comp and Current_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, Object_Definition => New_Reference_To (Comp_Type, Loc), - Expression => New_Reference_To (Saved_Comp, Loc))); + Expression => + New_Reference_To (Saved_Comp, Loc))); -- Protected function else - Append_To (Decls, Decl); Current_Comp := Saved_Comp; + + -- Insert the declaration of Saved_Comp in the function + -- declarations right before the renaming of the protected + -- component. + + Insert_Before (Comp_Decl, Decl); end if; - Process_Stmts - (Stmts, Compare, Unsigned, Comp, Saved_Comp, Current_Comp); + -- Rewrite the protected component renaming declaration to be a + -- renaming of Current_Comp. + + -- Generate: + -- Comp : Comp_Type renames Current_Comp; + + Rewrite (Comp_Decl, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => + Defining_Identifier (Comp_Decl), + Subtype_Mark => + New_Occurrence_Of (Comp_Type, Loc), + Name => + New_Reference_To (Current_Comp, Loc))); + + -- Wrap any return or raise statements in Stmts in same the manner + -- described in Process_Stmts. + + Process_Stmts (Stmts); -- Generate: @@ -3370,7 +3394,7 @@ package body Exp_Ch9 is New_Reference_To (Compare, Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Comp, Loc), + Prefix => Relocate_Node (Comp_Sel_Nam), Attribute_Name => Name_Address), Unchecked_Convert_To (Unsigned, @@ -3413,7 +3437,7 @@ package body Exp_Ch9 is if Is_Procedure then Stmts := New_List ( - Make_Procedure_Call_Statement (Loc, + Make_Procedure_Call_Statement (Loc, Name => New_Reference_To (RTE (RE_Atomic_Synchronize), Loc)), Make_Loop_Statement (Loc, @@ -3425,14 +3449,12 @@ package body Exp_Ch9 is Statements => Stmts))), End_Label => Empty)); end if; + + Hand_Stmt_Seq := + Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts); end; end if; - -- Add renamings for the protection object, discriminals, privals and - -- the entry index constant for use by debugger. - - Debug_Private_Data_Declarations (Decls); - -- Make an unprotected version of the subprogram for use within the same -- object, with new name and extra parameter representing the object. @@ -3441,8 +3463,7 @@ package body Exp_Ch9 is Specification => Build_Protected_Sub_Specification (N, Prot_Typ, Unprotected_Mode), Declarations => Decls, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)); + Handled_Statement_Sequence => Hand_Stmt_Seq); end Build_Lock_Free_Unprotected_Subprogram_Body; ------------------------- |