[multiple changes]

2009-07-23  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): For an initialized object
	of a class-wide interface type that is a return object of a
	build-in-place function, bypass the interface-related expansions into
	renamings with displacement conversions, etc.
	* exp_ch5.adb (Expand_N_Extended_Return_Statement): Add an assertion
	for the case where a renaming occurs in a build-in-place context, to
	assert that the bypassing of the build-in-place treatment only occurs
	in the case of a renaming that is an expansion of a return expression
	that is itself a build-in-place function call.

2009-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Primitive_Operation): A primitive operation is a
	valid candidate interpretation in a prefixed view if it is hidden, but
	overrides an inherited operation declared in the visible part.

2009-07-23  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Don't promote integer
	division operands to 64-bit at all in any circumstances.

From-SVN: r149990

5 files changed, 144 insertions, 63 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5026a5e..2e160cd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2009-07-23  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): For an initialized object
+	of a class-wide interface type that is a return object of a
+	build-in-place function, bypass the interface-related expansions into
+	renamings with displacement conversions, etc.
+	* exp_ch5.adb (Expand_N_Extended_Return_Statement): Add an assertion
+	for the case where a renaming occurs in a build-in-place context, to
+	assert that the bypassing of the build-in-place treatment only occurs
+	in the case of a renaming that is an expansion of a return expression
+	that is itself a build-in-place function call.
+
+2009-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Try_Primitive_Operation): A primitive operation is a
+	valid candidate interpretation in a prefixed view if it is hidden, but
+	overrides an inherited operation declared in the visible part.
+
+2009-07-23  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Type_Conversion): Don't promote integer
+	division operands to 64-bit at all in any circumstances.
+
 2009-07-23  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch4.adb (Analyze_N_Op_Rem): Assume operands are valid when
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e88661d..e8b46e5 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4524,7 +4524,18 @@ package body Exp_Ch3 is
          then
             pragma Assert (Is_Class_Wide_Type (Typ));
 
-            if Tagged_Type_Expansion then
+            --  If the object is a return object of an inherently limited type,
+            --  which implies build-in-place treatment, bypass the special
+            --  treatment of class-wide interface initialization below. In this
+            --  case, the expansion of the return statement will take care of
+            --  creating the object (via allocator) and initializing it.
+
+            if Is_Return_Object (Def_Id)
+              and then Is_Inherently_Limited_Type (Typ)
+            then
+               null;
+
+            elsif Tagged_Type_Expansion then
                declare
                   Iface    : constant Entity_Id := Root_Type (Typ);
                   Expr_N   : Node_Id := Expr;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index dac3ca7..258ce3a 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7952,10 +7952,15 @@ package body Exp_Ch4 is
       --  sure that things are in range of the target type in any case. This
       --  avoids some unnecessary intermediate overflows.
 
-      --  We also do a similar transformation in the case where the target
-      --  type is a 64-bit signed integer, in this case we do the inner
-      --  computation in Long_Long_Integer. We also use Long_Long_Integer
-      --  as the inner type in the fixed-point or floating-point target case.
+      --  We might consider a similar transformation in the case where the
+      --  target is a real type or a 64-bit integer type, and the operand
+      --  is an arithmetic operation using a 32-bit integer type. However,
+      --  we do not bother with this case, because it could cause significant
+      --  ineffiencies on 32-bit machines. On a 64-bit machine it would be
+      --  much cheaper, but we don't want different behavior on 32-bit and
+      --  64-bit machines. Note that the exclusion of the 64-bit case also
+      --  handles the configurable run-time cases where 64-bit arithmetic
+      --  may simply be unavailable.
 
       --  Note: this circuit is partially redundant with respect to the circuit
       --  in Checks.Apply_Arithmetic_Overflow_Check, but we catch more cases in
@@ -7964,69 +7969,85 @@ package body Exp_Ch4 is
       --  place, since it would be trick to remove them here!
 
       declare
-         Inner_Type        : Entity_Id          := Empty;
-         Root_Target_Type  : constant Entity_Id := Root_Type (Target_Type);
          Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
 
       begin
-         if (Root_Target_Type = Base_Type (Standard_Long_Long_Integer)
-              or else Is_Real_Type (Root_Target_Type))
-           and then Is_Signed_Integer_Type (Operand_Type)
-         then
-            Inner_Type := Standard_Long_Long_Integer;
+         --  Enable transformation if all conditions are met
 
-         elsif Root_Operand_Type = Base_Type (Standard_Short_Integer)
-                 or else
-               Root_Operand_Type = Base_Type (Standard_Short_Short_Integer)
+         if
+           --  We only do this transformation for source constructs. We assume
+           --  that the expander knows what it is doing when it generates code.
+
+           Comes_From_Source (N)
+
+           --  If the operand type is Short_Integer or Short_Short_Integer,
+           --  then we will promote to Integer, which is available on all
+           --  targets, and is sufficient to ensure no intermediate overflow.
+           --  Furthermore it is likely to be as efficient or more efficient
+           --  than using the smaller type for the computation so we do this
+           --  unconditionally.
+
+           and then
+             (Root_Operand_Type = Base_Type (Standard_Short_Integer)
+               or else
+              Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
+
+           --  Test for interesting operation, which includes addition,
+           --  division, exponentiation, multiplication, subtraction, and
+           --  unary negation.
+
+           and then Nkind_In (Operand, N_Op_Add,
+                                       N_Op_Divide,
+                                       N_Op_Expon,
+                                       N_Op_Minus,
+                                       N_Op_Multiply,
+                                       N_Op_Subtract)
          then
-            Inner_Type := Standard_Integer;
-         end if;
+            --  All conditions met, go ahead with transformation
 
-         --  Do rewrite if enabled
-
-         if Present (Inner_Type) then
-
-            --  Test for interesting binary operation, which includes addition,
-            --  exponentiation, multiplication, and subtraction. We do not
-            --  include division in the 64-bit case. It is a very marginal
-            --  situation to get overflow from division in any case (largest
-            --  negative number divided by minus one), and doing the promotion
-            --  may result in less efficient code. Worse still we may end up
-            --  promoting to 64-bit divide on a target that does not support
-            --  this operation, causing a fatal error.
-
-            if Nkind_In (Operand, N_Op_Add,
-                                  N_Op_Expon,
-                                  N_Op_Multiply,
-                                  N_Op_Subtract)
-              or else (Nkind (Operand) = N_Op_Divide
-                        and then Inner_Type /= Standard_Long_Long_Integer)
-            then
-               Rewrite (Left_Opnd (Operand),
-                 Make_Type_Conversion (Loc,
-                   Subtype_Mark => New_Reference_To (Inner_Type, Loc),
-                   Expression   => Relocate_Node (Left_Opnd (Operand))));
+            declare
+               Opnd : Node_Id;
+               L, R : Node_Id;
 
-               Rewrite (Right_Opnd (Operand),
+            begin
+               R :=
                  Make_Type_Conversion (Loc,
-                   Subtype_Mark => New_Reference_To (Inner_Type, Loc),
-                   Expression   => Relocate_Node (Right_Opnd (Operand))));
+                   Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
+                   Expression   => Relocate_Node (Right_Opnd (Operand)));
 
-               Set_Analyzed (Operand, False);
-               Analyze_And_Resolve (Operand, Inner_Type);
+               if Nkind (Operand) = N_Op_Minus then
+                  Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
 
-               --  Similar processing for unary operation. The only interesting
-               --  case is negation, nothing else can produce an overflow.
+               else
+                  L :=
+                    Make_Type_Conversion (Loc,
+                      Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
+                      Expression   => Relocate_Node (Left_Opnd (Operand)));
+
+                  case Nkind (Operand) is
+                     when N_Op_Add =>
+                        Opnd := Make_Op_Add (Loc, L, R);
+                     when N_Op_Divide =>
+                        Opnd := Make_Op_Divide (Loc, L, R);
+                     when N_Op_Expon =>
+                        Opnd := Make_Op_Expon (Loc, L, R);
+                     when N_Op_Multiply =>
+                        Opnd := Make_Op_Multiply (Loc, L, R);
+                     when N_Op_Subtract =>
+                        Opnd := Make_Op_Subtract (Loc, L, R);
+                     when others =>
+                        raise Program_Error;
+                  end case;
 
-            elsif Nkind (Operand) = N_Op_Minus then
-               Rewrite (Right_Opnd (Operand),
-                 Make_Type_Conversion (Loc,
-                   Subtype_Mark => New_Reference_To (Inner_Type, Loc),
-                   Expression   => Relocate_Node (Right_Opnd (Operand))));
+                  Rewrite (N,
+                    Make_Type_Conversion (Loc,
+                      Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
+                      Expression   => Opnd));
 
-               Set_Analyzed (Operand, False);
-               Analyze_And_Resolve (Operand, Inner_Type);
-            end if;
+                     Analyze_And_Resolve (N, Target_Type);
+                     return;
+               end if;
+            end;
          end if;
       end;
 
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 7886266..39700bd 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2689,6 +2689,11 @@ package body Exp_Ch5 is
            and then
              Nkind (Return_Object_Decl) = N_Object_Renaming_Declaration
          then
+            pragma Assert (Nkind (Original_Node (Return_Object_Decl)) =
+                            N_Object_Declaration
+              and then Is_Build_In_Place_Function_Call
+                         (Expression (Original_Node (Return_Object_Decl))));
+
             Set_By_Ref (Return_Stm);  -- Return build-in-place results by ref
 
          elsif Is_Build_In_Place then
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 600a95f..826380e 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6574,6 +6574,12 @@ package body Sem_Ch4 is
          --  subprogram because that list starts with the subprogram formals.
          --  We retrieve the candidate operations from the generic declaration.
 
+         function Is_Private_Overriding (Op : Entity_Id) return Boolean;
+         --  An operation that overrides an inherited operation in the private
+         --  part of its package may be hidden, but if the inherited operation
+         --  is visible a direct call to it will dispatch to the private one,
+         --  which is therefore a valid candidate.
+
          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
          --  Verify that the prefix, dereferenced if need be, is a valid
          --  controlling argument in a call to Op. The remaining actuals
@@ -6664,6 +6670,20 @@ package body Sem_Ch4 is
             end if;
          end Collect_Generic_Type_Ops;
 
+         ---------------------------
+         -- Is_Private_Overriding --
+         ---------------------------
+
+         function Is_Private_Overriding (Op : Entity_Id) return Boolean is
+            Visible_Op : constant Entity_Id := Homonym (Op);
+
+         begin
+            return Present (Visible_Op)
+              and then not Comes_From_Source (Visible_Op)
+              and then Alias (Visible_Op) = Op
+              and then not Is_Hidden (Visible_Op);
+         end Is_Private_Overriding;
+
          -----------------------------
          -- Valid_First_Argument_Of --
          -----------------------------
@@ -6744,15 +6764,16 @@ package body Sem_Ch4 is
                if (Present (Interface_Alias (Prim_Op))
                     and then Is_Ancestor (Find_Dispatching_Type
                                             (Alias (Prim_Op)), Corr_Type))
-                 or else
 
-                  --  Do not consider hidden primitives unless the type is
-                  --  in an open scope or we are within an instance, where
-                  --  visibility is known to be correct.
+                 --  Do not consider hidden primitives unless the type is in an
+                 --  open scope or we are within an instance, where visibility
+                 --  is known to be correct, or else if this is an overriding
+                 --  operation in the private part for an inherited operation.
 
-                  (Is_Hidden (Prim_Op)
-                     and then not Is_Immediately_Visible (Obj_Type)
-                     and then not In_Instance)
+                 or else (Is_Hidden (Prim_Op)
+                           and then not Is_Immediately_Visible (Obj_Type)
+                           and then not In_Instance
+                           and then not Is_Private_Overriding (Prim_Op))
                then
                   goto Continue;
                end if;