[multiple changes]

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.

From-SVN: r244414

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.