+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.
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))
-- 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
--------------
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;
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
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));
-- 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
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
L_H :=
Make_Qualified_Expression (Loc,
Subtype_Mark => Index_Base_Name,
- Expression => H);
+ Expression => New_Copy_Tree (H));
end if;
L_Range :=
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);
-- 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;
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;
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
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
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;
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
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);
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;
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
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;
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
-- 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)
-- in
-- En * En
- else
- pragma Assert (Expv = 4);
+ elsif Expv = 4 then
Temp := Make_Temporary (Loc, 'E', Base);
Xnode :=
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);
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)));
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
-- --
-- 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- --
-- 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 --
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
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
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;
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;
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;
----------------------------
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
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 --
---------
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;
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;
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;
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;
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 --
-------------------------
-- 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.
projects / gcc.git / commitdiff