[multiple changes]

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

	* exp_ch4.adb (Analyze_N_Op_Rem): Assume operands are valid when
	checking ranges for mod/rem to see if conditional jump will be
	generated.
	(Analyze_N_Op_Rem): Don't try to check actual lower bounds for
	generating special -1 test for rem, generate it whenever both
	operands can be negative (match circuit in Sem_Res).
	(Analyze_N_Op_Rem): Don't go to base type, no longer needed and
	destroys memory of positive range.
	* sem_res.adb (Resolve_Arithmetic_Op): Assume operands are valid when
	checking ranges for mod/rem to see if conditional jump will be generated

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

	* exp_ch3.adb (Build_Equivalent_Record_Aggregate): If the type of a
	scalar components has non-static bounds, the equivalent aggregate
	cannot be built, even if the expression is static, because range checks
	will be generated.

From-SVN: r149987
This commit is contained in:
Arnaud Charlet 2009-07-23 11:51:19 +02:00
parent 27f55f3c32
commit 5d5e977577
4 changed files with 86 additions and 55 deletions

View File

@ -1,3 +1,23 @@
2009-07-23 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Analyze_N_Op_Rem): Assume operands are valid when
checking ranges for mod/rem to see if conditional jump will be
generated.
(Analyze_N_Op_Rem): Don't try to check actual lower bounds for
generating special -1 test for rem, generate it whenever both
operands can be negative (match circuit in Sem_Res).
(Analyze_N_Op_Rem): Don't go to base type, no longer needed and
destroys memory of positive range.
* sem_res.adb (Resolve_Arithmetic_Op): Assume operands are valid when
checking ranges for mod/rem to see if conditional jump will be generated
2009-07-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Build_Equivalent_Record_Aggregate): If the type of a
scalar components has non-static bounds, the equivalent aggregate
cannot be built, even if the expression is static, because range checks
will be generated.
2009-07-23 Robert Dewar <dewar@adacore.com> 2009-07-23 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): Don't promote integer * exp_ch4.adb (Expand_N_Type_Conversion): Don't promote integer

View File

@ -1240,8 +1240,9 @@ package body Exp_Ch3 is
--------------------------------------- ---------------------------------------
function Build_Equivalent_Record_Aggregate (T : Entity_Id) return Node_Id is function Build_Equivalent_Record_Aggregate (T : Entity_Id) return Node_Id is
Agg : Node_Id; Agg : Node_Id;
Comp : Entity_Id; Comp : Entity_Id;
Comp_Type : Entity_Id;
-- Start of processing for Build_Equivalent_Record_Aggregate -- Start of processing for Build_Equivalent_Record_Aggregate
@ -1269,38 +1270,40 @@ package body Exp_Ch3 is
-- aggregate with static components. -- aggregate with static components.
if Is_Array_Type (Etype (Comp)) then if Is_Array_Type (Etype (Comp)) then
declare Comp_Type := Component_Type (Etype (Comp));
Comp_Type : constant Entity_Id := Component_Type (Etype (Comp));
begin if Nkind (Parent (Comp)) /= N_Component_Declaration
if Nkind (Parent (Comp)) /= N_Component_Declaration or else No (Expression (Parent (Comp)))
or else No (Expression (Parent (Comp))) or else Nkind (Expression (Parent (Comp))) /= N_Aggregate
or else Nkind (Expression (Parent (Comp))) /= N_Aggregate then
then Initialization_Warning (T);
Initialization_Warning (T); return Empty;
return Empty;
elsif Is_Scalar_Type (Component_Type (Etype (Comp))) elsif Is_Scalar_Type (Component_Type (Etype (Comp)))
and then and then
(not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type)) (not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type))
or else not Compile_Time_Known_Value or else
(Type_High_Bound (Comp_Type))) not Compile_Time_Known_Value (Type_High_Bound (Comp_Type)))
then then
Initialization_Warning (T); Initialization_Warning (T);
return Empty; return Empty;
elsif elsif
not Static_Array_Aggregate (Expression (Parent (Comp))) not Static_Array_Aggregate (Expression (Parent (Comp)))
then then
Initialization_Warning (T); Initialization_Warning (T);
return Empty; return Empty;
end if; end if;
end;
elsif Is_Scalar_Type (Etype (Comp)) then elsif Is_Scalar_Type (Etype (Comp)) then
Comp_Type := Etype (Comp);
if Nkind (Parent (Comp)) /= N_Component_Declaration if Nkind (Parent (Comp)) /= N_Component_Declaration
or else No (Expression (Parent (Comp))) or else No (Expression (Parent (Comp)))
or else not Compile_Time_Known_Value (Expression (Parent (Comp))) or else not Compile_Time_Known_Value (Expression (Parent (Comp)))
or else not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type))
or else not
Compile_Time_Known_Value (Type_High_Bound (Comp_Type))
then then
Initialization_Warning (T); Initialization_Warning (T);
return Empty; return Empty;

View File

@ -6270,8 +6270,8 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
Determine_Range (Right, ROK, Rlo, Rhi); Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
Determine_Range (Left, LOK, Llo, Lhi); Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
-- Convert mod to rem if operands are known non-negative. We do this -- Convert mod to rem if operands are known non-negative. We do this
-- since it is quite likely that this will improve the quality of code, -- since it is quite likely that this will improve the quality of code,
@ -6865,15 +6865,15 @@ package body Exp_Ch4 is
Left : constant Node_Id := Left_Opnd (N); Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N); Right : constant Node_Id := Right_Opnd (N);
LLB : Uint; Lo : Uint;
Llo : Uint; Hi : Uint;
Lhi : Uint; OK : Boolean;
LOK : Boolean;
Rlo : Uint;
Rhi : Uint;
ROK : Boolean;
pragma Warnings (Off, Lhi); Lneg : Boolean;
Rneg : Boolean;
-- Set if corresponding operand can be negative
pragma Unreferenced (Hi);
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
@ -6909,23 +6909,18 @@ package body Exp_Ch4 is
-- the remainder is always 0, and we can just ignore the left operand -- the remainder is always 0, and we can just ignore the left operand
-- completely in this case. -- completely in this case.
Determine_Range (Right, ROK, Rlo, Rhi); Determine_Range (Right, OK, Lo, Hi, Assume_Valid => True);
Determine_Range (Left, LOK, Llo, Lhi); Lneg := (not OK) or else Lo < 0;
-- The operand type may be private (e.g. in the expansion of an Determine_Range (Left, OK, Lo, Hi, Assume_Valid => True);
-- intrinsic operation) so we must use the underlying type to get the Rneg := (not OK) or else Lo < 0;
-- bounds, and convert the literals explicitly.
LLB := -- We won't mess with trying to find out if the left operand can really
Expr_Value -- be the largest negative number (that's a pain in the case of private
(Type_Low_Bound (Base_Type (Underlying_Type (Etype (Left))))); -- types and this is really marginal). We will just assume that we need
-- the test if the left operand can be negative at all.
-- Now perform the test, generating code only if needed if Lneg and Rneg then
if ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
and then
((not LOK) or else (Llo = LLB))
then
Rewrite (N, Rewrite (N,
Make_Conditional_Expression (Loc, Make_Conditional_Expression (Loc,
Expressions => New_List ( Expressions => New_List (

View File

@ -4674,12 +4674,25 @@ package body Sem_Res is
-- Set if corresponding operand might be negative -- Set if corresponding operand might be negative
begin begin
Determine_Range (Left_Opnd (N), OK, Lo, Hi); Determine_Range
(Left_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
LNeg := (not OK) or else Lo < 0; LNeg := (not OK) or else Lo < 0;
Determine_Range (Right_Opnd (N), OK, Lo, Hi); Determine_Range
(Right_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
RNeg := (not OK) or else Lo < 0; RNeg := (not OK) or else Lo < 0;
-- Check if we will be generating conditionals. There are two
-- cases where that can happen, first for REM, the only case
-- is largest negative integer mod -1, where the division can
-- overflow, but we still have to give the right result. The
-- front end generates a test for this annoying case. Here we
-- just test if both operands can be negative (that's what the
-- expander does, so we match its logic here).
-- The second case is mod where either operand can be negative.
-- In this case, the back end has to generate additonal tests.
if (Nkind (N) = N_Op_Rem and then (LNeg and RNeg)) if (Nkind (N) = N_Op_Rem and then (LNeg and RNeg))
or else or else
(Nkind (N) = N_Op_Mod and then (LNeg or RNeg)) (Nkind (N) = N_Op_Mod and then (LNeg or RNeg))
@ -4959,11 +4972,11 @@ package body Sem_Res is
Set_Entity (Subp, Nam); Set_Entity (Subp, Nam);
if (Is_Array_Type (Ret_Type) if (Is_Array_Type (Ret_Type)
and then Component_Type (Ret_Type) /= Any_Type) and then Component_Type (Ret_Type) /= Any_Type)
or else or else
(Is_Access_Type (Ret_Type) (Is_Access_Type (Ret_Type)
and then Component_Type (Designated_Type (Ret_Type)) and then
/= Any_Type) Component_Type (Designated_Type (Ret_Type)) /= Any_Type)
then then
if Needs_No_Actuals (Nam) then if Needs_No_Actuals (Nam) then