From a7f1b24f810a5f3312fee91a63f507da952498f3 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 6 Nov 2012 11:11:15 +0000 Subject: [PATCH] checks.ads, [...]: Minor changes throughout for new overflow checking. 2012-11-06 Robert Dewar * checks.ads, checks.adb, exp_ch4.adb: Minor changes throughout for new overflow checking. * exp_util.adb (Insert_Actions): Remove special casing of Overflow_Check. * gnat1drv.adb (Adjust_Global_Switches): Fixes for new handling of overflow checks. * sem.adb (Analyze): Remove special casing of Overflow_Check (Analyze_List): ditto. * sem_prag.adb (Analyze_Pragma, case Overflow_Checks): Remove SUPPRESSED and change CHECKED to STRICT. * sem_res.adb (Analyze_And_Resolve): No longer treat Overflow_Check specially. (Preanalyze_And_Resolve): ditto. (Resolve): ditto. * snames.ads-tmpl: Replace Name_Checked by Name_Strict. * switch-c.adb (Get_Overflow_Mode): Eliminate 0 setting, CHECKED => STRICT. * types.ads (Overflow_Check_Type): Remove Suppressed, change Checked to Strict (Suppress_Record): Overflow check controlled by Suppress array. From-SVN: r193233 --- gcc/ada/ChangeLog | 23 ++++ gcc/ada/checks.adb | 315 +++++++++++++++++++++++++++--------------------- gcc/ada/checks.ads | 45 +++---- gcc/ada/exp_ch4.adb | 47 ++++---- gcc/ada/exp_util.adb | 8 +- gcc/ada/gnat1drv.adb | 72 ++++++----- gcc/ada/sem.adb | 64 +++------- gcc/ada/sem_prag.adb | 39 ++---- gcc/ada/sem_res.adb | 88 ++++---------- gcc/ada/snames.ads-tmpl | 2 +- gcc/ada/switch-c.adb | 17 +-- gcc/ada/types.ads | 59 ++++----- 12 files changed, 370 insertions(+), 409 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cfa05a2..d2c739f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2012-11-06 Robert Dewar + + * checks.ads, checks.adb, exp_ch4.adb: Minor changes throughout for + new overflow checking. + * exp_util.adb (Insert_Actions): Remove special casing of + Overflow_Check. + * gnat1drv.adb (Adjust_Global_Switches): Fixes for new handling + of overflow checks. + * sem.adb (Analyze): Remove special casing of Overflow_Check + (Analyze_List): ditto. + * sem_prag.adb (Analyze_Pragma, case Overflow_Checks): Remove + SUPPRESSED and change CHECKED to STRICT. + * sem_res.adb (Analyze_And_Resolve): No longer treat + Overflow_Check specially. + (Preanalyze_And_Resolve): ditto. + (Resolve): ditto. + * snames.ads-tmpl: Replace Name_Checked by Name_Strict. + * switch-c.adb (Get_Overflow_Mode): Eliminate 0 setting, + CHECKED => STRICT. + * types.ads (Overflow_Check_Type): Remove Suppressed, change + Checked to Strict (Suppress_Record): Overflow check controlled + by Suppress array. + 2012-11-06 Ed Schonberg * sem_res.adb (Preanalyze_And_Resolve): In Alfa mode do not diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 406d292..b0262db 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -194,18 +194,19 @@ package body Checks is -- Local Subprograms -- ----------------------- - procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id); + procedure Apply_Arithmetic_Overflow_Strict (N : Node_Id); -- Used to apply arithmetic overflow checks for all cases except operators -- on signed arithmetic types in MINIMIZED/ELIMINATED case (for which we - -- call Apply_Arithmetic_Overflow_Minimized_Eliminated below). N is always - -- a signed integer arithmetic operator (if and case expressions are not - -- included for this case). + -- call Apply_Arithmetic_Overflow_Minimized_Eliminated below). N can be a + -- signed integer arithmetic operator (but not an if or case expression). + -- It is also called for types other than signed integers. procedure Apply_Arithmetic_Overflow_Minimized_Eliminated (Op : Node_Id); -- Used to apply arithmetic overflow checks for the case where the overflow - -- checking mode is MINIMIZED or ELIMINATED (and the Do_Overflow_Check flag - -- is known to be set) and we have a signed integer arithmetic op (which - -- includes the case of if and case expressions). + -- checking mode is MINIMIZED or ELIMINATED and we have a signed integer + -- arithmetic op (which includes the case of if and case expressions). Note + -- that Do_Overflow_Check may or may not be set for node Op. In these modes + -- we have work to do even if overflow checking is suppressed. procedure Apply_Division_Check (N : Node_Id; @@ -766,14 +767,12 @@ package body Checks is begin -- Use old routine in almost all cases (the only case we are treating -- specially is the case of a signed integer arithmetic op with the - -- Do_Overflow_Check flag set on the node, and the overflow checking - -- mode is MINIMIZED or ELIMINATED). + -- overflow checking mode set to MINIMIZED or ELIMINATED). - if Overflow_Check_Mode (Etype (N)) not in Minimized_Or_Eliminated - or else not Do_Overflow_Check (N) + if Overflow_Check_Mode = Strict or else not Is_Signed_Integer_Arithmetic_Op (N) then - Apply_Arithmetic_Overflow_Checked_Suppressed (N); + Apply_Arithmetic_Overflow_Strict (N); -- Otherwise use the new routine for the case of a signed integer -- arithmetic op, with Do_Overflow_Check set to True, and the checking @@ -784,9 +783,9 @@ package body Checks is end if; end Apply_Arithmetic_Overflow_Check; - -------------------------------------------------- - -- Apply_Arithmetic_Overflow_Checked_Suppressed -- - -------------------------------------------------- + -------------------------------------- + -- Apply_Arithmetic_Overflow_Strict -- + -------------------------------------- -- This routine is called only if the type is an integer type, and a -- software arithmetic overflow check may be needed for op (add, subtract, @@ -795,21 +794,28 @@ package body Checks is -- operation into a more complex sequence of tests that ensures that -- overflow is properly caught. - -- This is used in SUPPRESSED/CHECKED modes. It is identical to the - -- code for these cases before the big overflow earthquake, thus ensuring - -- that in these modes we have compatible behavior (and reliability) to - -- what was there before. It is also called for types other than signed - -- integers, and if the Do_Overflow_Check flag is off. + -- This is used in CHECKED modes. It is identical to the code for this + -- cases before the big overflow earthquake, thus ensuring that in this + -- modes we have compatible behavior (and reliability) to what was there + -- before. It is also called for types other than signed integers, and if + -- the Do_Overflow_Check flag is off. -- Note: we also call this routine if we decide in the MINIMIZED case -- to give up and just generate an overflow check without any fuss. - procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id) is + procedure Apply_Arithmetic_Overflow_Strict (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); Rtyp : constant Entity_Id := Root_Type (Typ); begin + -- Nothing to do if Do_Overflow_Check not set or overflow checks + -- suppressed. + + if not Do_Overflow_Check (N) then + return; + end if; + -- An interesting special case. If the arithmetic operation appears as -- the operand of a type conversion: @@ -1067,7 +1073,7 @@ package body Checks is when RE_Not_Available => return; end; - end Apply_Arithmetic_Overflow_Checked_Suppressed; + end Apply_Arithmetic_Overflow_Strict; ---------------------------------------------------- -- Apply_Arithmetic_Overflow_Minimized_Eliminated -- @@ -1075,7 +1081,6 @@ package body Checks is procedure Apply_Arithmetic_Overflow_Minimized_Eliminated (Op : Node_Id) is pragma Assert (Is_Signed_Integer_Arithmetic_Op (Op)); - pragma Assert (Do_Overflow_Check (Op)); Loc : constant Source_Ptr := Sloc (Op); P : constant Node_Id := Parent (Op); @@ -1086,8 +1091,7 @@ package body Checks is Result_Type : constant Entity_Id := Etype (Op); -- Original result type - Check_Mode : constant Overflow_Check_Type := - Overflow_Check_Mode (Etype (Op)); + Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode; pragma Assert (Check_Mode in Minimized_Or_Eliminated); Lo, Hi : Uint; @@ -1102,7 +1106,7 @@ package body Checks is -- In all these cases, we will process at the higher level (and then -- this node will be processed during the downwards recursion that - -- is part of the processing in Minimize_Eliminate_Overflow_Checks). + -- is part of the processing in Minimize_Eliminate_Overflows). if Is_Signed_Integer_Arithmetic_Op (P) or else Nkind (P) in N_Membership_Test @@ -1127,7 +1131,7 @@ package body Checks is -- will still be in Bignum mode if either of its operands are of type -- Bignum). - Minimize_Eliminate_Overflow_Checks (Op, Lo, Hi, Top_Level => True); + Minimize_Eliminate_Overflows (Op, Lo, Hi, Top_Level => True); -- That call may but does not necessarily change the result type of Op. -- It is the job of this routine to undo such changes, so that at the @@ -1213,7 +1217,7 @@ package body Checks is -- Here we know the result is Long_Long_Integer'Base, of that it has -- been rewritten because the parent operation is a conversion. See - -- Apply_Arithmetic_Overflow_Checked_Suppressed.Conversion_Optimization. + -- Apply_Arithmetic_Overflow_Strict.Conversion_Optimization. else pragma Assert @@ -1678,7 +1682,7 @@ package body Checks is Left : constant Node_Id := Left_Opnd (N); Right : constant Node_Id := Right_Opnd (N); - Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Typ); + Mode : constant Overflow_Check_Type := Overflow_Check_Mode; -- Current overflow checking mode LLB : Uint; @@ -1693,15 +1697,13 @@ package body Checks is -- Don't actually use this value begin - -- If we are operating in MINIMIZED or ELIMINATED mode, and the - -- Do_Overflow_Check flag is set and we are operating on signed - -- integer types, then the only thing this routine does is to call - -- Apply_Arithmetic_Overflow_Minimized_Eliminated. That procedure will - -- (possibly later on during recursive downward calls), make sure that - -- any needed overflow and division checks are properly applied. + -- If we are operating in MINIMIZED or ELIMINATED mode, and we are + -- operating on signed integer types, then the only thing this routine + -- does is to call Apply_Arithmetic_Overflow_Minimized_Eliminated. That + -- procedure will (possibly later on during recursive downward calls), + -- ensure that any needed overflow/division checks are properly applied. if Mode in Minimized_Or_Eliminated - and then Do_Overflow_Check (N) and then Is_Signed_Integer_Type (Typ) then Apply_Arithmetic_Overflow_Minimized_Eliminated (N); @@ -1726,7 +1728,9 @@ package body Checks is -- Deal with overflow check - if Do_Overflow_Check (N) and then Mode /= Suppressed then + if Do_Overflow_Check (N) + and then not Overflow_Checks_Suppressed (Etype (N)) + then -- Test for extremely annoying case of xxx'First divided by -1 -- for division of signed integer types (only overflow case). @@ -3093,6 +3097,7 @@ package body Checks is begin if not Overflow_Checks_Suppressed (Target_Base) + and then not Overflow_Checks_Suppressed (Target_Type) and then not In_Subrange_Of (Expr_Type, Target_Base, Fixed_Int => Conv_OK) and then not Float_To_Int @@ -4420,7 +4425,7 @@ package body Checks is procedure Enable_Overflow_Check (N : Node_Id) is Typ : constant Entity_Id := Base_Type (Etype (N)); - Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Etype (N)); + Mode : constant Overflow_Check_Type := Overflow_Check_Mode; Chk : Nat; OK : Boolean; Ent : Entity_Id; @@ -4438,7 +4443,7 @@ package body Checks is -- No check if overflow checks suppressed for type of node - if Mode = Suppressed then + if Overflow_Checks_Suppressed (Etype (N)) then return; -- Nothing to do for unsigned integer types, which do not overflow @@ -4447,23 +4452,28 @@ package body Checks is return; end if; - -- This is the point at which processing for CHECKED mode diverges + -- This is the point at which processing for STRICT mode diverges -- from processing for MINIMIZED/ELIMINATED modes. This divergence is -- probably more extreme that it needs to be, but what is going on here -- is that when we introduced MINIMIZED/ELIMINATED modes, we wanted - -- to leave the processing for CHECKED mode untouched. There were + -- to leave the processing for STRICT mode untouched. There were -- two reasons for this. First it avoided any incompatible change of - -- behavior. Second, it guaranteed that CHECKED mode continued to be + -- behavior. Second, it guaranteed that STRICT mode continued to be -- legacy reliable. - -- The big difference is that in CHECKED mode there is a fair amount of + -- The big difference is that in STRICT mode there is a fair amount of -- circuitry to try to avoid setting the Do_Overflow_Check flag if we -- know that no check is needed. We skip all that in the two new modes, -- since really overflow checking happens over a whole subtree, and we -- do the corresponding optimizations later on when applying the checks. if Mode in Minimized_Or_Eliminated then - Activate_Overflow_Check (N); + if not (Overflow_Checks_Suppressed (Etype (N))) + and then not (Is_Entity_Name (N) + and then Overflow_Checks_Suppressed (Entity (N))) + then + Activate_Overflow_Check (N); + end if; if Debug_Flag_CC then w ("Minimized/Eliminated mode"); @@ -4472,7 +4482,7 @@ package body Checks is return; end if; - -- Remainder of processing is for Checked case, and is unchanged from + -- Remainder of processing is for STRICT case, and is unchanged from -- earlier versions preceding the addition of MINIMIZED/ELIMINATED. -- Nothing to do if the range of the result is known OK. We skip this @@ -6685,9 +6695,9 @@ package body Checks is New_Reference_To (M, Loc)))))); end Make_Bignum_Block; - ---------------------------------------- - -- Minimize_Eliminate_Overflow_Checks -- - ---------------------------------------- + ---------------------------------- + -- Minimize_Eliminate_Overflows -- + ---------------------------------- -- 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 @@ -6697,14 +6707,13 @@ package body Checks is -- it would interfere 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. + -- the operator expansion routines, as well as the expansion routines for + -- if/case expression, do nothing (for the moment) 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 @@ -6716,11 +6725,10 @@ package body Checks is -- the node (if it has been modified by the overflow check processing). The -- Analyzed_Flag is set to False before the reexpand/reanalyze. To avoid -- a recursive call into the whole overflow apparatus, an 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. + -- for this call is that the overflow handling mode must be temporarily set + -- to STRICT. - procedure Minimize_Eliminate_Overflow_Checks + procedure Minimize_Eliminate_Overflows (N : Node_Id; Lo : out Uint; Hi : out Uint; @@ -6730,7 +6738,7 @@ package body Checks is pragma Assert (Is_Signed_Integer_Type (Rtyp)); -- Result type, must be a signed integer type - Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Empty); + Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode; pragma Assert (Check_Mode in Minimized_Or_Eliminated); Loc : constant Source_Ptr := Sloc (N); @@ -6764,18 +6772,24 @@ package body Checks is -- Set True if one or more operands is already of type Long_Long_Integer -- which means that if the result is known to be in the result type -- 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 modified the node, so we do not need - -- to reanalyze it. But we do want to reexpand it in either SUPPRESSED - -- or CHECKED 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 reanalyzing an already analyzed node - -- causes incorrect behavior. + + procedure Reanalyze (Typ : Entity_Id; Suppress : Boolean := False); + -- This is called when we have modified the node and we therefore need + -- to reanalyze it. It is important that we reset the mode to STRICT for + -- this reanalysis, since if we leave it in MINIMIZED or ELIMINATED mode + -- we would reenter this routine recursively which would not be good! + -- The argument Suppress is set True if we also want to suppress + -- overflow checking for the reexpansion (this is set when we know + -- overflow is not possible). Typ is the type for the reanalysis. + + procedure Reexpand (Suppress : Boolean := False); + -- This is like Reanalyze, but does not do the Analyze step, it only + -- does a reexpansion. We do this reexpansion in STRICT mode, so that + -- instead of reentering the MINIMIZED/ELIMINATED mode processing, we + -- follow the normal expansion path (e.g. converting A**4 to A**2**2). + -- Note that skipping reanalysis is not just an optimization, testing + -- has showed up several complex cases in which reanalyzing 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 @@ -6829,25 +6843,62 @@ package body Checks is end if; end Min; + --------------- + -- Reanalyze -- + --------------- + + procedure Reanalyze (Typ : Entity_Id; Suppress : Boolean := False) is + Svg : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_General; + Sva : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_Assertions; + Svo : constant Boolean := + Scope_Suppress.Suppress (Overflow_Check); + + begin + Scope_Suppress.Overflow_Checks_General := Strict; + Scope_Suppress.Overflow_Checks_Assertions := Strict; + + if Suppress then + Scope_Suppress.Suppress (Overflow_Check) := True; + end if; + + Analyze_And_Resolve (N, Typ); + + Scope_Suppress.Suppress (Overflow_Check) := Svo; + Scope_Suppress.Overflow_Checks_General := Svg; + Scope_Suppress.Overflow_Checks_Assertions := Sva; + end Reanalyze; + -------------- -- Reexpand -- -------------- - procedure Reexpand (C : Suppressed_Or_Checked) is + procedure Reexpand (Suppress : Boolean := False) is Svg : constant Overflow_Check_Type := Scope_Suppress.Overflow_Checks_General; Sva : constant Overflow_Check_Type := Scope_Suppress.Overflow_Checks_Assertions; + Svo : constant Boolean := + Scope_Suppress.Suppress (Overflow_Check); + begin - Scope_Suppress.Overflow_Checks_General := C; - Scope_Suppress.Overflow_Checks_Assertions := C; + Scope_Suppress.Overflow_Checks_General := Strict; + Scope_Suppress.Overflow_Checks_Assertions := Strict; Set_Analyzed (N, False); + + if Suppress then + Scope_Suppress.Suppress (Overflow_Check) := True; + end if; + Expand (N); + + Scope_Suppress.Suppress (Overflow_Check) := Svo; Scope_Suppress.Overflow_Checks_General := Svg; Scope_Suppress.Overflow_Checks_Assertions := Sva; end Reexpand; - -- Start of processing for Minimize_Eliminate_Overflow_Checks + -- Start of processing for Minimize_Eliminate_Overflows begin -- Case where we do not have a signed integer arithmetic operation @@ -6884,14 +6935,14 @@ package body Checks is begin Bignum_Operands := False; - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Then_DE, Lo, Hi, Top_Level => False); if Lo = No_Uint then Bignum_Operands := True; end if; - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Else_DE, Rlo, Rhi, Top_Level => False); if Rlo = No_Uint then @@ -6918,8 +6969,7 @@ package body Checks is Convert_To_Bignum (Else_DE)), Is_Elsif => Is_Elsif (N))); - Analyze_And_Resolve - (N, RTE (RE_Bignum), Suppress => Overflow_Check); + Reanalyze (RTE (RE_Bignum), Suppress => True); -- 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 @@ -6930,7 +6980,7 @@ package body Checks is elsif not Long_Long_Integer_Operands then Set_Do_Overflow_Check (N, False); - Reexpand (Suppressed); + Reexpand; -- Otherwise convert us to long long integer mode. Note that we -- don't need any further overflow checking at this level. @@ -6943,8 +6993,7 @@ package body Checks is -- Now reanalyze with overflow checks off Set_Do_Overflow_Check (N, False); - Set_Analyzed (N, False); - Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check); + Reanalyze (LLIB, Suppress => True); end if; end; @@ -6968,7 +7017,7 @@ package body Checks is Aexp : constant Node_Id := Expression (Alt); begin - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Aexp, Lo, Hi, Top_Level => False); if Lo = No_Uint then @@ -6991,7 +7040,7 @@ package body Checks is if not (Bignum_Operands or Long_Long_Integer_Operands) then Set_Do_Overflow_Check (N, False); - Reexpand (Suppressed); + Reexpand (Suppress => True); -- Otherwise we are going to rebuild the case expression using -- either bignum or long long integer operands throughout. @@ -7028,7 +7077,7 @@ package body Checks is Expression => Expression (N), Alternatives => New_Alts)); - Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check); + Reanalyze (Rtype, Suppress => True); end; end if; end; @@ -7040,11 +7089,11 @@ package body Checks is -- operands to get the ranges (and to properly process the subtree -- that lies below us!) - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Right_Opnd (N), Rlo, Rhi, Top_Level => False); if Binary then - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Left_Opnd (N), Llo, Lhi, Top_Level => False); end if; @@ -7356,7 +7405,7 @@ package body Checks is and then In_Result_Range then Set_Do_Overflow_Check (N, False); - Reexpand (Suppressed); + Reexpand (Suppress => True); return; -- Here we know that we are not in the result range, and in the general @@ -7380,22 +7429,17 @@ package body Checks is and then Nkind (Parent (N)) /= N_Type_Conversion 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); + -- Here keep original types, but we need to complete analysis -- 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! + -- mode (i.e. we want to use STRICT 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. - Reexpand (Checked); + Reexpand; return; -- Cases where we do the operation in Bignum mode. This happens either @@ -7421,17 +7465,18 @@ package body Checks is -- set True). In this case, there is no point in moving into Bignum -- mode to prevent overflow if the caller will immediately convert -- the Bignum value back to LLI with an overflow check. It's more - -- efficient to stay in LLI mode with an overflow check. + -- efficient to stay in LLI mode with an overflow check (if needed) if Check_Mode = Minimized or else (Top_Level and not Bignum_Operands) then - Enable_Overflow_Check (N); + if Do_Overflow_Check (N) then + Enable_Overflow_Check (N); + end if; - -- Since we are doing an overflow check, the result has to be in - -- Long_Long_Integer mode, so adjust the possible range to reflect - -- this. Note these calls also change No_Uint values from the top - -- level case to LLI bounds. + -- The result now has to be in Long_Long_Integer mode, so adjust + -- the possible range to reflect this. Note these calls also + -- change No_Uint values from the top level case to LLI bounds. Max (Lo, LLLo); Min (Hi, LLHi); @@ -7500,7 +7545,7 @@ package body Checks is Make_Function_Call (Loc, Name => New_Occurrence_Of (Fent, Loc), Parameter_Associations => Args)); - Analyze_And_Resolve (N, RTE (RE_Bignum)); + Reanalyze (RTE (RE_Bignum), Suppress => True); -- Indicate result is Bignum mode @@ -7557,48 +7602,36 @@ package body Checks is -- we will complete any division checks (since we have not changed the -- setting of the Do_Division_Check flag). - -- If no overflow check, suppress overflow check to avoid an infinite - -- recursion into this procedure. + -- We do this reanalysis in STRICT mode to avoid recursion into the + -- MINIMIZED/ELIMINATED handling, since we are now done with that! - if not Do_Overflow_Check (N) then - Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check); + declare + SG : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_General; + SA : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_Assertions; - -- If an overflow check is required, do it in normal CHECKED mode. - -- That avoids an infinite recursion, making sure we get a normal - -- overflow check. + begin + Scope_Suppress.Overflow_Checks_General := Strict; + Scope_Suppress.Overflow_Checks_Assertions := Strict; - else - declare - SG : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_General; - SA : 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, LLIB); - Scope_Suppress.Overflow_Checks_General := SG; - Scope_Suppress.Overflow_Checks_Assertions := SA; - end; - end if; - end Minimize_Eliminate_Overflow_Checks; + if not Do_Overflow_Check (N) then + Reanalyze (LLIB, Suppress => True); + else + Reanalyze (LLIB); + end if; + + Scope_Suppress.Overflow_Checks_General := SG; + Scope_Suppress.Overflow_Checks_Assertions := SA; + end; + end Minimize_Eliminate_Overflows; ------------------------- -- Overflow_Check_Mode -- ------------------------- - function Overflow_Check_Mode (E : Entity_Id) return Overflow_Check_Type is + function Overflow_Check_Mode return Overflow_Check_Type is begin - -- Check overflow suppressed on entity - - if Present (E) and then Checks_May_Be_Suppressed (E) then - if Is_Check_Suppressed (E, Overflow_Check) then - return Suppressed; - end if; - end if; - - -- Else return appropriate scope setting - if In_Assertion_Expr = 0 then return Scope_Suppress.Overflow_Checks_General; else @@ -7612,7 +7645,11 @@ package body Checks is function Overflow_Checks_Suppressed (E : Entity_Id) return Boolean is begin - return Overflow_Check_Mode (E) = Suppressed; + if Present (E) and then Checks_May_Be_Suppressed (E) then + return Is_Check_Suppressed (E, Overflow_Check); + else + return Scope_Suppress.Suppress (Overflow_Check); + end if; end Overflow_Checks_Suppressed; ----------------------------- diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index f7a4399..f2919e2 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -72,12 +72,11 @@ package Checks is -- determine whether check C is suppressed either on the entity E or -- as the result of a scope suppress pragma. If Checks_May_Be_Suppressed -- is False, then the status of the check can be determined simply by - -- examining Scope_Checks (C), so this routine is not called in that case. + -- examining Scope_Suppress, so this routine is not called in that case. - function Overflow_Check_Mode (E : Entity_Id) return Overflow_Check_Type; + function Overflow_Check_Mode return Overflow_Check_Type; -- Returns current overflow checking mode, taking into account whether - -- we are inside an assertion expression. Always returns Suppressed if - -- overflow checks are suppressed for entity E. + -- we are inside an assertion expression. ------------------------------------------- -- Procedures to Activate Checking Flags -- @@ -142,7 +141,10 @@ 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_Divide_Checks. + -- Apply_Divide_Checks. Node N may or may not have Do_Overflow_Check. + -- In STRICT mode, there is nothing to do if this flag is off, but in + -- MINIMIZED/ELIMINATED mode we still have to deal with possible use + -- of doing operations in Long_Long_Integer or Bignum mode. procedure Apply_Constraint_Check (N : Node_Id; @@ -266,15 +268,16 @@ package Checks is -- Insert_Action of the whole block (it is returned unanalyzed). The Loc -- parameter is used to supply Sloc values for the constructed tree. - procedure Minimize_Eliminate_Overflow_Checks + procedure Minimize_Eliminate_Overflows (N : Node_Id; Lo : out Uint; Hi : out Uint; Top_Level : Boolean); -- This is the main routine for handling MINIMIZED and ELIMINATED overflow - -- checks. On entry N is a node whose result is a signed integer subtype. - -- If the node is an arithmetic operation, then a range analysis is carried - -- out, and there are three possibilities: + -- processing. On entry N is a node whose result is a signed integer + -- subtype. The Do_Overflow_Check flag may or may not be set on N. If the + -- node is an arithmetic operation, then a range analysis is carried out, + -- and there are three possibilities: -- -- The node is left unchanged (apart from expansion of an exponentiation -- operation). This happens if the routine can determine that the result @@ -313,16 +316,16 @@ package Checks is -- The routine is called in three situations if we are operating in either -- MINIMIZED or ELIMINATED modes. -- - -- Overflow checks applied to the top node of an expression tree when + -- Overflow processing applied to the top node of an expression tree when -- that node is an arithmetic operator. In this case the result is -- converted to the appropriate result type (there is special processing -- when the parent is a conversion, see body for details). -- - -- Overflow checks are applied to the operands of a comparison operation. + -- Overflow processing applied to the operands of a comparison operation. -- In this case, the comparison is done on the result Long_Long_Integer -- or Bignum values, without raising any exceptions. -- - -- Overflow checks are applied to the left operand of a membership test. + -- Overflow processing applied to the left operand of a membership test. -- In this case no exception is raised if a Long_Long_Integer or Bignum -- result is outside the range of the type of that left operand (it is -- just that the result of IN is false in that case). @@ -332,13 +335,13 @@ package Checks is -- -- Top_Level is used to avoid inefficient unnecessary transitions into the -- Bignum domain. If Top_Level is True, it means that the caller will have - -- to convert any Bignum value back to Long_Long_Integer, checking that the - -- value is in range. This is the normal case for a top level operator in - -- a subexpression. There is no point in going into Bignum mode to avoid an - -- overflow just so we can check for overflow the next moment. For calls - -- from comparisons and membership tests, and for all recursive calls, we - -- do want to transition into the Bignum domain if necessary. Note that - -- this setting is only relevant in ELIMINATED mode. + -- to convert any Bignum value back to Long_Long_Integer, possibly checking + -- that the value is in range. This is the normal case for a top level + -- operator in a subexpression. There is no point in going into Bignum mode + -- to avoid an overflow just so we can check for overflow the next moment. + -- For calls from comparisons and membership tests, and for all recursive + -- calls, we do want to transition into the Bignum domain if necessary. + -- Note that this setting is only relevant in ELIMINATED mode. ------------------------------------------------------- -- Control and Optimization of Range/Overflow Checks -- @@ -370,9 +373,7 @@ package Checks is -- has no effect. If a check is needed then this routine sets the flag -- Do_Overflow_Check in node N to True, unless it can be determined that -- the check is not needed. The only condition under which this is the - -- case is if there was an identical check earlier on. These optimziations - -- apply to CHECKED mode, but not to MINIMIZED/ELIMINATED modes. See the - -- body for a full explanation. + -- case is if there was an identical check earlier on. procedure Enable_Range_Check (N : Node_Id); -- Set Do_Range_Check flag in node N True, unless it can be determined diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d9bdebd..f62d70d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -213,19 +213,19 @@ package body Exp_Ch4 is -- 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. + -- For signed arithmetic operations when the current overflow mode is + -- MINIMIZED or ELIMINATED, we must call 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 is in CHECKED mode, avoiding a recursive entry into this + -- routine, 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 @@ -2274,8 +2274,8 @@ package body Exp_Ch4 is LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer); -- Entity for Long_Long_Integer'Base - Check : constant Overflow_Check_Type := Overflow_Check_Mode (Empty); - -- Current checking mode + Check : constant Overflow_Check_Type := Overflow_Check_Mode; + -- Current overflow checking mode procedure Set_True; procedure Set_False; @@ -2320,9 +2320,9 @@ package body Exp_Ch4 is -- our operands using the Minimize_Eliminate circuitry which applies -- this processing to the two operand subtrees. - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Left_Opnd (N), Llo, Lhi, Top_Level => False); - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Right_Opnd (N), Rlo, Rhi, Top_Level => False); -- See if the range information decides the result of the comparison. @@ -3721,7 +3721,7 @@ package body Exp_Ch4 is -- Entity for Long_Long_Integer'Base (Standard should export this???) begin - Minimize_Eliminate_Overflow_Checks (Lop, Lo, Hi, Top_Level => False); + Minimize_Eliminate_Overflows (Lop, Lo, Hi, Top_Level => False); -- If right operand is a subtype name, and the subtype name has no -- predicate, then we can just replace the right operand with an @@ -3751,9 +3751,9 @@ package body Exp_Ch4 is -- have not been processed for minimized or eliminated checks. if Nkind (Rop) = N_Range then - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Low_Bound (Rop), Lo, Hi, Top_Level => False); - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (High_Bound (Rop), Lo, Hi, Top_Level => False); -- We have A in B .. C, treated as A >= B and then A <= C @@ -5498,7 +5498,7 @@ package body Exp_Ch4 is -- in which case, this usage makes sense, and in any case, we have -- actually eliminated the danger of optimization above. - if Overflow_Check_Mode (Restyp) not in Minimized_Or_Eliminated then + if Overflow_Check_Mode not in Minimized_Or_Eliminated then Error_Msg_N ("?explicit membership test may be optimized away", N); Error_Msg_N -- CODEFIX ("\?use ''Valid attribute instead", N); @@ -5526,7 +5526,7 @@ package body Exp_Ch4 is -- type, then expand with a separate procedure. Note the use of the -- flag No_Minimize_Eliminate to prevent infinite recursion. - if Overflow_Check_Mode (Empty) in Minimized_Or_Eliminated + if Overflow_Check_Mode in Minimized_Or_Eliminated and then Is_Signed_Integer_Type (Ltyp) and then not No_Minimize_Eliminate (N) then @@ -11785,8 +11785,7 @@ package body Exp_Ch4 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; + and then Overflow_Check_Mode in Minimized_Or_Eliminated; end Minimized_Eliminated_Overflow_Check; -------------------------------- diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index cc3213d..7c1ceeb 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3840,11 +3840,11 @@ package body Exp_Util is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Sva : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Insert_Actions (Assoc_Node, Ins_Actions); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Sva; end; else @@ -6727,7 +6727,7 @@ package body Exp_Util is -- All this must not have any checks - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); -- If it is a scalar type and we need to capture the value, just make -- a copy. Likewise for a function call, an attribute reference, an diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 47c4b17..ee6ca09 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -192,14 +192,12 @@ procedure Gnat1drv is -- Enable all other language checks - Suppress_Options := - (Suppress => (Access_Check => True, - Alignment_Check => True, - Division_Check => True, - Elaboration_Check => True, - others => False), - Overflow_Checks_General => Suppressed, - Overflow_Checks_Assertions => Suppressed); + Suppress_Options.Suppress := + (Access_Check => True, + Alignment_Check => True, + Division_Check => True, + Elaboration_Check => True, + others => False); Dynamic_Elaboration_Checks := False; @@ -328,42 +326,50 @@ procedure Gnat1drv is Exception_Mechanism := Back_End_Exceptions; end if; - -- Set proper status for overflow checks + -- Set proper status for overflow check mechanism - -- If already set (by - gnato or -gnatp) then we have nothing to do + -- If already set (by -gnato) then we have nothing to do if Opt.Suppress_Options.Overflow_Checks_General /= Not_Set then null; - -- Otherwise set appropriate default mode. Note: at present we set - -- SUPPRESSED in all three of the following cases. They are separated - -- because in the future we may make different choices. + -- Otherwise set overflow mode defaults - -- By default suppress overflow checks in -gnatg mode + else + -- Otherwise set overflow checks off by default - elsif GNAT_Mode then - Suppress_Options.Overflow_Checks_General := Suppressed; - Suppress_Options.Overflow_Checks_Assertions := Suppressed; + Suppress_Options.Suppress (Overflow_Check) := True; - -- If we have backend divide and overflow checks, then by default - -- overflow checks are suppressed. Historically this code used to - -- activate overflow checks, although no target currently has these - -- flags set, so this was dead code anyway. + -- Set appropriate default overflow handling mode. Note: at present + -- we set STRICT in all three of the following cases. They are + -- separated because in the future we may make different choices. - elsif Targparm.Backend_Divide_Checks_On_Target - and - Targparm.Backend_Overflow_Checks_On_Target - then - Suppress_Options.Overflow_Checks_General := Suppressed; - Suppress_Options.Overflow_Checks_Assertions := Suppressed; + -- By default set STRICT mode if -gnatg in effect - -- Otherwise for now, default is checks are suppressed. This is subject - -- to change in the future, but for now this is the compatible behavior - -- with previous versions of GNAT. + if GNAT_Mode then + Suppress_Options.Overflow_Checks_General := Strict; + Suppress_Options.Overflow_Checks_Assertions := Strict; - else - Suppress_Options.Overflow_Checks_General := Suppressed; - Suppress_Options.Overflow_Checks_Assertions := Suppressed; + -- If we have backend divide and overflow checks, then by default + -- overflow checks are STRICT. Historically this code used to also + -- activate overflow checks, although no target currently has these + -- flags set, so this was dead code anyway. + + elsif Targparm.Backend_Divide_Checks_On_Target + and + Targparm.Backend_Overflow_Checks_On_Target + then + Suppress_Options.Overflow_Checks_General := Strict; + Suppress_Options.Overflow_Checks_Assertions := Strict; + + -- Otherwise for now, default is STRICT mode. This may change in the + -- future, but for now this is the compatible behavior with previous + -- versions of GNAT. + + else + Suppress_Options.Overflow_Checks_General := Strict; + Suppress_Options.Overflow_Checks_Assertions := Strict; + end if; end if; -- Set default for atomic synchronization. As this synchronization diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 6aafad8..f357779 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -723,29 +723,15 @@ package body Sem is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Svs : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Analyze (N); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Svs; end; elsif Suppress = Overflow_Check then 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 := Suppressed; - Scope_Suppress.Overflow_Checks_Assertions := Suppressed; - Analyze (N); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; - end; - - else - declare Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); begin Scope_Suppress.Suppress (Suppress) := True; @@ -776,25 +762,11 @@ package body Sem is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; - begin - Scope_Suppress := Suppress_All; - Analyze_List (L); - Scope_Suppress := Svg; - end; - - elsif Suppress = Overflow_Check then - declare - Svg : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_General; - Sva : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_Assertions; + Svs : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress.Overflow_Checks_General := Suppressed; - Scope_Suppress.Overflow_Checks_Assertions := Suppressed; + Scope_Suppress.Suppress := (others => True); Analyze_List (L); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; + Scope_Suppress.Suppress := Svs; end; else @@ -1051,11 +1023,11 @@ package body Sem is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Svs : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Insert_After_And_Analyze (N, M); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Svs; end; else @@ -1111,11 +1083,11 @@ package body Sem is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Svs : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Insert_Before_And_Analyze (N, M); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Svs; end; else @@ -1170,11 +1142,11 @@ package body Sem is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Svs : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Insert_List_After_And_Analyze (N, L); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Svs; end; else @@ -1228,11 +1200,11 @@ package body Sem is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Svs : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Insert_List_Before_And_Analyze (N, L); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Svs; end; else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f7f56f0..4ca5285 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2121,7 +2121,8 @@ package body Sem_Prag is (Get_Pragma_Arg (Arg2), Standard_String); end if; - -- Record if pragma is disabled + -- For a pragma in the extended main source unit, record enabled + -- status in SCO (note: there is never any SCO for an instance). if Check_Enabled (Pname) then Set_SCO_Pragma_Enabled (Loc); @@ -5058,7 +5059,8 @@ package body Sem_Prag is -- If previous error, avoid cascaded errors - Applies := True; + Cascaded_Error; + Applies := True; Effective := True; else @@ -5703,18 +5705,6 @@ package body Sem_Prag is ("argument of pragma% is not valid check name", Arg1); end if; - -- Special processing for overflow check case - - if C = All_Checks or else C = Overflow_Check then - if Suppress_Case then - Scope_Suppress.Overflow_Checks_General := Suppressed; - Scope_Suppress.Overflow_Checks_Assertions := Suppressed; - else - Scope_Suppress.Overflow_Checks_General := Checked; - Scope_Suppress.Overflow_Checks_Assertions := Checked; - end if; - end if; - if Arg_Count = 1 then -- Make an entry in the local scope suppress table. This is the @@ -12007,10 +11997,11 @@ package body Sem_Prag is -- pragma Overflow_Checks -- ([General => ] MODE [, [Assertions => ] MODE]); - -- MODE := SUPPRESSED | CHECKED | MINIMIZED | ELIMINATED + -- MODE := STRICT | MINIMIZED | ELIMINATED -- Note: ELIMINATED is allowed only if Long_Long_Integer'Size is 64 - -- since System.Bignums makes this assumption. + -- since System.Bignums makes this assumption. This is true of nearly + -- all (all?) targets. when Pragma_Overflow_Checks => Overflow_Checks : declare function Get_Check_Mode @@ -12034,19 +12025,8 @@ package body Sem_Prag is Check_Optional_Identifier (Arg, Name); Check_Arg_Is_Identifier (Argx); - -- Do not suppress overflow checks for formal verification. - -- Instead, require that a check is inserted so that formal - -- verification can detect wraparound errors. - - if Chars (Argx) = Name_Suppressed then - if Alfa_Mode then - return Checked; - else - return Suppressed; - end if; - - elsif Chars (Argx) = Name_Checked then - return Checked; + if Chars (Argx) = Name_Strict then + return Strict; elsif Chars (Argx) = Name_Minimized then return Minimized; @@ -14545,6 +14525,7 @@ package body Sem_Prag is -- Note: in previous versions of GNAT we used to check for limited -- types and give an error, but in fact the standard does allow -- Unchecked_Union on limited types, so this check was removed. + -- Similarly, GNAT used to require that all discriminants have -- default values, but this is not mandated by the RM. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 847dd30..64199fa 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -334,25 +334,11 @@ package body Sem_Res is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Sva : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Analyze_And_Resolve (N, Typ); - Scope_Suppress := Svg; - end; - - elsif Suppress = Overflow_Check then - 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 := Suppressed; - Scope_Suppress.Overflow_Checks_Assertions := Suppressed; - Analyze_And_Resolve (N, Typ); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; + Scope_Suppress.Suppress := Sva; end; else @@ -388,25 +374,11 @@ package body Sem_Res is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; - begin - Scope_Suppress := Suppress_All; - Analyze_And_Resolve (N); - Scope_Suppress := Svg; - end; - - elsif Suppress = Overflow_Check then - declare - Svg : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_General; - Sva : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_Assertions; + Sva : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress.Overflow_Checks_General := Suppressed; - Scope_Suppress.Overflow_Checks_Assertions := Suppressed; + Scope_Suppress.Suppress := (others => True); Analyze_And_Resolve (N); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; + Scope_Suppress.Suppress := Sva; end; else @@ -1690,19 +1662,23 @@ package body Sem_Res is Full_Analysis := False; Expander_Mode_Save_And_Set (False); - -- We suppress all checks for this analysis, except in Alfa mode. - -- Otherwise the checks are applied properly, and in the proper - -- location, when the default expressions are reanalyzed and reexpanded - -- later on. + -- Normally, we suppress all checks for this preanalysis. There is no + -- point in processing them now, since they will be applied properly + -- and in the proper location when the default expressions reanalyzed + -- and reexpanded later on. We will also have more information at that + -- point for possible suppression of individual checks. - -- Alfa mode suppresses all expansion but requires the setting of - -- checking flags (DIvision_Check and others) in particular for Ada 2012 - -- constructs such as quantified expressions, that are expanded in two - -- separate steps. + -- However, in Alfa mode, most expansion is suppressed, and this + -- later reanalysis and reexpansion may not occur. Alfa mode does + -- require the setting of checking flags for proof purposes, so we + -- do the Alfa preanalysis without suppressing checks. + + -- This special handling for Alfa mode is required for example in the + -- case of Ada 2012 constructs such as quantified expressions, which are + -- expanded in two separate steps. if Alfa_Mode then Analyze_And_Resolve (N, T); - else Analyze_And_Resolve (N, T, Suppress => All_Checks); end if; @@ -2946,11 +2922,11 @@ package body Sem_Res is begin if Suppress = All_Checks then declare - Svg : constant Suppress_Record := Scope_Suppress; + Sva : constant Suppress_Array := Scope_Suppress.Suppress; begin - Scope_Suppress := Suppress_All; + Scope_Suppress.Suppress := (others => True); Resolve (N, Typ); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Sva; end; else @@ -5959,16 +5935,6 @@ package body Sem_Res is Set_Etype (N, Typ); Eval_Case_Expression (N); - - -- If we still have a case expression, and overflow checks are enabled - -- in MINIMIZED or ELIMINATED modes, then set Do_Overflow_Check to - -- ensure that we handle overflow for dependent expressions. - - if Nkind (N) = N_Case_Expression - and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated - then - Set_Do_Overflow_Check (N); - end if; end Resolve_Case_Expression; ------------------------------- @@ -7215,16 +7181,6 @@ package body Sem_Res is Set_Etype (N, Typ); Eval_If_Expression (N); - - -- If we still have a if expression, and overflow checks are enabled in - -- MINIMIZED or ELIMINATED modes, then set Do_Overflow_Check to ensure - -- that we handle overflow for dependent expressions. - - if Nkind (N) = N_If_Expression - and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated - then - Set_Do_Overflow_Check (N); - end if; end Resolve_If_Expression; ------------------------------- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 864d8ed..efd340f 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -665,7 +665,6 @@ package Snames is Name_By_Protected_Procedure : constant Name_Id := N + $; Name_Casing : constant Name_Id := N + $; Name_Check_All : constant Name_Id := N + $; - Name_Checked : constant Name_Id := N + $; Name_Code : constant Name_Id := N + $; Name_Component : constant Name_Id := N + $; Name_Component_Size_4 : constant Name_Id := N + $; @@ -739,6 +738,7 @@ package Snames is Name_State : constant Name_Id := N + $; Name_Static : constant Name_Id := N + $; Name_Stack_Size : constant Name_Id := N + $; + Name_Strict : constant Name_Id := N + $; Name_Subunit_File_Name : constant Name_Id := N + $; Name_Suppressed : constant Name_Id := N + $; Name_Task_Stack_Size_Default : constant Name_Id := N + $; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 2a96c06..e7d517e 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -97,11 +97,8 @@ package body Switch.C is function Get_Overflow_Mode (C : Character) return Overflow_Check_Type is begin case C is - when '0' => - return Suppressed; - when '1' => - return Checked; + return Strict; when '2' => return Minimized; @@ -801,12 +798,13 @@ package body Switch.C is when 'o' => Ptr := Ptr + 1; + Suppress_Options.Suppress (Overflow_Check) := False; -- Case of no digits after the -gnato - if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '3' then - Suppress_Options.Overflow_Checks_General := Checked; - Suppress_Options.Overflow_Checks_Assertions := Checked; + if Ptr > Max or else Switch_Chars (Ptr) not in '1' .. '3' then + Suppress_Options.Overflow_Checks_General := Strict; + Suppress_Options.Overflow_Checks_Assertions := Strict; -- At least one digit after the -gnato @@ -821,7 +819,7 @@ package body Switch.C is -- be the same as general mode. if Ptr > Max - or else Switch_Chars (Ptr) not in '0' .. '3' + or else Switch_Chars (Ptr) not in '1' .. '3' then Suppress_Options.Overflow_Checks_Assertions := Suppress_Options.Overflow_Checks_General; @@ -869,9 +867,6 @@ package body Switch.C is end if; end loop; - Suppress_Options.Overflow_Checks_General := Suppressed; - Suppress_Options.Overflow_Checks_Assertions := Suppressed; - Validity_Checks_On := False; Opt.Suppress_Checks := True; end if; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 277bfd5..861c0bc 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -703,43 +703,39 @@ package Types is -- 4. Add a new Do_xxx_Check flag to Sinfo (if required) -- 5. Add appropriate checks for the new test - -- The following provides precise details on the mode used to check - -- intermediate overflows in expressions for signed integer arithmetic. + -- The following provides precise details on the mode used to generate + -- code for intermediate overflows in expressions for signed integer + -- arithmetic (and how to generate overflow checks if enabled). Note + -- that this only affects handling of intermediate results. The final + -- result must always fit within the target range, and if overflow + -- checking is enabled, the check on the final result is against this + -- target range. type Overflow_Check_Type is ( Not_Set, -- Dummy value used during initialization process to show that the -- corresponding value has not yet been initialized. - Suppressed, - -- Overflow checking is suppressed. If an arithmetic operation creates - -- an overflow, no exception is raised, and the program is erroneous. - - Checked, - -- All operations, including all intermediate operations are checked. - -- If the result of any arithmetic operation gives a result outside the - -- range of the base type, then a Constraint_Error exception is raised. + Strict, + -- Operations are done in the base type of the subexpression. If + -- overflow checks are enabled, then the check is against the range + -- of this base type. Minimized, - -- Where appropriate, arithmetic operations are performed with an - -- extended range, using Long_Long_Integer if necessary. As long as the - -- result fits in this extended range, then no exception is raised and - -- computation continues with the extended result. The final value of an - -- expression must fit in the base type of the whole expression. If an - -- intermediate result is outside the range of Long_Long_Integer then a - -- Constraint_Error exception is raised. + -- Where appropriate, intermediate arithmetic operations are performed + -- with an extended range, using Long_Long_Integer if necessary. If + -- overflow checking is enabled, then the check is against the range + -- of Long_Long_Integer. Eliminated); -- In this mode arbitrary precision arithmetic is used as needed to -- ensure that it is impossible for intermediate arithmetic to cause an - -- overflow. Again the final value of an expression must fit in the base - -- type of the whole expression. + -- overflow. In this mode, intermediate expressions are not affected by + -- the overflow checking mode, since overflows are eliminated. subtype Minimized_Or_Eliminated is Overflow_Check_Type range Minimized .. Eliminated; - subtype Suppressed_Or_Checked is - Overflow_Check_Type range Suppressed .. Checked; - -- Define subtypes so that clients don't need to know ordering. Note that + -- Define subtype so that clients don't need to know ordering. Note that -- Overflow_Check_Type is not marked as an ordered enumeration type. -- The following structure captures the state of check suppression or @@ -747,24 +743,19 @@ package Types is type Suppress_Record is record Suppress : Suppress_Array; - -- Indicates suppression status of each possible check. Note: there - -- is an entry for Overflow_Check in this array, but it is never used. - -- Instead we use the more detailed information in the two components - -- that follow this one (Overflow_Checks_General/Assertions). + -- Indicates suppression status of each possible check Overflow_Checks_General : Overflow_Check_Type; - -- This field indicates the mode of overflow checking to be applied to - -- general expressions outside assertions. + -- This field indicates the mode for handling code generation and + -- overflow checking (if enabled) for intermediate expression values. + -- This applies to general expressions outside assertions. Overflow_Checks_Assertions : Overflow_Check_Type; - -- This field indicates the mode of overflow checking to be applied to - -- any expression occuring inside assertions. + -- This field indicates the mode for handling code generation and + -- overflow checking (if enabled) for intermediate expression values. + -- This applies to any expression occuring inside assertions. end record; - Suppress_All : constant Suppress_Record := - ((others => True), Suppressed, Suppressed); - -- Constant used to initialize Suppress_Record value to all suppressed. - ----------------------------------- -- Global Exception Declarations -- ----------------------------------- -- 2.7.4