Commit dfcfdc0a by Arnaud Charlet

[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
parent 832338d8
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> 2009-07-23 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Analyze_N_Op_Rem): Assume operands are valid when * exp_ch4.adb (Analyze_N_Op_Rem): Assume operands are valid when
......
...@@ -4524,7 +4524,18 @@ package body Exp_Ch3 is ...@@ -4524,7 +4524,18 @@ package body Exp_Ch3 is
then then
pragma Assert (Is_Class_Wide_Type (Typ)); 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 declare
Iface : constant Entity_Id := Root_Type (Typ); Iface : constant Entity_Id := Root_Type (Typ);
Expr_N : Node_Id := Expr; Expr_N : Node_Id := Expr;
......
...@@ -7952,10 +7952,15 @@ package body Exp_Ch4 is ...@@ -7952,10 +7952,15 @@ package body Exp_Ch4 is
-- sure that things are in range of the target type in any case. This -- sure that things are in range of the target type in any case. This
-- avoids some unnecessary intermediate overflows. -- avoids some unnecessary intermediate overflows.
-- We also do a similar transformation in the case where the target -- We might consider a similar transformation in the case where the
-- type is a 64-bit signed integer, in this case we do the inner -- target is a real type or a 64-bit integer type, and the operand
-- computation in Long_Long_Integer. We also use Long_Long_Integer -- is an arithmetic operation using a 32-bit integer type. However,
-- as the inner type in the fixed-point or floating-point target case. -- 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 -- Note: this circuit is partially redundant with respect to the circuit
-- in Checks.Apply_Arithmetic_Overflow_Check, but we catch more cases in -- in Checks.Apply_Arithmetic_Overflow_Check, but we catch more cases in
...@@ -7964,69 +7969,85 @@ package body Exp_Ch4 is ...@@ -7964,69 +7969,85 @@ package body Exp_Ch4 is
-- place, since it would be trick to remove them here! -- place, since it would be trick to remove them here!
declare 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); Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
begin begin
if (Root_Target_Type = Base_Type (Standard_Long_Long_Integer) -- Enable transformation if all conditions are met
or else Is_Real_Type (Root_Target_Type))
and then Is_Signed_Integer_Type (Operand_Type)
then
Inner_Type := Standard_Long_Long_Integer;
elsif Root_Operand_Type = Base_Type (Standard_Short_Integer) if
or else -- We only do this transformation for source constructs. We assume
Root_Operand_Type = Base_Type (Standard_Short_Short_Integer) -- 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 then
Inner_Type := Standard_Integer; -- All conditions met, go ahead with transformation
end if;
-- Do rewrite if enabled declare
Opnd : Node_Id;
if Present (Inner_Type) then L, R : Node_Id;
-- 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))));
Rewrite (Right_Opnd (Operand), begin
R :=
Make_Type_Conversion (Loc, Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Inner_Type, Loc), Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Right_Opnd (Operand)))); Expression => Relocate_Node (Right_Opnd (Operand)));
Set_Analyzed (Operand, False); if Nkind (Operand) = N_Op_Minus then
Analyze_And_Resolve (Operand, Inner_Type); Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
-- Similar processing for unary operation. The only interesting else
-- case is negation, nothing else can produce an overflow. 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 (N,
Rewrite (Right_Opnd (Operand), Make_Type_Conversion (Loc,
Make_Type_Conversion (Loc, Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
Subtype_Mark => New_Reference_To (Inner_Type, Loc), Expression => Opnd));
Expression => Relocate_Node (Right_Opnd (Operand))));
Set_Analyzed (Operand, False); Analyze_And_Resolve (N, Target_Type);
Analyze_And_Resolve (Operand, Inner_Type); return;
end if; end if;
end;
end if; end if;
end; end;
......
...@@ -2689,6 +2689,11 @@ package body Exp_Ch5 is ...@@ -2689,6 +2689,11 @@ package body Exp_Ch5 is
and then and then
Nkind (Return_Object_Decl) = N_Object_Renaming_Declaration Nkind (Return_Object_Decl) = N_Object_Renaming_Declaration
then 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 Set_By_Ref (Return_Stm); -- Return build-in-place results by ref
elsif Is_Build_In_Place then elsif Is_Build_In_Place then
......
...@@ -6574,6 +6574,12 @@ package body Sem_Ch4 is ...@@ -6574,6 +6574,12 @@ package body Sem_Ch4 is
-- subprogram because that list starts with the subprogram formals. -- subprogram because that list starts with the subprogram formals.
-- We retrieve the candidate operations from the generic declaration. -- 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; function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
-- Verify that the prefix, dereferenced if need be, is a valid -- Verify that the prefix, dereferenced if need be, is a valid
-- controlling argument in a call to Op. The remaining actuals -- controlling argument in a call to Op. The remaining actuals
...@@ -6664,6 +6670,20 @@ package body Sem_Ch4 is ...@@ -6664,6 +6670,20 @@ package body Sem_Ch4 is
end if; end if;
end Collect_Generic_Type_Ops; 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 -- -- Valid_First_Argument_Of --
----------------------------- -----------------------------
...@@ -6744,15 +6764,16 @@ package body Sem_Ch4 is ...@@ -6744,15 +6764,16 @@ package body Sem_Ch4 is
if (Present (Interface_Alias (Prim_Op)) if (Present (Interface_Alias (Prim_Op))
and then Is_Ancestor (Find_Dispatching_Type and then Is_Ancestor (Find_Dispatching_Type
(Alias (Prim_Op)), Corr_Type)) (Alias (Prim_Op)), Corr_Type))
or else
-- Do not consider hidden primitives unless the type is -- Do not consider hidden primitives unless the type is in an
-- in an open scope or we are within an instance, where -- open scope or we are within an instance, where visibility
-- visibility is known to be correct. -- 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) or else (Is_Hidden (Prim_Op)
and then not Is_Immediately_Visible (Obj_Type) and then not Is_Immediately_Visible (Obj_Type)
and then not In_Instance) and then not In_Instance
and then not Is_Private_Overriding (Prim_Op))
then then
goto Continue; goto Continue;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment