aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-10-02 15:05:08 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2012-10-02 15:05:08 +0200
commitb6b5cca81b846b91c3a4b35bcedd2294a6ee4dfd (patch)
tree77297aeeb5ef4433fd70088533b5e97a0664932a /gcc/ada
parent6e6636ec8b5044a7ab2b464f6e7d7d71ade42356 (diff)
downloadgcc-b6b5cca81b846b91c3a4b35bcedd2294a6ee4dfd.zip
gcc-b6b5cca81b846b91c3a4b35bcedd2294a6ee4dfd.tar.gz
gcc-b6b5cca81b846b91c3a4b35bcedd2294a6ee4dfd.tar.bz2
[multiple changes]
2012-10-02 Ben Brosgol <brosgol@adacore.com> * gnat_rm.texi: Minor editing. 2012-10-02 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Analyze_Function_Return): Reject a return expression whose type is a local access to subprogram type. 2012-10-02 Robert Dewar <dewar@adacore.com> * sem_eval.adb: Minor improvement to Compile_Time_Compare. 2012-10-02 Robert Dewar <dewar@adacore.com> * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): Fix base type problem that resulted in improper conversion. (Minimize_Eliminate_Overflow_Checks): Properly handle top level case to avoid unnecessary conversion to bignum or LLI. (Minimize_Eliminate_Overflow_Checks): Implement uniform two phase approach for arithmetic operators and for if/case expressions. * checks.ads: Minor comment fix. * exp_ch4.adb (Minimized_Eliminated_Overflow_Check): New function, implements a uniform way of treating minimized/eliminated checks in two phases. (Expand_Compare_Minimize_Eliminate_Overflow): Fix cut and paste error resulting in wrong results for less than in some cases. (Expand_Membership_Minimize_Eliminate_Overflow): Fix error caused by incorrect capture of operand types. (Expand_Membership_Minimize_Eliminate_Overflow): Fix error in handling of bignum case. (Expand_N_Case_Expression): Implement proper two phase handling (Expand_N_If_Expression): Implement proper two phase handling (Expand_N_Op_Abs): Implement proper two phase handling ditto for all other arithmetic operators * sem_res.adb (Resolve_If_Expression): Avoid introducing unneeded conversions. From-SVN: r191980
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog38
-rw-r--r--gcc/ada/checks.adb210
-rw-r--r--gcc/ada/checks.ads2
-rw-r--r--gcc/ada/exp_ch4.adb304
-rw-r--r--gcc/ada/gnat_rm.texi6
-rw-r--r--gcc/ada/sem_ch6.adb18
-rw-r--r--gcc/ada/sem_eval.adb18
-rw-r--r--gcc/ada/sem_res.adb2
8 files changed, 466 insertions, 132 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 837baff..fa3673d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,41 @@
+2012-10-02 Ben Brosgol <brosgol@adacore.com>
+
+ * gnat_rm.texi: Minor editing.
+
+2012-10-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Analyze_Function_Return): Reject a return
+ expression whose type is a local access to subprogram type.
+
+2012-10-02 Robert Dewar <dewar@adacore.com>
+
+ * sem_eval.adb: Minor improvement to Compile_Time_Compare.
+
+2012-10-02 Robert Dewar <dewar@adacore.com>
+
+ * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
+ Fix base type problem that resulted in improper conversion.
+ (Minimize_Eliminate_Overflow_Checks): Properly handle top
+ level case to avoid unnecessary conversion to bignum or LLI.
+ (Minimize_Eliminate_Overflow_Checks): Implement uniform two phase
+ approach for arithmetic operators and for if/case expressions.
+ * checks.ads: Minor comment fix.
+ * exp_ch4.adb (Minimized_Eliminated_Overflow_Check): New function,
+ implements a uniform way of treating minimized/eliminated checks in
+ two phases.
+ (Expand_Compare_Minimize_Eliminate_Overflow): Fix cut and
+ paste error resulting in wrong results for less than in some
+ cases. (Expand_Membership_Minimize_Eliminate_Overflow):
+ Fix error caused by incorrect capture of operand types.
+ (Expand_Membership_Minimize_Eliminate_Overflow): Fix error in
+ handling of bignum case.
+ (Expand_N_Case_Expression): Implement
+ proper two phase handling (Expand_N_If_Expression): Implement
+ proper two phase handling (Expand_N_Op_Abs): Implement proper
+ two phase handling ditto for all other arithmetic operators
+ * sem_res.adb (Resolve_If_Expression): Avoid introducing
+ unneeded conversions.
+
2012-10-02 Robert Dewar <dewar@adacore.com>
* s-bignum.adb (Big_Exp): 0**0 should be 1, not 0.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a31e87b..53be1a6 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -854,7 +854,7 @@ package body Checks is
if Is_Signed_Integer_Type (Typ)
and then Nkind (Parent (N)) = N_Type_Conversion
then
- declare
+ Conversion_Optimization : declare
Target_Type : constant Entity_Id :=
Base_Type (Entity (Subtype_Mark (Parent (N))));
@@ -918,7 +918,7 @@ package body Checks is
end if;
end if;
end if;
- end;
+ end Conversion_Optimization;
end if;
-- Now see if an overflow check is required
@@ -1129,9 +1129,11 @@ package body Checks is
-- top level, we have the proper type. This "undoing" is a point at
-- which a final overflow check may be applied.
- -- If the result type was not fiddled we are all set
+ -- If the result type was not fiddled we are all set. We go to base
+ -- types here because things may have been rewritten to generate the
+ -- base type of the operand types.
- if Etype (Op) = Result_Type then
+ if Base_Type (Etype (Op)) = Base_Type (Result_Type) then
return;
-- Bignum case
@@ -1204,10 +1206,13 @@ package body Checks is
Analyze_And_Resolve (Op);
end;
- -- Here we know the result is Long_Long_Integer'Base
+ -- Here we know the result is Long_Long_Integer'Base, or that it
+ -- has been rewritten because the parent is a conversion (see
+ -- Apply_Arithmetic_Overflow_Check.Conversion_Optimization).
else
- pragma Assert (Etype (Op) = LLIB);
+ pragma Assert
+ (Etype (Op) = LLIB or else Nkind (Parent (Op)) = N_Type_Conversion);
-- All we need to do here is to convert the result to the proper
-- result type. As explained above for the Bignum case, we can
@@ -6682,6 +6687,35 @@ package body Checks is
-- Minimize_Eliminate_Overflow_Checks --
----------------------------------------
+ -- This is a recursive routine that is called at the top of an expression
+ -- tree to properly process overflow checking for a whole subtree by making
+ -- recursive calls to process operands. This processing may involve the use
+ -- of bignum or long long integer arithmetic, which will change the types
+ -- of operands and results. That's why we can't do this bottom up (since
+ -- it would intefere with semantic analysis).
+
+ -- What happens is that if Minimized/Eliminated mode is in effect then
+ -- the operator expansion routines, as well as the expansion routines
+ -- for if/case expression test the Do_Overflow_Check flag and if it is
+ -- set they (for the moment) do nothing except call the routine to apply
+ -- the overflow check (Apply_Arithmetic_Overflow_Check). That routine
+ -- does nothing for non top-level nodes, so at the point where the call
+ -- is made for the top level node, the entire expression subtree has not
+ -- been expanded, or processed for overflow. All that has to happen as a
+ -- result of the top level call to this routine.
+
+ -- As noted above, the overflow processing works by making recursive calls
+ -- for the operands, and figuring out what to do, based on the processing
+ -- of these operands (e.g. if a bignum operand appears, the parent op has
+ -- 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
+ -- to Checked/Suppressed. Either step will avoid the unwanted recursion.
+
procedure Minimize_Eliminate_Overflow_Checks
(N : Node_Id;
Lo : out Uint;
@@ -6743,10 +6777,14 @@ package body Checks is
function In_Result_Range return Boolean is
begin
- if Is_Static_Subtype (Etype (N)) then
+ if Lo = No_Uint or else Hi = No_Uint then
+ return False;
+
+ elsif Is_Static_Subtype (Etype (N)) then
return Lo >= Expr_Value (Type_Low_Bound (Rtyp))
and then
Hi <= Expr_Value (Type_High_Bound (Rtyp));
+
else
return Lo >= Expr_Value (Type_Low_Bound (Base_Type (Rtyp)))
and then
@@ -6853,10 +6891,13 @@ package body Checks is
-- 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).
+ -- converted to long long integer or bignum). We reanalyze to
+ -- complete the expansion of the if expression
elsif not Long_Long_Integer_Operands then
Set_Do_Overflow_Check (N, False);
+ Set_Analyzed (N, False);
+ Analyze_And_Resolve (N, Suppress => Overflow_Check);
-- Otherwise convert us to long long integer mode. Note that we
-- don't need any further overflow checking at this level.
@@ -6865,7 +6906,12 @@ package body Checks is
Convert_To_And_Rewrite (LLIB, Then_DE);
Convert_To_And_Rewrite (LLIB, Else_DE);
Set_Etype (N, LLIB);
+
+ -- Now reanalyze with overflow checks off
+
Set_Do_Overflow_Check (N, False);
+ Set_Analyzed (N, False);
+ Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check);
end if;
end;
@@ -6880,10 +6926,7 @@ package body Checks is
Hi := No_Uint;
declare
- Alt : Node_Id;
- New_Alts : List_Id;
- New_Exp : Node_Id;
- Rtype : Entity_Id;
+ Alt : Node_Id;
begin
-- Loop through expressions applying recursive call
@@ -6915,40 +6958,48 @@ package body Checks is
-- we will properly reexpand and get the needed expansion for
-- the case expression.
- if not (Bignum_Operands or else Long_Long_Integer_Operands) then
+ 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);
-- Otherwise we are going to rebuild the case expression using
-- either bignum or long long integer operands throughout.
else
- New_Alts := New_List;
- Alt := First (Alternatives (N));
- while Present (Alt) loop
- if Bignum_Operands then
- New_Exp := Convert_To_Bignum (Expression (Alt));
- Rtype := RTE (RE_Bignum);
- else
- New_Exp := Convert_To (LLIB, Expression (Alt));
- Rtype := LLIB;
- end if;
+ declare
+ Rtype : Entity_Id;
+ New_Alts : List_Id;
+ New_Exp : Node_Id;
- Append_To (New_Alts,
- Make_Case_Expression_Alternative (Sloc (Alt),
- Actions => No_List,
- Discrete_Choices => Discrete_Choices (Alt),
- Expression => New_Exp));
+ begin
+ New_Alts := New_List;
+ Alt := First (Alternatives (N));
+ while Present (Alt) loop
+ if Bignum_Operands then
+ New_Exp := Convert_To_Bignum (Expression (Alt));
+ Rtype := RTE (RE_Bignum);
+ else
+ New_Exp := Convert_To (LLIB, Expression (Alt));
+ Rtype := LLIB;
+ end if;
- Next (Alt);
- end loop;
+ Append_To (New_Alts,
+ Make_Case_Expression_Alternative (Sloc (Alt),
+ Actions => No_List,
+ Discrete_Choices => Discrete_Choices (Alt),
+ Expression => New_Exp));
- Rewrite (N,
- Make_Case_Expression (Loc,
- Expression => Expression (N),
- Alternatives => New_Alts));
+ Next (Alt);
+ end loop;
+
+ Rewrite (N,
+ Make_Case_Expression (Loc,
+ Expression => Expression (N),
+ Alternatives => New_Alts));
- Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check);
+ Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check);
+ end;
end if;
end;
@@ -6967,7 +7018,17 @@ package body Checks is
(Left_Opnd (N), Llo, Lhi, Top_Level => False);
end if;
- -- If either operand is a bignum, then result will be a bignum
+ -- Record if we have Long_Long_Integer operands
+
+ Long_Long_Integer_Operands :=
+ Etype (Right_Opnd (N)) = LLIB
+ or else (Binary and then Etype (Left_Opnd (N)) = LLIB);
+
+ -- If either operand is a bignum, then result will be a bignum and we
+ -- don't need to do any range analysis. As previously discussed we could
+ -- do range analysis in such cases, but it could mean working with giant
+ -- numbers at compile time for very little gain (the number of cases
+ -- in which we could slip back from bignum mode are small).
if Rlo = No_Uint or else (Binary and then Llo = No_Uint) then
Lo := No_Uint;
@@ -7321,7 +7382,59 @@ package body Checks is
end case;
end if;
- -- Case where we do the operation in Bignum mode. This happens either
+ -- 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.
+
+ 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);
+ return;
+
+ -- Here we know that we are not in the result range, and in the general
+ -- we will move into either the Bignum or Long_Long_Integer domain to
+ -- compute the result. However, there is one exception. If we are at the
+ -- top level, and we do not have Bignum or Long_Long_Integer operands,
+ -- we will have to immediately convert the result back to the result
+ -- type, so there is no point in Bignum/Long_Long_Integer fiddling.
+
+ elsif Top_Level
+ and then not (Bignum_Operands or Long_Long_Integer_Operands)
+ then
+ -- Here we will keep the original types, but we do need an overflow
+ -- check, so we will set Do_Overflow_Check to True (actually it is
+ -- true already, or how would we have got here?).
+
+ pragma Assert (Do_Overflow_Check (N));
+ Set_Analyzed (N, False);
+
+ -- One subtlety. We can't just go ahead and do an analyze operation
+ -- here because it will cause recursion into the whole minimized/
+ -- 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!
+
+ 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;
+
+ return;
+
+ -- Cases where we do the operation in Bignum mode. This happens either
-- because one of our operands is in Bignum mode already, or because
-- the computed bounds are outside the bounds of Long_Long_Integer,
-- which in some cases can be indicated by Hi and Lo being No_Uint.
@@ -7331,10 +7444,10 @@ package body Checks is
-- 0 .. 1, but the cases are rare and it is not worth the effort.
-- Failing to do this switching back is only an efficiency issue.
- if Lo = No_Uint or else Lo < LLLo or else Hi > LLHi then
+ elsif Lo = No_Uint or else Lo < LLLo or else Hi > LLHi then
-- OK, we are definitely outside the range of Long_Long_Integer. The
- -- question is whether to move into Bignum mode, or remain the domain
+ -- question is whether to move to Bignum mode, or stay in the domain
-- of Long_Long_Integer, signalling that an overflow check is needed.
-- Obviously in MINIMIZED mode we stay with LLI, since we are not in
@@ -7440,12 +7553,21 @@ package body Checks is
Set_Do_Overflow_Check (N, False);
end if;
- -- If Result is in range of the result type, and we don't have any
- -- Long_Long_Integer operands, then overflow checking is not needed
- -- and we have nothing to do (we have already reset Do_Overflow_Check).
+ -- Here we are not in Bignum territory, but we may have long long
+ -- integer operands that need special handling. First a special check:
+ -- If an exponentiation operator exponent is of type Long_Long_Integer,
+ -- it means we converted it to prevent overflow, but exponentiation
+ -- requires a Natural right operand, so convert it back to Natural.
+ -- This conversion may raise an exception which is fine.
- if In_Result_Range and not Long_Long_Integer_Operands then
- return;
+ if Nkind (N) = N_Op_Expon and then Etype (Right_Opnd (N)) = LLIB then
+ Convert_To_And_Rewrite (Standard_Natural, Right_Opnd (N));
+
+ -- Now Long_Long_Integer_Operands may have to be reset if that was
+ -- the only long long integer operand, i.e. we now have long long
+ -- integer operands only if the left operand is long long integer.
+
+ Long_Long_Integer_Operands := Etype (Left_Opnd (N)) = LLIB;
end if;
-- Here we will do the operation in Long_Long_Integer. We do this even
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 6478eec..8efaece 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -142,7 +142,7 @@ package Checks is
-- overflow checking for dependent expressions. This routine handles
-- front end vs back end overflow checks (in the front end case it expands
-- the necessary check). Note that divide is handled separately using
- -- Apply_Arithmetic_Divide_Overflow_Check.
+ -- Apply_Divide_Checks.
procedure Apply_Constraint_Check
(N : Node_Id;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 3e30446..dc5a299 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -212,6 +212,21 @@ package body Exp_Ch4 is
-- constrained type (the caller has ensured this by using
-- Convert_To_Actual_Subtype if necessary).
+ function Minimized_Eliminated_Overflow_Check (N : Node_Id) return Boolean;
+ -- For signed arithmetic operations with Do_Overflow_Check set when the
+ -- current overflow mode is MINIMIZED or ELIMINATED, we need to make a
+ -- call to Apply_Arithmetic_Overflow_Checks as the first thing we do. We
+ -- then return. We count on the recursive apparatus for overflow checks
+ -- to call us back with an equivalent operation that does not have the
+ -- Do_Overflow_Check flag set, and that is when we will proceed with the
+ -- expansion of the operator (e.g. converting X+0 to X, or X**2 to X*X).
+ -- We cannot do these optimizations without first making this check, since
+ -- there may be operands further down the tree that are relying on the
+ -- recursive calls triggered by the top level nodes to properly process
+ -- overflow checking and remaining expansion on these nodes. Note that
+ -- this call back may be skipped if the operation is done in Bignum mode
+ -- but that's fine, since the Bignum call takes care of everything.
+
procedure Optimize_Length_Comparison (N : Node_Id);
-- Given an expression, if it is of the form X'Length op N (or the other
-- way round), where N is known at compile time to be 0 or 1, and X is a
@@ -2383,9 +2398,9 @@ package body Exp_Ch4 is
when N_Op_Lt =>
if Llo >= Rhi then
- Set_True;
- elsif Lhi < Rlo then
Set_False;
+ elsif Lhi < Rlo then
+ Set_True;
end if;
when N_Op_Ne =>
@@ -3721,11 +3736,14 @@ package body Exp_Ch4 is
-- Despite the name, this routine applies only to N_In, not to
-- N_Not_In. The latter is always rewritten as not (X in Y).
- Loc : constant Source_Ptr := Sloc (N);
- Lop : constant Node_Id := Left_Opnd (N);
- Rop : constant Node_Id := Right_Opnd (N);
- Ltype : constant Entity_Id := Etype (Lop);
- Rtype : constant Entity_Id := Etype (Rop);
+ Loc : constant Source_Ptr := Sloc (N);
+ Lop : constant Node_Id := Left_Opnd (N);
+ Rop : constant Node_Id := Right_Opnd (N);
+
+ -- Note: there are many referencs to Etype (Lop) and Etype (Rop). It
+ -- is thus tempting to capture these values, but due to the rewrites
+ -- that occur as a result of overflow checking, these values change
+ -- as we go along, and it is safe just to always use Etype explicitly.
Restype : constant Entity_Id := Etype (N);
-- Save result type
@@ -3743,19 +3761,24 @@ package body Exp_Ch4 is
-- predicate, then we can just replace the right operand with an
-- explicit range T'First .. T'Last, and use the explicit range code.
- if Nkind (Rop) /= N_Range and then No (Predicate_Function (Rtype)) then
- Rewrite (Rop,
- Make_Range (Loc,
- Low_Bound =>
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_First,
- Prefix => New_Reference_To (Rtype, Loc)),
-
- High_Bound =>
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Last,
- Prefix => New_Reference_To (Rtype, Loc))));
- Analyze_And_Resolve (Rop, Rtype, Suppress => All_Checks);
+ if Nkind (Rop) /= N_Range
+ and then No (Predicate_Function (Etype (Rop)))
+ then
+ declare
+ Rtyp : constant Entity_Id := Etype (Rop);
+ begin
+ Rewrite (Rop,
+ Make_Range (Loc,
+ Low_Bound =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_First,
+ Prefix => New_Reference_To (Rtyp, Loc)),
+ High_Bound =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Last,
+ Prefix => New_Reference_To (Rtyp, Loc))));
+ Analyze_And_Resolve (Rop, Rtyp, Suppress => All_Checks);
+ end;
end if;
-- Here for the explicit range case. Note that the bounds of the range
@@ -3763,7 +3786,7 @@ package body Exp_Ch4 is
if Nkind (Rop) = N_Range then
Minimize_Eliminate_Overflow_Checks
- (Low_Bound (Rop), Lo, Hi, Top_Level => False);
+ (Low_Bound (Rop), Lo, Hi, Top_Level => False);
Minimize_Eliminate_Overflow_Checks
(High_Bound (Rop), Lo, Hi, Top_Level => False);
@@ -3771,7 +3794,7 @@ package body Exp_Ch4 is
-- Bignum case
- if Is_RTE (Ltype, RE_Bignum)
+ if Is_RTE (Etype (Lop), RE_Bignum)
or else Is_RTE (Etype (Low_Bound (Rop)), RE_Bignum)
or else Is_RTE (Etype (High_Bound (Rop)), RE_Bignum)
then
@@ -3841,9 +3864,9 @@ package body Exp_Ch4 is
else
-- Case where types are all the same
- if Ltype = Etype (Low_Bound (Rop))
+ if Base_Type (Etype (Lop)) = Base_Type (Etype (Low_Bound (Rop)))
and then
- Ltype = Etype (High_Bound (Rop))
+ Base_Type (Etype (Lop)) = Base_Type (Etype (High_Bound (Rop)))
then
null;
@@ -3862,7 +3885,8 @@ package body Exp_Ch4 is
end if;
-- Now the three operands are of the same signed integer type,
- -- so we can use the normal expansion routine for membership.
+ -- so we can use the normal expansion routine for membership,
+ -- setting the flag to prevent recursion into this procedure.
Set_No_Minimize_Eliminate (N);
Expand_N_In (N);
@@ -3873,17 +3897,17 @@ package body Exp_Ch4 is
-- the standard N_In circuitry with appropriate types.
else
- pragma Assert (Present (Predicate_Function (Rtype)));
+ pragma Assert (Present (Predicate_Function (Etype (Rop))));
-- If types are "right", just call Expand_N_In preventing recursion
- if Base_Type (Ltype) = Base_Type (Rtype) then
+ if Base_Type (Etype (Lop)) = Base_Type (Etype (Rop)) then
Set_No_Minimize_Eliminate (N);
Expand_N_In (N);
-- Bignum case
- elsif Is_RTE (Ltype, RE_Bignum) then
+ elsif Is_RTE (Etype (Lop), RE_Bignum) then
-- For X in T, we want to insert code that looks like
@@ -3911,11 +3935,11 @@ package body Exp_Ch4 is
-- A bit gruesome, but here goes.
declare
- Blk : constant Node_Id := Make_Bignum_Block (Loc);
- Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
- Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N);
- Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N);
- Nin : Node_Id;
+ Blk : constant Node_Id := Make_Bignum_Block (Loc);
+ Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+ Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N);
+ Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N);
+ Nin : Node_Id;
begin
-- The last membership test is marked to prevent recursion
@@ -3923,9 +3947,9 @@ package body Exp_Ch4 is
Nin :=
Make_In (Loc,
Left_Opnd =>
- Convert_To (Base_Type (Rtype),
+ Convert_To (Base_Type (Etype (Rop)),
New_Occurrence_Of (Lnn, Loc)),
- Right_Opnd => New_Occurrence_Of (Rtype, Loc));
+ Right_Opnd => New_Occurrence_Of (Etype (Rop), Loc));
Set_No_Minimize_Eliminate (Nin);
-- Now decorate the block
@@ -3985,7 +4009,7 @@ package body Exp_Ch4 is
New_Occurrence_Of (Lnn, Loc),
Right_Opnd =>
New_Occurrence_Of
- (Base_Type (Rtype), Loc)),
+ (Base_Type (Etype (Rop)), Loc)),
Right_Opnd => Nin))))));
Insert_Actions (N, New_List (
@@ -4001,10 +4025,10 @@ package body Exp_Ch4 is
end;
-- Not bignum case, but types don't match (this means we rewrote the
- -- left operand to be Long_Long_Integer.
+ -- left operand to be Long_Long_Integer).
else
- pragma Assert (Base_Type (Ltype) = LLIB);
+ pragma Assert (Base_Type (Etype (Lop)) = LLIB);
-- We rewrite the membership test as
@@ -4019,8 +4043,9 @@ package body Exp_Ch4 is
Nin :=
Make_In (Loc,
Left_Opnd =>
- Convert_To (Base_Type (Rtype), Duplicate_Subexpr (Lop)),
- Right_Opnd => New_Occurrence_Of (Rtype, Loc));
+ Convert_To (Base_Type (Etype (Rop)),
+ Duplicate_Subexpr (Lop)),
+ Right_Opnd => New_Occurrence_Of (Etype (Rop), Loc));
Set_No_Minimize_Eliminate (Nin);
-- Now do the rewrite
@@ -4031,7 +4056,7 @@ package body Exp_Ch4 is
Make_In (Loc,
Left_Opnd => Lop,
Right_Opnd =>
- New_Occurrence_Of (Base_Type (Ltype), Loc)),
+ New_Occurrence_Of (Base_Type (Etype (Lop)), Loc)),
Right_Opnd => Nin));
Analyze_And_Resolve (N, Restype, Suppress => All_Checks);
@@ -4776,14 +4801,9 @@ package body Exp_Ch4 is
Fexp : Node_Id;
begin
- -- If Do_Overflow_Check is set, it means we are in MINIMIZED/ELIMINATED
- -- mode, and all we do is to call Apply_Arithmetic_Overflow_Check to
- -- ensure proper overflow handling for the dependent expressions. The
- -- checks circuitry will rewrite the case expression in this case with
- -- Do_Overflow_Checks off. so that when that rewritten node arrives back
- -- here, then we will do the full expansion.
-
- if Do_Overflow_Check (N) then
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
@@ -5170,6 +5190,13 @@ package body Exp_Ch4 is
New_N : Node_Id;
begin
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
-- Fold at compile time if condition known. We have already folded
-- static if expressions, but it is possible to fold any case in which
-- the condition is known at compile time, even though the result is
@@ -5383,15 +5410,6 @@ package body Exp_Ch4 is
-- the same approach as a C conditional expression.
else
- -- If Do_Overflow_Check is set it means we have a signed intger type
- -- in MINIMIZED or ELIMINATED mode, so we apply an overflow check to
- -- the if expression (to make sure that overflow checking is properly
- -- handled for dependent expressions).
-
- if Do_Overflow_Check (N) then
- Apply_Arithmetic_Overflow_Check (N);
- end if;
-
return;
end if;
@@ -5500,18 +5518,35 @@ package body Exp_Ch4 is
-- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid
- -- test and give a warning. For floating point types however, this is a
- -- standard way to check for finite numbers, and using 'Valid would
- -- typically be a pessimization. Also skip this test for predicated
- -- types, since it is perfectly reasonable to check if a value meets
- -- its predicate.
+ -- test and give a warning for scalar types.
if Is_Scalar_Type (Ltyp)
+
+ -- Only relevant for source comparisons
+
+ and then Comes_From_Source (N)
+
+ -- In floating-point this is a standard way to check for finite values
+ -- and using 'Valid would typically be a pessimization.
+
and then not Is_Floating_Point_Type (Ltyp)
+
+ -- Don't give the message unless right operand is a type entity and
+ -- the type of the left operand matches this type. Note that this
+ -- eliminates the cases where MINIMIZED/ELIMINATED mode overflow
+ -- checks have changed the type of the left operand.
+
and then Nkind (Rop) in N_Has_Entity
and then Ltyp = Entity (Rop)
- and then Comes_From_Source (N)
+
+ -- Skip in VM mode, where we have no sense of invalid values. The
+ -- warning still seems relevant, but not important enough to worry.
+
and then VM_Target = No_VM
+
+ -- Skip this for predicated types, where such expressions are a
+ -- reasonable way of testing if something meets the predicate.
+
and then not (Is_Discrete_Type (Ltyp)
and then Present (Predicate_Function (Ltyp)))
then
@@ -5564,15 +5599,30 @@ package body Exp_Ch4 is
-- Could use some individual comments for this complex test ???
if Is_Scalar_Type (Ltyp)
+
+ -- And left operand is X'First where X matches left operand
+ -- type (this eliminates cases of type mismatch, including
+ -- the cases where ELIMINATED/MINIMIZED mode has changed the
+ -- type of the left operand.
+
and then Nkind (Lo_Orig) = N_Attribute_Reference
and then Attribute_Name (Lo_Orig) = Name_First
and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity
and then Entity (Prefix (Lo_Orig)) = Ltyp
+
+ -- Same tests for right operand
+
and then Nkind (Hi_Orig) = N_Attribute_Reference
and then Attribute_Name (Hi_Orig) = Name_Last
and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity
and then Entity (Prefix (Hi_Orig)) = Ltyp
+
+ -- Relevant only for source cases
+
and then Comes_From_Source (N)
+
+ -- Omit for VM cases, where we don't have invalid values
+
and then VM_Target = No_VM
then
Substitute_Valid_Check;
@@ -6331,6 +6381,13 @@ package body Exp_Ch4 is
begin
Unary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
-- Deal with software overflow checking
if not Backend_Overflow_Checks_On_Target
@@ -6374,6 +6431,13 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
-- N + 0 = 0 + N = N for integer types
if Is_Integer_Type (Typ) then
@@ -6516,6 +6580,15 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
+ -- Otherwise proceed with expansion of division
+
if Rknow then
Rval := Expr_Value (Ropnd);
end if;
@@ -7284,19 +7357,9 @@ package body Exp_Ch4 is
end;
end if;
- -- Normally we complete expansion of exponentiation (e.g. converting
- -- to multplications) right here, but there is one exception to this.
- -- If we have a signed integer type and the overflow checking mode
- -- is MINIMIZED or ELIMINATED and overflow checking is activated, then
- -- we don't yet want to expand, since that will intefere with handling
- -- of extended precision intermediate value. In this situation we just
- -- apply the arithmetic overflow check, and then the overflow check
- -- circuit will re-expand the exponentiation node in CHECKED mode.
+ -- Check for MINIMIZED/ELIMINATED overflow mode
- if Is_Signed_Integer_Type (Rtyp)
- and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated
- and then Do_Overflow_Check (N)
- then
+ if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
@@ -7792,6 +7855,13 @@ package body Exp_Ch4 is
begin
Unary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
if not Backend_Overflow_Checks_On_Target
and then Is_Signed_Integer_Type (Etype (N))
and then Do_Overflow_Check (N)
@@ -7819,11 +7889,12 @@ package body Exp_Ch4 is
procedure Expand_N_Op_Mod (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
DOC : constant Boolean := Do_Overflow_Check (N);
DDC : constant Boolean := Do_Division_Check (N);
+ Left : Node_Id;
+ Right : Node_Id;
+
LLB : Uint;
Llo : Uint;
Lhi : Uint;
@@ -7837,10 +7908,29 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
if Is_Integer_Type (Etype (N)) then
Apply_Divide_Checks (N);
+
+ -- All done if we don't have a MOD any more, which can happen as a
+ -- result of overflow expansion in MINIMIZED or ELIMINATED modes.
+
+ if Nkind (N) /= N_Op_Mod then
+ return;
+ end if;
end if;
+ -- Proceed with expansion of mod operator
+
+ Left := Left_Opnd (N);
+ Right := Right_Opnd (N);
+
Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
@@ -7960,6 +8050,13 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
-- Special optimizations for integer types
if Is_Integer_Type (Typ) then
@@ -8482,6 +8579,13 @@ package body Exp_Ch4 is
procedure Expand_N_Op_Plus (N : Node_Id) is
begin
Unary_Op_Validity_Checks (N);
+
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
end Expand_N_Op_Plus;
---------------------
@@ -8492,8 +8596,8 @@ package body Exp_Ch4 is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
+ Left : Node_Id;
+ Right : Node_Id;
Lo : Uint;
Hi : Uint;
@@ -8508,10 +8612,29 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
if Is_Integer_Type (Etype (N)) then
Apply_Divide_Checks (N);
+
+ -- All done if we don't have a REM any more, which can happen as a
+ -- result of overflow expansion in MINIMIZED or ELIMINATED modes.
+
+ if Nkind (N) /= N_Op_Rem then
+ return;
+ end if;
end if;
+ -- Proceed with expansion of REM
+
+ Left := Left_Opnd (N);
+ Right := Right_Opnd (N);
+
-- Apply optimization x rem 1 = 0. We don't really need that with gcc,
-- but it is useful with other back ends (e.g. AAMP), and is certainly
-- harmless.
@@ -8624,6 +8747,13 @@ package body Exp_Ch4 is
begin
Binary_Op_Validity_Checks (N);
+ -- Check for MINIMIZED/ELIMINATED overflow mode
+
+ if Minimized_Eliminated_Overflow_Check (N) then
+ Apply_Arithmetic_Overflow_Check (N);
+ return;
+ end if;
+
-- N - 0 = N for integer types
if Is_Integer_Type (Typ)
@@ -11626,6 +11756,18 @@ package body Exp_Ch4 is
return Func_Body;
end Make_Boolean_Array_Op;
+ -----------------------------------------
+ -- Minimized_Eliminated_Overflow_Check --
+ -----------------------------------------
+
+ function Minimized_Eliminated_Overflow_Check (N : Node_Id) return Boolean is
+ begin
+ return
+ Is_Signed_Integer_Type (Etype (N))
+ and then Do_Overflow_Check (N)
+ and then Overflow_Check_Mode (Empty) in Minimized_Or_Eliminated;
+ end Minimized_Eliminated_Overflow_Check;
+
--------------------------------
-- Optimize_Length_Comparison --
--------------------------------
@@ -12216,7 +12358,7 @@ package body Exp_Ch4 is
end if;
end Is_Safe_Operand;
- -- Start of processing for Is_Safe_In_Place_Array_Op
+ -- Start of processing for Safe_In_Place_Array_Op
begin
-- Skip this processing if the component size is different from system
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5f2270f..9e875bc 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -4147,7 +4147,8 @@ MODE ::= SUPPRESSED | CHECKED | MINIMIZED | ELIMINATED
@noindent
This pragma sets the current overflow mode to the given mode. For details
-of the meaning of these modes, see section on overflow checking in the
+of the meaning of these modes, please refer to the
+``Overflow Check Handling in GNAT'' appendix in the
@value{EDITION} User's Guide. If only the @code{General} parameter is present,
the given mode applies to all expressions. If both parameters are present,
the @code{General} mode applies to expressions outside assertions, and
@@ -4169,6 +4170,7 @@ The pragma @code{Suppress (Overflow_Check)} sets mode
General => Suppressed
@end smallexample
+@noindent
suppressing all overflow checking within and outside
assertions.
@@ -4178,9 +4180,11 @@ The pragam @code{Unsuppress (Overflow_Check)} sets mode
General => Checked
@end smallexample
+@noindent
which causes overflow checking of all intermediate overflows.
This applies both inside and outside assertions.
+
@node Pragma Passive
@unnumberedsec Pragma Passive
@findex Passive
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 2afc4ee..098f943 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -869,6 +869,24 @@ package body Sem_Ch6 is
then
Rewrite (Expr, Convert_To (R_Type, Relocate_Node (Expr)));
Analyze_And_Resolve (Expr, R_Type);
+
+ -- If this is a local anonymous access to subprogram, the
+ -- accessibility check can be applied statically. The return is
+ -- illegal if the access type of the return expression is declared
+ -- inside of the subprogram (except if it is the subtype indication
+ -- of an extended return statement).
+
+ elsif Ekind (R_Type) = E_Anonymous_Access_Subprogram_Type then
+ if not Comes_From_Source (Current_Scope)
+ or else Ekind (Current_Scope) = E_Return_Statement
+ then
+ null;
+
+ elsif
+ Scope_Depth (Scope (Etype (Expr))) >= Scope_Depth (Scope_Id)
+ then
+ Error_Msg_N ("cannot return local access to subprogram", N);
+ end if;
end if;
-- If the result type is class-wide, then check that the return
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 3d13e9c..116864a 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -949,21 +949,31 @@ package body Sem_Eval is
LLo, LHi : Uint;
RLo, RHi : Uint;
+ Single : Boolean;
+ -- True if each range is a single point
+
begin
Determine_Range (L, LOK, LLo, LHi, Assume_Valid);
Determine_Range (R, ROK, RLo, RHi, Assume_Valid);
if LOK and ROK then
+ Single := (LLo = LHi) and then (RLo = RHi);
+
if LHi < RLo then
+ if Single and Assume_Valid then
+ Diff.all := RLo - LLo;
+ end if;
+
return LT;
elsif RHi < LLo then
+ if Single and Assume_Valid then
+ Diff.all := LLo - RLo;
+ end if;
+
return GT;
- elsif LLo = LHi
- and then RLo = RHi
- and then LLo = RLo
- then
+ elsif Single and then LLo = RLo then
-- If the range includes a single literal and we can assume
-- validity then the result is known even if an operand is
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e50bcc9..5095088 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7162,7 +7162,7 @@ package body Sem_Res is
-- a constraint check.
if Is_Scalar_Type (Then_Typ)
- and then Then_Typ /= Typ
+ and then Base_Type (Then_Typ) /= Base_Type (Typ)
then
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
Analyze_And_Resolve (Then_Expr, Typ);