Commit 5d5e9775 by Arnaud Charlet

[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
parent 27f55f3c
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>
* exp_ch4.adb (Expand_N_Type_Conversion): Don't promote integer
division operands to 64-bit inside a conversion if 64-bit division not
available.
......
......@@ -1240,8 +1240,9 @@ package body Exp_Ch3 is
---------------------------------------
function Build_Equivalent_Record_Aggregate (T : Entity_Id) return Node_Id is
Agg : Node_Id;
Comp : Entity_Id;
Agg : Node_Id;
Comp : Entity_Id;
Comp_Type : Entity_Id;
-- Start of processing for Build_Equivalent_Record_Aggregate
......@@ -1269,38 +1270,40 @@ package body Exp_Ch3 is
-- aggregate with static components.
if Is_Array_Type (Etype (Comp)) then
declare
Comp_Type : constant Entity_Id := Component_Type (Etype (Comp));
Comp_Type := Component_Type (Etype (Comp));
begin
if Nkind (Parent (Comp)) /= N_Component_Declaration
or else No (Expression (Parent (Comp)))
or else Nkind (Expression (Parent (Comp))) /= N_Aggregate
then
Initialization_Warning (T);
return Empty;
elsif Is_Scalar_Type (Component_Type (Etype (Comp)))
and then
(not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type))
or else not Compile_Time_Known_Value
(Type_High_Bound (Comp_Type)))
then
Initialization_Warning (T);
return Empty;
if Nkind (Parent (Comp)) /= N_Component_Declaration
or else No (Expression (Parent (Comp)))
or else Nkind (Expression (Parent (Comp))) /= N_Aggregate
then
Initialization_Warning (T);
return Empty;
elsif
not Static_Array_Aggregate (Expression (Parent (Comp)))
then
Initialization_Warning (T);
return Empty;
end if;
end;
elsif Is_Scalar_Type (Component_Type (Etype (Comp)))
and then
(not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type))
or else
not Compile_Time_Known_Value (Type_High_Bound (Comp_Type)))
then
Initialization_Warning (T);
return Empty;
elsif
not Static_Array_Aggregate (Expression (Parent (Comp)))
then
Initialization_Warning (T);
return Empty;
end if;
elsif Is_Scalar_Type (Etype (Comp)) then
Comp_Type := Etype (Comp);
if Nkind (Parent (Comp)) /= N_Component_Declaration
or else No (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
Initialization_Warning (T);
return Empty;
......
......@@ -6270,8 +6270,8 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
Determine_Range (Right, ROK, Rlo, Rhi);
Determine_Range (Left, LOK, Llo, Lhi);
Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
-- 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,
......@@ -6865,15 +6865,15 @@ package body Exp_Ch4 is
Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N);
LLB : Uint;
Llo : Uint;
Lhi : Uint;
LOK : Boolean;
Rlo : Uint;
Rhi : Uint;
ROK : Boolean;
Lo : Uint;
Hi : Uint;
OK : Boolean;
pragma Warnings (Off, Lhi);
Lneg : Boolean;
Rneg : Boolean;
-- Set if corresponding operand can be negative
pragma Unreferenced (Hi);
begin
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
-- completely in this case.
Determine_Range (Right, ROK, Rlo, Rhi);
Determine_Range (Left, LOK, Llo, Lhi);
Determine_Range (Right, OK, Lo, Hi, Assume_Valid => True);
Lneg := (not OK) or else Lo < 0;
-- The operand type may be private (e.g. in the expansion of an
-- intrinsic operation) so we must use the underlying type to get the
-- bounds, and convert the literals explicitly.
Determine_Range (Left, OK, Lo, Hi, Assume_Valid => True);
Rneg := (not OK) or else Lo < 0;
LLB :=
Expr_Value
(Type_Low_Bound (Base_Type (Underlying_Type (Etype (Left)))));
-- We won't mess with trying to find out if the left operand can really
-- be the largest negative number (that's a pain in the case of private
-- 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 ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
and then
((not LOK) or else (Llo = LLB))
then
if Lneg and Rneg then
Rewrite (N,
Make_Conditional_Expression (Loc,
Expressions => New_List (
......
......@@ -4674,12 +4674,25 @@ package body Sem_Res is
-- Set if corresponding operand might be negative
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;
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;
-- 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))
or else
(Nkind (N) = N_Op_Mod and then (LNeg or RNeg))
......@@ -4959,11 +4972,11 @@ package body Sem_Res is
Set_Entity (Subp, Nam);
if (Is_Array_Type (Ret_Type)
and then Component_Type (Ret_Type) /= Any_Type)
and then Component_Type (Ret_Type) /= Any_Type)
or else
(Is_Access_Type (Ret_Type)
and then Component_Type (Designated_Type (Ret_Type))
/= Any_Type)
and then
Component_Type (Designated_Type (Ret_Type)) /= Any_Type)
then
if Needs_No_Actuals (Nam) then
......
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