mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 05:30:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2017-01-13 11:42:37 +01:00
parent eaed322611
commit 00f45f3090
9 changed files with 160 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/ada/ChangeLog
View File

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

53
gcc/ada/exp_aggr.adb
View File

@ -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

29
gcc/ada/exp_ch4.adb
View File

@ -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);

6
gcc/ada/inline.adb
View File

@ -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

83
gcc/ada/s-exnllf.adb
View File

@ -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.
-- set, multiply the result by this factor.
if Exp >= 0 then
loop
if Exp rem 2 /= 0 then
Result := Result * Factor;
end if;
loop
if Exp rem 2 /= 0 then
Result := Result * Factor;
end if;
Exp := Exp / 2;
exit when Exp = 0;
Factor := Factor * Factor;
end loop;
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;
return Result;
end Exp;
end System.Exn_LLF;

29
gcc/ada/sem_aggr.adb
View File

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

7
gcc/ada/sem_ch3.adb
View File

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

13
gcc/ada/sem_util.adb
View File

@ -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 --
-------------------------

6
gcc/ada/sem_util.ads
View File

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