From e8de1a820f28cfdd7b8a588dd28277cc8db25ce3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 7 Nov 2014 14:45:22 +0100 Subject: [PATCH] [multiple changes] 2014-11-07 Ed Schonberg * exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Integer): If the restriction No_Floating_Point is in effect, and the operands have the same type, introduce a temporary to hold the fixed point result, to prevent the use of floating-point operations at run-time. 2014-11-07 Robert Dewar * freeze.adb (Check_Address_Clause): Minor reformatting (Find_Constant): Minor reformatting. (Freeze_Array_Type): Modify check for packed declarations. (Freeze_Entity): Minor reformatting. From-SVN: r217223 --- gcc/ada/ChangeLog | 15 +++++++++++ gcc/ada/exp_fixd.adb | 36 +++++++++++++++++++++++--- gcc/ada/freeze.adb | 61 +++++++++++++++++++++++++++----------------- 3 files changed, 86 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1c5b803c7d3..e7fedaa586b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2014-11-07 Ed Schonberg + + * exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Integer): + If the restriction No_Floating_Point is in effect, and the + operands have the same type, introduce a temporary to hold + the fixed point result, to prevent the use of floating-point + operations at run-time. + +2014-11-07 Robert Dewar + + * freeze.adb (Check_Address_Clause): Minor reformatting + (Find_Constant): Minor reformatting. + (Freeze_Array_Type): Modify check for packed declarations. + (Freeze_Entity): Minor reformatting. + 2014-11-05 Eric Botcazou * gnatvsn.ads (Library_Version): Bump to 5.0. diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index 37cded71c9e..564c527927c 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -29,6 +29,8 @@ with Einfo; use Einfo; with Exp_Util; use Exp_Util; with Nlists; use Nlists; with Nmake; use Nmake; +with Restrict; use Restrict; +with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Eval; use Sem_Eval; @@ -2214,13 +2216,41 @@ package body Exp_Fixd is --------------------------------------------------- procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is - Left : constant Node_Id := Left_Opnd (N); - Right : constant Node_Id := Right_Opnd (N); + Loc : constant Source_Ptr := Sloc (N); + Left : constant Node_Id := Left_Opnd (N); + Right : constant Node_Id := Right_Opnd (N); + begin if Etype (Left) = Universal_Real then Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left); + elsif Etype (Right) = Universal_Real then Do_Multiply_Fixed_Universal (N, Left, Right); + + -- If both types are equal and we need to avoid floating point + -- instructions, it's worth introducing a temporary with the + -- common type, because it may be evaluated more simply without + -- the need for run-time use of floating point. + + elsif Etype (Right) = Etype (Left) + and then Restriction_Active (No_Floating_Point) + then + declare + Temp : constant Entity_Id := Make_Temporary (Loc, 'F'); + Mult : constant Node_Id := Make_Op_Multiply (Loc, Left, Right); + Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Temp, + Object_Definition => New_Occurrence_Of (Etype (Right), Loc), + Expression => Mult); + + begin + Insert_Action (N, Decl); + Rewrite (N, + OK_Convert_To (Etype (N), New_Occurrence_Of (Temp, Loc))); + Analyze_And_Resolve (N, Standard_Integer); + end; + else Do_Multiply_Fixed_Fixed (N); end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 2079271eae1..d98645c0cab 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -111,7 +111,7 @@ package body Freeze is -- itself is frozen. Check that the expression does not include references -- to deferred constants without completion. We report this at the freeze -- point of the function, to provide a better error message. - + -- -- In most cases the expression itself is frozen by the time the function -- itself is frozen, because the formals will be frozen by then. However, -- Attribute references to outer types are freeze points for those types; @@ -664,7 +664,6 @@ package body Freeze is if Present (Tag_Assign) then Append_Freeze_Action (E, Tag_Assign); end if; - end if; end if; end Check_Address_Clause; @@ -1295,6 +1294,7 @@ package body Freeze is elsif Nkind (Nod) = N_Attribute_Reference then Analyze (Prefix (Nod)); + if Is_Entity_Name (Prefix (Nod)) and then Is_Type (Entity (Prefix (Nod))) then @@ -2398,24 +2398,6 @@ package body Freeze is Set_Has_Non_Standard_Rep (Base_Type (Arr), True); Set_Is_Bit_Packed_Array (Base_Type (Arr), True); Set_Is_Packed (Base_Type (Arr), True); - - -- Make sure that we have the necessary routines to - -- implement the packing, and complain now if not. - - declare - CS : constant Int := UI_To_Int (Csiz); - RE : constant RE_Id := Get_Id (CS); - - begin - if RE /= RE_Null - and then not RTE_Available (RE) - then - Error_Msg_CRT - ("packing of " & UI_Image (Csiz) - & "-bit components", - First_Subtype (Etype (Arr))); - end if; - end; end if; end; end if; @@ -2668,6 +2650,37 @@ package body Freeze is Create_Packed_Array_Impl_Type (Arr); Freeze_And_Append (Packed_Array_Impl_Type (Arr), N, Result); + -- Make sure that we have the necessary routines to implement the + -- packing, and complain now if not. Note that we only test this + -- for constrained array types. + + if Is_Constrained (Arr) + and then Is_Bit_Packed_Array (Arr) + and then Present (Packed_Array_Impl_Type (Arr)) + and then Is_Array_Type (Packed_Array_Impl_Type (Arr)) + then + declare + CS : constant Uint := Component_Size (Arr); + RE : constant RE_Id := Get_Id (UI_To_Int (CS)); + + begin + if RE /= RE_Null + and then not RTE_Available (RE) + then + Error_Msg_CRT + ("packing of " & UI_Image (CS) & "-bit components", + First_Subtype (Etype (Arr))); + + -- Cancel the packing + + Set_Is_Packed (Base_Type (Arr), False); + Set_Is_Bit_Packed_Array (Base_Type (Arr), False); + Set_Packed_Array_Impl_Type (Arr, Empty); + goto Skip_Packed; + end if; + end; + end if; + -- Size information of packed array type is copied to the array -- type, since this is really the representation. But do not -- override explicit existing size values. If the ancestor subtype @@ -2689,6 +2702,8 @@ package body Freeze is end if; end if; + <> + -- For non-packed arrays set the alignment of the array to the -- alignment of the component type if it is unknown. Skip this -- in atomic case (atomic arrays may need larger alignments). @@ -4561,12 +4576,12 @@ package body Freeze is if Is_CPP_Class (Etype (E)) then Error_Msg_NE ("\} may need a cpp_constructor", - Object_Definition (Parent (E)), Etype (E)); + Object_Definition (Parent (E)), Etype (E)); elsif Present (Expression (Parent (E))) then Error_Msg_N -- CODEFIX ("\maybe a class-wide type was meant", - Object_Definition (Parent (E))); + Object_Definition (Parent (E))); end if; end if; @@ -5432,7 +5447,7 @@ package body Freeze is Check_Suspicious_Modulus (E); end if; - -- the pool applies to named and anonymous access types, but not + -- The pool applies to named and anonymous access types, but not -- to subprogram and to internal types generated for 'Access -- references. -- 2.30.2