From f32c377d6fa1ec4d5c21ca055dd1b7b7c7b75c3a Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 2 Oct 2012 13:05:08 +0000 Subject: [PATCH] 2012-10-02 Ben Brosgol * gnat_rm.texi: Minor editing. 2012-10-02 Ed Schonberg * sem_ch6.adb (Analyze_Function_Return): Reject a return expression whose type is a local access to subprogram type. 2012-10-02 Robert Dewar * sem_eval.adb: Minor improvement to Compile_Time_Compare. 2012-10-02 Robert Dewar * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@191980 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 38 +++++++ gcc/ada/checks.adb | 210 +++++++++++++++++++++++++++-------- gcc/ada/checks.ads | 2 +- gcc/ada/exp_ch4.adb | 304 +++++++++++++++++++++++++++++++++++++-------------- gcc/ada/gnat_rm.texi | 6 +- gcc/ada/sem_ch6.adb | 18 +++ gcc/ada/sem_eval.adb | 18 ++- gcc/ada/sem_res.adb | 2 +- 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 + + * gnat_rm.texi: Minor editing. + +2012-10-02 Ed Schonberg + + * sem_ch6.adb (Analyze_Function_Return): Reject a return + expression whose type is a local access to subprogram type. + +2012-10-02 Robert Dewar + + * sem_eval.adb: Minor improvement to Compile_Time_Compare. + +2012-10-02 Robert Dewar + + * 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 * 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); -- 2.7.4