diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 29 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/s-exnllf.adb | 89 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 6 |
9 files changed, 163 insertions, 98 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d4e3301..ecd4459 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2017-01-13 Ed Schonberg <schonberg@adacore.com> + + * sem_util.ads, sem_util.adb (Choice_List): Move function here + from sem_aggr.adb, for use elsewhere. + * sem_ch3.adb (Analyze_Object_Declaration): Use Choice_List. + * sem_aggr.adb (Resolve_Array_Aggregate): Remove + Iterated_Component_Present. + * exp_aggr.adb: Use Choice_List throughout, to handle + Iterated_Component_Associations. + (Gen_Loop): Generate proper loop for an + Iterated_Component_Association: loop variable has the identifier + of the original association. Generate a loop even for a single + component choice, in order to make loop parameter visible in + expression. + (Flatten): An Iterated_Component_Association is not static. + +2017-01-13 Yannick Moy <moy@adacore.com> + + * exp_ch4.adb (Expand_N_Op_Expon): Ensure that the value of + float exponentiation for statically known small negative values + is the reciprocal of the exponentiation for the opposite value + of the exponent. + * s-exnllf.adb (Exn_Float, Exn_Long_Float, Exn_Long_Long_Float): + Ensure that the value of float exponentiation for negative values + is the reciprocal of the exponentiation for the opposite value + of the exponent. + * inline.adb (Expand_Inlined_Call): Fix the count + for the number of generated gotos. + 2017-01-13 Yannick Moy <moy@adacore.com> * inline.adb: Code cleanup. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index f058c61..889c359 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -492,7 +492,8 @@ package body Exp_Aggr is then if Present (Component_Associations (N)) then Indx := - First (Choices (First (Component_Associations (N)))); + First + (Choice_List (First (Component_Associations (N)))); if Is_Entity_Name (Indx) and then not Is_Type (Entity (Indx)) @@ -853,6 +854,9 @@ package body Exp_Aggr is -- Otherwise we call Build_Code recursively. As an optimization if the -- loop covers 3 or fewer scalar elements we generate a sequence of -- assignments. + -- If the component association that generates the loop comes from an + -- Iterated_Component_Association, the loop parameter has the name of + -- the corresponding parameter in the original construct. function Gen_While (L, H : Node_Id; Expr : Node_Id) return List_Id; -- Nodes L and H must be side-effect-free expressions. If the input @@ -1644,6 +1648,9 @@ package body Exp_Aggr is -------------- function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id is + Is_Iterated_Component : constant Boolean := + Nkind (Parent (Expr)) = N_Iterated_Component_Association; + L_J : Node_Id; L_L : Node_Id; @@ -1700,9 +1707,10 @@ package body Exp_Aggr is return S; - -- If loop bounds are the same then generate an assignment + -- If loop bounds are the same then generate an assignment, unless + -- the parent construct is an Iterated_Component_Association. - elsif Equal (L, H) then + elsif Equal (L, H) and then not Is_Iterated_Component then return Gen_Assign (New_Copy_Tree (L), Expr); -- If H - L <= 2 then generate a sequence of assignments when we are @@ -1714,6 +1722,7 @@ package body Exp_Aggr is and then Local_Compile_Time_Known_Value (L) and then Local_Compile_Time_Known_Value (H) and then Local_Expr_Value (H) - Local_Expr_Value (L) <= 2 + and then not Is_Iterated_Component then Append_List_To (S, Gen_Assign (New_Copy_Tree (L), Expr)); Append_List_To (S, Gen_Assign (Add (1, To => L), Expr)); @@ -1727,7 +1736,13 @@ package body Exp_Aggr is -- Otherwise construct the loop, starting with the loop index L_J - L_J := Make_Temporary (Loc, 'J', L); + if Is_Iterated_Component then + L_J := Make_Defining_Identifier (Loc, + Chars => (Chars (Defining_Identifier (Parent (Expr))))); + + else + L_J := Make_Temporary (Loc, 'J', L); + end if; -- Construct "L .. H" in Index_Base. We use a qualified expression -- for the bound to convert to the index base, but we don't need @@ -1739,7 +1754,7 @@ package body Exp_Aggr is L_L := Make_Qualified_Expression (Loc, Subtype_Mark => Index_Base_Name, - Expression => L); + Expression => New_Copy_Tree (L)); end if; if Etype (H) = Index_Base then @@ -1748,7 +1763,7 @@ package body Exp_Aggr is L_H := Make_Qualified_Expression (Loc, Subtype_Mark => Index_Base_Name, - Expression => H); + Expression => New_Copy_Tree (H)); end if; L_Range := @@ -2027,7 +2042,7 @@ package body Exp_Aggr is Assoc := First (Component_Associations (N)); while Present (Assoc) loop - Choice := First (Choices (Assoc)); + Choice := First (Choice_List (Assoc)); while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then Set_Loop_Actions (Assoc, New_List); @@ -4255,6 +4270,8 @@ package body Exp_Aggr is -- Check whether all components of the aggregate are compile-time known -- values, and can be passed as is to the back-end without further -- expansion. + -- An Iterated_component_Association is treated as non-static, but there + -- are posibilities for optimization here. function Flatten (N : Node_Id; @@ -4318,6 +4335,7 @@ package body Exp_Aggr is elsif Nkind (Expression (Expr)) /= N_Aggregate or else not Compile_Time_Known_Aggregate (Expression (Expr)) or else Expansion_Delayed (Expression (Expr)) + or else Nkind (Expr) = N_Iterated_Component_Association then Static_Components := False; exit; @@ -4377,9 +4395,12 @@ package body Exp_Aggr is if Box_Present (Assoc) then return False; + + elsif Nkind (Assoc) = N_Iterated_Component_Association then + return False; end if; - Choice := First (Choices (Assoc)); + Choice := First (Choice_List (Assoc)); while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then @@ -4460,7 +4481,7 @@ package body Exp_Aggr is end if; Component_Loop : while Present (Elmt) loop - Choice := First (Choices (Elmt)); + Choice := First (Choice_List (Elmt)); Choice_Loop : while Present (Choice) loop -- If we have an others choice, fill in the missing elements @@ -5228,7 +5249,7 @@ package body Exp_Aggr is if Present (Component_Associations (Sub_Aggr)) then Assoc := Last (Component_Associations (Sub_Aggr)); - if Nkind (First (Choices (Assoc))) = N_Others_Choice then + if Nkind (First (Choice_List (Assoc))) = N_Others_Choice then Others_Present (Dim) := True; end if; end if; @@ -5513,7 +5534,7 @@ package body Exp_Aggr is elsif Present (Component_Associations (Sub_Aggr)) then Assoc := Last (Component_Associations (Sub_Aggr)); - if Nkind (First (Choices (Assoc))) /= N_Others_Choice then + if Nkind (First (Choice_List (Assoc))) /= N_Others_Choice then Need_To_Check := False; else @@ -5525,7 +5546,7 @@ package body Exp_Aggr is Nb_Choices := -1; Assoc := First (Component_Associations (Sub_Aggr)); while Present (Assoc) loop - Choice := First (Choices (Assoc)); + Choice := First (Choice_List (Assoc)); while Present (Choice) loop Nb_Choices := Nb_Choices + 1; Next (Choice); @@ -5570,7 +5591,7 @@ package body Exp_Aggr is begin Assoc := First (Component_Associations (Sub_Aggr)); while Present (Assoc) loop - Choice := First (Choices (Assoc)); + Choice := First (Choice_List (Assoc)); while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then exit; @@ -6348,7 +6369,7 @@ package body Exp_Aggr is MX : constant := 80; begin - if Nkind (First (Choices (CA))) = N_Others_Choice + if Nkind (First (Choice_List (CA))) = N_Others_Choice and then Nkind (Expression (CA)) = N_Character_Literal and then No (Expressions (N)) then @@ -7348,7 +7369,7 @@ package body Exp_Aggr is Assoc := First (Component_Associations (N)); while Present (Assoc) loop - Choice := First (Choices (Assoc)); + Choice := First (Choice_List (Assoc)); while Present (Choice) loop if Nkind (Choice) /= N_Others_Choice then Nb_Choices := Nb_Choices + 1; @@ -8091,7 +8112,7 @@ package body Exp_Aggr is elsif Present (Next (Expr)) then return False; - elsif Present (Next (First (Choices (Expr)))) then + elsif Present (Next (First (Choice_List (Expr)))) then return False; else diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b89d66c..bdd7209 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7691,7 +7691,11 @@ package body Exp_Ch4 is -- the case of 0.0 ** (negative) even if Machine_Overflows = False. -- See ACVC test C4A012B, and it is not worth generating the test. - if Expv >= 0 and then Expv <= 4 then + -- For small negative exponents, we return the reciprocal of + -- the folding of the exponentiation for the opposite (positive) + -- exponent, as required by Ada RM 4.5.6(11/3). + + if abs Expv <= 4 then -- X ** 0 = 1 (or 1.0) @@ -7742,8 +7746,7 @@ package body Exp_Ch4 is -- in -- En * En - else - pragma Assert (Expv = 4); + elsif Expv = 4 then Temp := Make_Temporary (Loc, 'E', Base); Xnode := @@ -7766,6 +7769,26 @@ package body Exp_Ch4 is Make_Op_Multiply (Loc, Left_Opnd => New_Occurrence_Of (Temp, Loc), Right_Opnd => New_Occurrence_Of (Temp, Loc)))); + + -- X ** N = 1.0 / X ** (-N) + -- N in -4 .. -1 + + else + pragma Assert + (Expv = -1 or Expv = -2 or Expv = -3 or Expv = -4); + Xnode := + Make_Op_Divide (Loc, + Left_Opnd => + Make_Float_Literal (Loc, + Radix => Uint_1, + Significand => Uint_1, + Exponent => Uint_0), + Right_Opnd => + Make_Op_Expon (Loc, + Left_Opnd => Duplicate_Subexpr (Base), + Right_Opnd => + Make_Integer_Literal (Loc, + Intval => -Expv))); end if; Rewrite (N, Xnode); diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index d0f8a8c..f07cc4a 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2458,6 +2458,7 @@ package body Inline is elsif Nkind (N) = N_Simple_Return_Statement then if No (Expression (N)) then + Num_Ret := Num_Ret + 1; Make_Exit_Label; Rewrite (N, Make_Goto_Statement (Loc, Name => New_Copy (Lab_Id))); @@ -3396,8 +3397,9 @@ package body Inline is elsif Present (Exit_Lab) then - -- If the body was a single expression, the single return statement - -- and the corresponding label are useless. + -- If there is a single return statement at the end of the + -- subprogram, the corresponding goto statement and the + -- corresponding label are useless. if Num_Ret = 1 and then diff --git a/gcc/ada/s-exnllf.adb b/gcc/ada/s-exnllf.adb index a4386e8..be16b07 100644 --- a/gcc/ada/s-exnllf.adb +++ b/gcc/ada/s-exnllf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -34,12 +34,28 @@ -- a compile time known exponent in this range. The use of Float'Machine and -- Long_Float'Machine is to avoid unwanted extra precision in the results. +-- Note that for a negative exponent in Left ** Right, we compute the result +-- as: + +-- 1.0 / (Left ** (-Right)) + +-- Note that the case of Left being zero is not special, it will simply result +-- in a division by zero at the end, yielding a correctly signed infinity, or +-- possibly generating an overflow. + +-- Note on overflow: This coding assumes that the target generates infinities +-- with standard IEEE semantics. If this is not the case, then the code +-- for negative exponent may raise Constraint_Error. This follows the +-- implementation permission given in RM 4.5.6(12). + package body System.Exn_LLF is + subtype Negative is Integer range Integer'First .. -1; + function Exp (Left : Long_Long_Float; - Right : Integer) return Long_Long_Float; - -- Common routine used if Right not in 0 .. 4 + Right : Natural) return Long_Long_Float; + -- Common routine used if Right is greater or equal to 5 --------------- -- Exn_Float -- @@ -63,6 +79,8 @@ package body System.Exn_LLF is when 4 => Temp := Float'Machine (Left * Left); return Float'Machine (Temp * Temp); + when Negative => + return Float'Machine (1.0 / Exn_Float (Left, -Right)); when others => return Float'Machine @@ -92,6 +110,8 @@ package body System.Exn_LLF is when 4 => Temp := Long_Float'Machine (Left * Left); return Long_Float'Machine (Temp * Temp); + when Negative => + return Long_Float'Machine (1.0 / Exn_Long_Float (Left, -Right)); when others => return Long_Float'Machine @@ -121,6 +141,8 @@ package body System.Exn_LLF is when 4 => Temp := Left * Left; return Temp * Temp; + when Negative => + return 1.0 / Exn_Long_Long_Float (Left, -Right); when others => return Exp (Left, Right); end case; @@ -132,60 +154,29 @@ package body System.Exn_LLF is function Exp (Left : Long_Long_Float; - Right : Integer) return Long_Long_Float + Right : Natural) return Long_Long_Float is Result : Long_Long_Float := 1.0; Factor : Long_Long_Float := Left; - Exp : Integer := Right; + Exp : Natural := Right; begin -- We use the standard logarithmic approach, Exp gets shifted right -- testing successive low order bits and Factor is the value of the -- base raised to the next power of 2. If the low order bit or Exp is - -- set, multiply the result by this factor. For negative exponents, - -- invert result upon return. - - if Exp >= 0 then - loop - if Exp rem 2 /= 0 then - Result := Result * Factor; - end if; - - Exp := Exp / 2; - exit when Exp = 0; - Factor := Factor * Factor; - end loop; - - return Result; - - -- Here we have a negative exponent, and we compute the result as: - - -- 1.0 / (Left ** (-Right)) - - -- Note that the case of Left being zero is not special, it will - -- simply result in a division by zero at the end, yielding a - -- correctly signed infinity, or possibly generating an overflow. - - -- Note on overflow: The coding of this routine assumes that the - -- target generates infinities with standard IEEE semantics. If this - -- is not the case, then the code below may raise Constraint_Error. - -- This follows the implementation permission given in RM 4.5.6(12). - - else - begin - loop - if Exp rem 2 /= 0 then - Result := Result * Factor; - end if; - - Exp := Exp / 2; - exit when Exp = 0; - Factor := Factor * Factor; - end loop; - - return 1.0 / Result; - end; - end if; + -- set, multiply the result by this factor. + + loop + if Exp rem 2 /= 0 then + Result := Result * Factor; + end if; + + Exp := Exp / 2; + exit when Exp = 0; + Factor := Factor * Factor; + end loop; + + return Result; end Exp; end System.Exn_LLF; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 9481c45..f34ae63 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -809,8 +809,8 @@ package body Sem_Aggr is begin return No (Expressions (Aggr)) and then - Nkind (First (Choices (First (Component_Associations (Aggr))))) = - N_Others_Choice; + Nkind (First (Choice_List (First (Component_Associations (Aggr))))) + = N_Others_Choice; end Is_Others_Aggregate; ---------------------------- @@ -1207,10 +1207,6 @@ package body Sem_Aggr is function Dynamic_Or_Null_Range (L, H : Node_Id) return Boolean; -- Returns True if range L .. H is dynamic or null - function Choice_List (N : Node_Id) return List_Id; - -- Utility to retrieve the choices of a Component_Association or the - -- Discrete_Choices of an Iterated_Component_Association. - procedure Get (Value : out Uint; From : Node_Id; OK : out Boolean); -- Given expression node From, this routine sets OK to False if it -- cannot statically evaluate From. Otherwise it stores this static @@ -1473,19 +1469,6 @@ package body Sem_Aggr is or else Val_L > Val_H; end Dynamic_Or_Null_Range; - ----------------- - -- Choice_List -- - ----------------- - - function Choice_List (N : Node_Id) return List_Id is - begin - if Nkind (N) = N_Iterated_Component_Association then - return Discrete_Choices (N); - else - return Choices (N); - end if; - end Choice_List; - --------- -- Get -- --------- @@ -1708,7 +1691,7 @@ package body Sem_Aggr is Expr : Node_Id; Discard : Node_Id; - Iterated_Component_Present : Boolean := False; + -- Iterated_Component_Present : Boolean := False; Aggr_Low : Node_Id := Empty; Aggr_High : Node_Id := Empty; @@ -1749,7 +1732,7 @@ package body Sem_Aggr is while Present (Assoc) loop if Nkind (Assoc) = N_Iterated_Component_Association then Resolve_Iterated_Component_Association (Assoc, Index_Typ); - Iterated_Component_Present := True; + -- Iterated_Component_Present := True; goto Next_Assoc; end if; @@ -2726,10 +2709,6 @@ package body Sem_Aggr is Analyze_Dimension_Array_Aggregate (N, Component_Typ); - if Iterated_Component_Present then - Error_Msg_N ("iterated association not implemented yet", N); - end if; - return Success; end Resolve_Array_Aggregate; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 24ac69f..0a6a30e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4149,9 +4149,10 @@ package body Sem_Ch3 is elsif Nkind (E) = N_Aggregate and then Present (Component_Associations (E)) - and then Present (Choices (First (Component_Associations (E)))) - and then Nkind (First - (Choices (First (Component_Associations (E))))) = N_Others_Choice + and then Present (Choice_List (First (Component_Associations (E)))) + and then + Nkind (First (Choice_List (First (Component_Associations (E))))) + = N_Others_Choice then null; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b90b007..3e5269f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3853,6 +3853,19 @@ package body Sem_Util is end if; end Check_Unused_Body_States; + ----------------- + -- Choice_List -- + ----------------- + + function Choice_List (N : Node_Id) return List_Id is + begin + if Nkind (N) = N_Iterated_Component_Association then + return Discrete_Choices (N); + else + return Choices (N); + end if; + end Choice_List; + ------------------------- -- Collect_Body_States -- ------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 1e84fa5..b5d1e4a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -337,6 +337,12 @@ package Sem_Util is -- and the context is external to the protected operation, to warn against -- a possible unlocked access to data. + function Choice_List (N : Node_Id) return List_Id; + -- Utility to retrieve the choices of a Component_Association or the + -- Discrete_Choices of an Iterated_Component_Association. For various + -- reasons these nodes have a different structure even though they play + -- similar roles in array aggregates. + function Collect_Body_States (Body_Id : Entity_Id) return Elist_Id; -- Gather the entities of all abstract states and objects declared in the -- body state space of package body Body_Id. |