with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Elists; use Elists;
+with Expander; use Expander;
with Eval_Fat; use Eval_Fat;
with Freeze; use Freeze;
with Lib; use Lib;
Apply_Range_Check (N, Typ);
end if;
- elsif (Is_Record_Type (Typ)
- or else Is_Private_Type (Typ))
+ elsif (Is_Record_Type (Typ) or else Is_Private_Type (Typ))
and then Has_Discriminants (Base_Type (Typ))
and then Is_Constrained (Typ)
then
-- to be done in bignum mode), and the determined ranges of the operands.
-- After possible rewriting of a constituent subexpression node, a call is
- -- made to reanalyze the node after setting Analyzed to False. To avoid a
- -- recursive call into the whole overflow apparatus, and important rule for
- -- this reanalysis call is that either Do_Overflow_Check must be False, or
- -- if it is set, then the overflow checking mode must be temporarily set
+ -- made to either reexpand the node (if nothing has changed) or reanalyze
+ -- the node (if it has been modified by the overflow check processing).
+ -- The Analyzed_flag is set False before the reexpand/reanalyze. To avoid
+ -- a recursive call into the whole overflow apparatus, and important rule
+ -- for this call is that either Do_Overflow_Check must be False, or if
+ -- it is set, then the overflow checking mode must be temporarily set
-- to Checked/Suppressed. Either step will avoid the unwanted recursion.
procedure Minimize_Eliminate_Overflow_Checks
-- range, then we must convert such operands back to the result type.
-- This switch is properly set only when Bignum_Operands is False.
+ procedure Reexpand (C : Suppressed_Or_Checked);
+ -- This is called when we have not modifed the node, so we do not need
+ -- to reanalyze it. But we do want to reexpand it in either CHECKED
+ -- or SUPPRESSED mode (as indicated by the argument C) to get proper
+ -- expansion. It is important that we reset the mode to SUPPRESSED or
+ -- CHECKED, since if we leave it in MINIMIZED or ELIMINATED mode we
+ -- would reenter this routine recursively which would not be good!
+ -- Note that this is not just an optimization, testing has showed up
+ -- several complex cases in which renalyzing an already analyzed node
+ -- causes incorrect behavior.
+
function In_Result_Range return Boolean;
-- Returns True iff Lo .. Hi are within range of the result type
end if;
end Min;
+ --------------
+ -- Reexpand --
+ --------------
+
+ procedure Reexpand (C : Suppressed_Or_Checked) is
+ Svg : constant Overflow_Check_Type :=
+ Scope_Suppress.Overflow_Checks_General;
+ Sva : constant Overflow_Check_Type :=
+ Scope_Suppress.Overflow_Checks_Assertions;
+ begin
+ Scope_Suppress.Overflow_Checks_General := C;
+ Scope_Suppress.Overflow_Checks_Assertions := C;
+ Set_Analyzed (N, False);
+ Expand (N);
+ Scope_Suppress.Overflow_Checks_General := Svg;
+ Scope_Suppress.Overflow_Checks_Assertions := Sva;
+ end Reexpand;
+
-- Start of processing for Minimize_Eliminate_Overflow_Checks
begin
-- If we have no Long_Long_Integer operands, then we are in result
-- range, since it means that none of our operands felt the need
-- to worry about overflow (otherwise it would have already been
- -- converted to long long integer or bignum). We reanalyze to
- -- complete the expansion of the if expression
+ -- converted to long long integer or bignum). We reexpand to
+ -- complete the expansion of the if expression (but we do not
+ -- need to reanalyze).
elsif not Long_Long_Integer_Operands then
Set_Do_Overflow_Check (N, False);
- Set_Analyzed (N, False);
- Analyze_And_Resolve (N, Suppress => Overflow_Check);
+ Reexpand (Suppressed);
-- Otherwise convert us to long long integer mode. Note that we
-- don't need any further overflow checking at this level.
-- that none of our dependent expressions could raise overflow.
-- In this case, we simply return with no changes except for
-- resetting the overflow flag, since we are done with overflow
- -- checks for this node. We will reset the Analyzed flag so that
- -- we will properly reexpand and get the needed expansion for
- -- the case expression.
+ -- checks for this node. We will reexpand to get the needed
+ -- expansion for the case expression, but we do not need to
+ -- renalyze, since nothing has changed.
if not (Bignum_Operands or Long_Long_Integer_Operands) then
Set_Do_Overflow_Check (N, False);
- Set_Analyzed (N, False);
- Analyze_And_Resolve (N, Suppress => Overflow_Check);
+ Reexpand (Suppressed);
-- Otherwise we are going to rebuild the case expression using
-- either bignum or long long integer operands throughout.
end case;
end if;
- -- If we know we are in the result range, and we do not have Bignum
- -- operands or Long_Long_Integer operands, we can just renalyze with
- -- overflow checks turned off (since we know we cannot have overflow).
- -- As always the reanalysis is required to complete expansion of the
- -- operator, and we prevent recursion by suppressing the check.
+ -- Here for the case where we have not rewritten anything (no bignum
+ -- operands or long long integer operands), and we know the result If we
+ -- know we are in the result range, and we do not have Bignum operands
+ -- or Long_Long_Integer operands, we can just reexpand with overflow
+ -- checks turned off (since we know we cannot have overflow). As always
+ -- the reexpansion is required to complete expansion of the operator,
+ -- but we do not need to reanalyze, and we prevent recursion by
+ -- suppressing the check,
if not (Bignum_Operands or Long_Long_Integer_Operands)
and then In_Result_Range
then
Set_Do_Overflow_Check (N, False);
- Set_Analyzed (N, False);
- Analyze_And_Resolve (N, Suppress => Overflow_Check);
+ Reexpand (Suppressed);
return;
-- Here we know that we are not in the result range, and in the general
-- eliminated overflow processing which is not what we want. Here
-- we are at the top level, and we need a check against the result
-- mode (i.e. we want to use Checked mode). So do exactly that!
+ -- Also, we have not modified the node, so this is a case where
+ -- we need to reexpand, but not reanalyze.
- declare
- Svg : constant Overflow_Check_Type :=
- Scope_Suppress.Overflow_Checks_General;
- Sva : constant Overflow_Check_Type :=
- Scope_Suppress.Overflow_Checks_Assertions;
- begin
- Scope_Suppress.Overflow_Checks_General := Checked;
- Scope_Suppress.Overflow_Checks_Assertions := Checked;
- Analyze_And_Resolve (N);
- Scope_Suppress.Overflow_Checks_General := Svg;
- Scope_Suppress.Overflow_Checks_Assertions := Sva;
- end;
-
+ Reexpand (Checked);
return;
-- Cases where we do the operation in Bignum mode. This happens either
end if;
end if;
- -- Try range analysis on variables and see if ranges are disjoint
+ -- First attempt is to decompose the expressions to extract a
+ -- constant offset resulting from the use of any of the forms:
+
+ -- expr + literal
+ -- expr - literal
+ -- typ'Succ (expr)
+ -- typ'Pred (expr)
+
+ -- Then we see if the two expressions are the same value, and if so
+ -- the result is obtained by comparing the offsets.
+
+ -- Note: the reason we do this test first is that it returns only
+ -- decisive results (with diff set), where other tests, like the
+ -- range test, may not be as so decisive. Consider for example
+ -- J .. J + 1. This code can conclude LT with a difference of 1,
+ -- even if the range of J is not known.
+
+ declare
+ Lnode : Node_Id;
+ Loffs : Uint;
+ Rnode : Node_Id;
+ Roffs : Uint;
+
+ begin
+ Compare_Decompose (L, Lnode, Loffs);
+ Compare_Decompose (R, Rnode, Roffs);
+
+ if Is_Same_Value (Lnode, Rnode) then
+ if Loffs = Roffs then
+ return EQ;
+
+ elsif Loffs < Roffs then
+ Diff.all := Roffs - Loffs;
+ return LT;
+
+ else
+ Diff.all := Loffs - Roffs;
+ return GT;
+ end if;
+ end if;
+ end;
+
+ -- Next, try range analysis and see if operand ranges are disjoint
declare
LOK, ROK : Boolean;
end if;
end if;
- -- Next attempt is to decompose the expressions to extract
- -- a constant offset resulting from the use of any of the forms:
-
- -- expr + literal
- -- expr - literal
- -- typ'Succ (expr)
- -- typ'Pred (expr)
-
- -- Then we see if the two expressions are the same value, and if so
- -- the result is obtained by comparing the offsets.
-
- declare
- Lnode : Node_Id;
- Loffs : Uint;
- Rnode : Node_Id;
- Roffs : Uint;
-
- begin
- Compare_Decompose (L, Lnode, Loffs);
- Compare_Decompose (R, Rnode, Roffs);
-
- if Is_Same_Value (Lnode, Rnode) then
- if Loffs = Roffs then
- return EQ;
-
- elsif Loffs < Roffs then
- Diff.all := Roffs - Loffs;
- return LT;
-
- else
- Diff.all := Loffs - Roffs;
- return GT;
- end if;
- end if;
- end;
-
-- Next attempt is to see if we have an entity compared with a
-- compile time known value, where there is a current value
-- conditional for the entity which can tell us the result.
projects / platform / upstream / gcc.git / commitdiff