From: Arnaud Charlet Date: Tue, 29 Jul 2014 15:49:30 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=36a66365455b8a28b25a38dccfb5f5e3acf39771;p=gcc.git [multiple changes] 2014-07-29 Hristian Kirtchev * a-cbmutr.adb (Allocate_Node): Remove the two parameter version. (Insert_Child): Add local variable First. Capture the index of the first node being created to ensure correct cursor construction later on. Use the three parameter version of Allocate_Node when creating multiple children as this method allows aspect Default_Value to take effect (if applicable). 2014-07-29 Eric Botcazou * exp_aggr.adb (Safe_Slice_Assignment): Remove. (Expand_Array_Aggregate): For a safe slice assignment, just set the target and use the common code path. From-SVN: r213216 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ed9c60866e6..14891b76a4a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2014-07-29 Hristian Kirtchev + + * a-cbmutr.adb (Allocate_Node): Remove the two parameter version. + (Insert_Child): Add local variable First. Capture the index of the + first node being created to ensure correct cursor construction + later on. Use the three parameter version of Allocate_Node + when creating multiple children as this method allows aspect + Default_Value to take effect (if applicable). + +2014-07-29 Eric Botcazou + + * exp_aggr.adb (Safe_Slice_Assignment): Remove. + (Expand_Array_Aggregate): For a safe slice assignment, just set + the target and use the common code path. + 2014-07-29 Robert Dewar * sem_util.adb, sem_util.ads, sem_res.adb, exp_ch6.adb: Invert diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb index aa754149067..c8120036cb5 100644 --- a/gcc/ada/a-cbmutr.adb +++ b/gcc/ada/a-cbmutr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2014, 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- -- @@ -94,10 +94,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is New_Item : Element_Type; New_Node : out Count_Type); - procedure Allocate_Node - (Container : in out Tree; - New_Node : out Count_Type); - procedure Allocate_Node (Container : in out Tree; Stream : not null access Root_Stream_Type'Class; @@ -318,15 +314,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is Allocate_Node (Container, Initialize_Element'Access, New_Node); end Allocate_Node; - procedure Allocate_Node - (Container : in out Tree; - New_Node : out Count_Type) - is - procedure Initialize_Element (Index : Count_Type) is null; - begin - Allocate_Node (Container, Initialize_Element'Access, New_Node); - end Allocate_Node; - ------------------- -- Ancestor_Find -- ------------------- @@ -1583,6 +1570,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is Count : Count_Type := 1) is Nodes : Tree_Node_Array renames Container.Nodes; + First : Count_Type; Last : Count_Type; New_Item : Element_Type; @@ -1634,11 +1622,12 @@ package body Ada.Containers.Bounded_Multiway_Trees is -- initialized elements at the given position. Allocate_Node (Container, New_Item, Position.Node); + First := Position.Node; Nodes (Position.Node).Parent := Parent.Node; Last := Position.Node; for J in Count_Type'(2) .. Count loop - Allocate_Node (Container, Nodes (Last).Next); + Allocate_Node (Container, New_Item, Nodes (Last).Next); Nodes (Nodes (Last).Next).Parent := Parent.Node; Nodes (Nodes (Last).Next).Prev := Last; @@ -1654,7 +1643,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is Container.Count := Container.Count + Count; - Position.Container := Parent.Container; + Position := Cursor'(Parent.Container, First); end Insert_Child; ------------------------- diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 5a1c2882d0f..ff1cb4a0064 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -289,11 +289,6 @@ package body Exp_Aggr is -- If this transformation is not possible, N is unchanged and False is -- returned. - function Safe_Slice_Assignment (N : Node_Id) return Boolean; - -- If a slice assignment has an aggregate with a single others_choice, - -- the assignment can be done in place even if bounds are not static, - -- by converting it into a loop over the discrete range of the slice. - function Two_Dim_Packed_Array_Handled (N : Node_Id) return Boolean; -- If the type of the aggregate is a two-dimensional bit_packed array -- it may be transformed into an array of bytes with constant values, @@ -404,8 +399,8 @@ package body Exp_Aggr is elsif Restriction_Active (No_Elaboration_Code) or else Restriction_Active (No_Implicit_Loops) or else Is_Two_Dim_Packed_Array (Typ) - or else ((Ekind (Current_Scope) = E_Package - and then Static_Elaboration_Desired (Current_Scope))) + or else (Ekind (Current_Scope) = E_Package + and then Static_Elaboration_Desired (Current_Scope)) then Max_Aggr_Size := 2 ** 24; @@ -443,9 +438,7 @@ package body Exp_Aggr is -- is an object declaration with non-static bounds it will trip gcc; -- such an aggregate must be expanded into a single assignment. - if Hiv = Lov - and then Nkind (Parent (N)) = N_Object_Declaration - then + if Hiv = Lov and then Nkind (Parent (N)) = N_Object_Declaration then declare Index_Type : constant Entity_Id := Etype @@ -454,8 +447,8 @@ package body Exp_Aggr is begin if not Compile_Time_Known_Value (Type_Low_Bound (Index_Type)) - or else not Compile_Time_Known_Value - (Type_High_Bound (Index_Type)) + or else not Compile_Time_Known_Value + (Type_High_Bound (Index_Type)) then if Present (Component_Associations (N)) then Indx := @@ -603,7 +596,7 @@ package body Exp_Aggr is -- Recursion to following indexes for multiple dimension case if Present (Next_Index (Index)) - and then not Component_Check (Expr, Next_Index (Index)) + and then not Component_Check (Expr, Next_Index (Index)) then return False; end if; @@ -653,11 +646,11 @@ package body Exp_Aggr is end if; -- Checks 5 (if the component type is tagged, then we may need to do - -- tag adjustments. Perhaps this should be refined to check for any - -- component associations that actually need tag adjustment, similar - -- to the test in Component_Not_OK_For_Backend for record aggregates - -- with tagged components, but not clear whether it's worthwhile ???; - -- in the case of the JVM, object tags are handled implicitly) + -- tag adjustments. Perhaps this should be refined to check for any + -- component associations that actually need tag adjustment, similar + -- to the test in Component_Not_OK_For_Backend for record aggregates + -- with tagged components, but not clear whether it's worthwhile ???; + -- in the case of the JVM, object tags are handled implicitly) if Is_Tagged_Type (Component_Type (Typ)) and then Tagged_Type_Expansion @@ -934,7 +927,8 @@ package body Exp_Aggr is end case; if Local_Compile_Time_Known_Value (Low) - and then Local_Compile_Time_Known_Value (High) + and then + Local_Compile_Time_Known_Value (High) then Is_Empty := UI_Gt (Local_Expr_Value (Low), Local_Expr_Value (High)); @@ -956,7 +950,8 @@ package body Exp_Aggr is return True; elsif Local_Compile_Time_Known_Value (L) - and then Local_Compile_Time_Known_Value (H) + and then + Local_Compile_Time_Known_Value (H) then return UI_Eq (Local_Expr_Value (L), Local_Expr_Value (H)); end if; @@ -1053,9 +1048,7 @@ package body Exp_Aggr is Expr_Q := Expr; end if; - if Present (Etype (N)) - and then Etype (N) /= Any_Composite - then + if Present (Etype (N)) and then Etype (N) /= Any_Composite then Comp_Type := Component_Type (Etype (N)); pragma Assert (Comp_Type = Ctype); -- AI-287 @@ -1066,13 +1059,13 @@ package body Exp_Aggr is -- the formal parameter Ctype. -- ??? Some assert pragmas have been added to check if this new - -- formal can be used to replace this code in all cases. + -- formal can be used to replace this code in all cases. if Present (Expr) then - -- This is a multidimensional array. Recover the component - -- type from the outermost aggregate, because subaggregates - -- do not have an assigned type. + -- This is a multidimensional array. Recover the component type + -- from the outermost aggregate, because subaggregates do not + -- have an assigned type. declare P : Node_Id; @@ -1265,8 +1258,8 @@ package body Exp_Aggr is and then not Is_Limited_Type (Comp_Type) and then not (Is_Array_Type (Comp_Type) - and then Is_Controlled (Component_Type (Comp_Type)) - and then Nkind (Expr) = N_Aggregate) + and then Is_Controlled (Component_Type (Comp_Type)) + and then Nkind (Expr) = N_Aggregate) then Append_To (L, Make_Adjust_Call ( @@ -1621,9 +1614,7 @@ package body Exp_Aggr is -- entity in the current scope, because it will be needed if build- -- in-place functions are called in the expanded code. - if Nkind (Parent (N)) = N_Object_Declaration - and then Has_Task (Typ) - then + if Nkind (Parent (N)) = N_Object_Declaration and then Has_Task (Typ) then Build_Master_Entity (Defining_Identifier (Parent (N))); end if; @@ -2189,9 +2180,7 @@ package body Exp_Aggr is -- proper scope is the scope of the target rather than the -- potentially transient current scope. - if Is_Controlled (Typ) - and then Ancestor_Is_Subtype_Mark - then + if Is_Controlled (Typ) and then Ancestor_Is_Subtype_Mark then Ref := Convert_To (Init_Typ, New_Copy_Tree (Target)); Set_Assignment_OK (Ref); @@ -2223,8 +2212,8 @@ package body Exp_Aggr is and then Present (Entity (Expr)) and then Ekind (Entity (Expr)) = E_In_Parameter and then Present (Discriminal_Link (Entity (Expr))) - and then Scope (Discriminal_Link (Entity (Expr))) - = Base_Type (Etype (N)) + and then Scope (Discriminal_Link (Entity (Expr))) = + Base_Type (Etype (N)) then Rewrite (Expr, Make_Selected_Component (Loc, @@ -2427,7 +2416,7 @@ package body Exp_Aggr is elsif Is_Limited_Type (Etype (Ancestor)) and then Nkind_In (Unqualify (Ancestor), N_Aggregate, - N_Extension_Aggregate) + N_Extension_Aggregate) then Ancestor_Is_Expression := True; @@ -2596,9 +2585,7 @@ package body Exp_Aggr is -- constructor to ensure the proper initialization of the _Tag -- component. - if Is_CPP_Class (Root_Type (Typ)) - and then CPP_Num_Prims (Typ) > 0 - then + if Is_CPP_Class (Root_Type (Typ)) and then CPP_Num_Prims (Typ) > 0 then Invoke_Constructor : declare CPP_Parent : constant Entity_Id := Enclosing_CPP_Parent (Typ); @@ -2952,7 +2939,7 @@ package body Exp_Aggr is if Nkind (Ass) = N_Assignment_Statement and then Nkind (Name (Ass)) = N_Selected_Component and then Chars (Selector_Name (Name (Ass))) = - Chars (Disc) + Chars (Disc) then Set_Expression (Ass, New_Copy_Tree (Expression (Comp))); @@ -3382,7 +3369,7 @@ package body Exp_Aggr is -- known discriminants if available. if Has_Unknown_Discriminants (Typ) - and then Present (Underlying_Record_View (Typ)) + and then Present (Underlying_Record_View (Typ)) then T := Underlying_Record_View (Typ); else @@ -3487,7 +3474,7 @@ package body Exp_Aggr is elsif Is_Entity_Name (Expression (Expr)) and then Present (Entity (Expression (Expr))) and then Ekind (Entity (Expression (Expr))) = - E_Enumeration_Literal + E_Enumeration_Literal then null; @@ -3581,8 +3568,7 @@ package body Exp_Aggr is -- See ACATS c460010 for an example. if Hiv < Lov - or else (not Compile_Time_Known_Value (Blo) - and then Others_Present) + or else (not Compile_Time_Known_Value (Blo) and then Others_Present) then return False; end if; @@ -3636,7 +3622,7 @@ package body Exp_Aggr is if Present (Next_Index (Ix)) and then not Flatten - (Expression (Elmt), Next_Index (Ix), Next_Index (Ixb)) + (Expression (Elmt), Next_Index (Ix), Next_Index (Ixb)) then return False; end if; @@ -3679,9 +3665,8 @@ package body Exp_Aggr is or else Restriction_Active (No_Implicit_Loops) or else (Ekind (Current_Scope) = E_Package - and then - Static_Elaboration_Desired - (Current_Scope)) + and then Static_Elaboration_Desired + (Current_Scope)) or else Is_Preelaborated (P) or else (Ekind (P) = E_Package_Body and then @@ -3834,9 +3819,7 @@ package body Exp_Aggr is return; end if; - if Is_Bit_Packed_Array (Typ) - and then not Handle_Bit_Packed - then + if Is_Bit_Packed_Array (Typ) and then not Handle_Bit_Packed then return; end if; @@ -4388,7 +4371,7 @@ package body Exp_Aggr is return Compile_Time_Known_Value (Comp) or else (Is_Entity_Name (Comp) - and then Present (Entity (Comp)) + and then Present (Entity (Comp)) and then No (Renamed_Object (Entity (Comp)))) or else (Nkind (Comp) = N_Attribute_Reference @@ -4749,8 +4732,7 @@ package body Exp_Aggr is elsif Nkind (Indx) = N_Function_Call and then Is_Entity_Name (Name (Indx)) - and then - Has_Pragma_Pure_Function (Entity (Name (Indx))) + and then Has_Pragma_Pure_Function (Entity (Name (Indx))) then return True; @@ -4777,8 +4759,7 @@ package body Exp_Aggr is elsif Nkind (N) = N_Indexed_Component and then Safe_Left_Hand_Side (Prefix (N)) - and then - Is_Safe_Index (First (Expressions (N))) + and then Is_Safe_Index (First (Expressions (N))) then return True; @@ -4968,9 +4949,7 @@ package body Exp_Aggr is -- that Convert_To_Positional succeeded and reanalyzed the rewritten -- aggregate. - elsif Analyzed (N) - and then N /= Original_Node (N) - then + elsif Analyzed (N) and then N /= Original_Node (N) then return; end if; @@ -5165,13 +5144,21 @@ package body Exp_Aggr is end if; end if; + -- If a slice assignment has an aggregate with a single others_choice, + -- the assignment can be done in place even if bounds are not static, + -- by converting it into a loop over the discrete range of the slice. + elsif Maybe_In_Place_OK and then Nkind (Name (Parent (N))) = N_Slice - and then Safe_Slice_Assignment (N) + and then Comes_From_Source (N) + and then Is_Others_Aggregate (N) then - -- Safe_Slice_Assignment rewrites assignment as a loop + Tmp := Name (Parent (N)); - return; + -- Set type of aggregate to be type of lhs in assignment, in order + -- to suppress redundant length checks. + + Set_Etype (N, Etype (Tmp)); -- Step 5 @@ -5958,9 +5945,7 @@ package body Exp_Aggr is -- extension aggregate, the parent expr is replaced by an -- aggregate formed by selected components of this expr. - if Present (Parent_Expr) - and then Is_Empty_List (Comps) - then + if Present (Parent_Expr) and then Is_Empty_List (Comps) then Comp := First_Component_Or_Discriminant (Typ); while Present (Comp) loop @@ -6026,8 +6011,10 @@ package body Exp_Aggr is First_Comp := First (Component_Associations (N)); Parent_Comps := New_List; while Present (First_Comp) - and then Scope (Original_Record_Component ( - Entity (First (Choices (First_Comp))))) /= Base_Typ + and then + Scope (Original_Record_Component + (Entity (First (Choices (First_Comp))))) /= + Base_Typ loop Comp := First_Comp; Next (First_Comp); @@ -6035,8 +6022,9 @@ package body Exp_Aggr is Append (Comp, Parent_Comps); end loop; - Parent_Aggr := Make_Aggregate (Loc, - Component_Associations => Parent_Comps); + Parent_Aggr := + Make_Aggregate (Loc, + Component_Associations => Parent_Comps); Set_Etype (Parent_Aggr, Etype (Base_Type (Typ))); -- Find the _parent component @@ -6129,8 +6117,7 @@ package body Exp_Aggr is Expr := Expression (C); if Present (Expr) - and then - Nkind_In (Expr, N_Aggregate, N_Extension_Aggregate) + and then Nkind_In (Expr, N_Aggregate, N_Extension_Aggregate) and then Has_Default_Init_Comps (Expr) then return True; @@ -6156,7 +6143,7 @@ package body Exp_Aggr is Kind := Nkind (Node); end if; - if Kind /= N_Aggregate and then Kind /= N_Extension_Aggregate then + if not Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate) then return False; else return Expansion_Delayed (Node); @@ -6591,8 +6578,8 @@ package body Exp_Aggr is and then Number_Discriminants (Bas) /= Number_Discriminants (Par) and then Nkind (Decl) = N_Full_Type_Declaration and then Nkind (Type_Definition (Decl)) = N_Record_Definition - and then Present - (Variant_Part (Component_List (Type_Definition (Decl)))) + and then + Present (Variant_Part (Component_List (Type_Definition (Decl)))) and then Nkind (N) /= N_Extension_Aggregate then @@ -6614,6 +6601,7 @@ package body Exp_Aggr is Typ : Entity_Id) return Boolean is L1, L2, H1, H2 : Node_Id; + begin -- No sliding if the type of the object is not established yet, if it is -- an unconstrained type whose actual subtype comes from the aggregate, @@ -6648,70 +6636,6 @@ package body Exp_Aggr is end if; end Must_Slide; - --------------------------- - -- Safe_Slice_Assignment -- - --------------------------- - - function Safe_Slice_Assignment (N : Node_Id) return Boolean is - Loc : constant Source_Ptr := Sloc (Parent (N)); - Pref : constant Node_Id := Prefix (Name (Parent (N))); - Range_Node : constant Node_Id := Discrete_Range (Name (Parent (N))); - Expr : Node_Id; - L_J : Entity_Id; - L_Iter : Node_Id; - L_Body : Node_Id; - Stat : Node_Id; - - begin - -- Generate: for J in Range loop Pref (J) := Expr; end loop; - - if Comes_From_Source (N) - and then No (Expressions (N)) - and then Nkind (First (Choices (First (Component_Associations (N))))) - = N_Others_Choice - then - Expr := Expression (First (Component_Associations (N))); - L_J := Make_Temporary (Loc, 'J'); - - L_Iter := - Make_Iteration_Scheme (Loc, - Loop_Parameter_Specification => - Make_Loop_Parameter_Specification - (Loc, - Defining_Identifier => L_J, - Discrete_Subtype_Definition => Relocate_Node (Range_Node))); - - L_Body := - Make_Assignment_Statement (Loc, - Name => - Make_Indexed_Component (Loc, - Prefix => Relocate_Node (Pref), - Expressions => New_List (New_Occurrence_Of (L_J, Loc))), - Expression => Relocate_Node (Expr)); - - -- Construct the final loop - - Stat := - Make_Implicit_Loop_Statement - (Node => Parent (N), - Identifier => Empty, - Iteration_Scheme => L_Iter, - Statements => New_List (L_Body)); - - -- Set type of aggregate to be type of lhs in assignment, - -- to suppress redundant length checks. - - Set_Etype (N, Etype (Name (Parent (N)))); - - Rewrite (Parent (N), Stat); - Analyze (Parent (N)); - return True; - - else - return False; - end if; - end Safe_Slice_Assignment; - ---------------------------------- -- Two_Dim_Packed_Array_Handled -- ---------------------------------- @@ -6724,10 +6648,10 @@ package body Exp_Aggr is Packed_Array : constant Entity_Id := Packed_Array_Impl_Type (Base_Type (Typ)); - One_Comp : Node_Id; + One_Comp : Node_Id; -- Expression in original aggregate - One_Dim : Node_Id; + One_Dim : Node_Id; -- One-dimensional subaggregate begin