[multiple changes]

2014-11-07  Ed Schonberg  <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* 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

+2014-11-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <dewar@adacore.com>
+
+	* 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  <ebotcazou@adacore.com>
 
 	* gnatvsn.ads (Library_Version): Bump to 5.0.

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;

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;
 
+         <<Skip_Packed>>
+
          --  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.