From patchwork Tue Nov 6 11:12:42 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 197468 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 12C9F2C00C8 for ; Tue, 6 Nov 2012 22:13:08 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1352805189; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=LDYt0H+wCoDIjmustvOt NzYf4Cc=; b=L2MHvs6cGT0es7XZHNyFqcBPIr25K8GXOHaCAynv3k+JoQqRn6/N yJ8h5Gduy8GBL4zIrOS5DP9Xmefer/f64ZqrS8GFwpktZdFk/GXVTJVtdLNYwDkb Th2CXfobn+LQbv0zICo/Ntm7rSToSNx4RVkq3t6cGnZ2WliAZ5qrbDs= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=FDq9EJPJoWzVjgbO4zC/3ptiMXlVGtR3mbD2i9OGc5qThsetEhZlm9sX3/MjAL 7mMyR2DXK2vFnWfaJ9xiG6ixRArx4G7cxoTcstQ96J/UY4YoiFOgJoFMOjuiC1Dv qTMQUQWJTh6SbOWeKaUOg2BB1xEr+bdFsJJgvIMKFE8io=; Received: (qmail 14197 invoked by alias); 6 Nov 2012 11:13:00 -0000 Received: (qmail 14149 invoked by uid 22791); 6 Nov 2012 11:12:57 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 06 Nov 2012 11:12:43 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5A8071C7C98; Tue, 6 Nov 2012 06:12:42 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id Y08qzyx99Cnh; Tue, 6 Nov 2012 06:12:42 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 25EC21C7BE8; Tue, 6 Nov 2012 06:12:42 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 1F4443FF09; Tue, 6 Nov 2012 06:12:42 -0500 (EST) Date: Tue, 6 Nov 2012 06:12:42 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Change approach for control of intermediate overflow checking Message-ID: <20121106111242.GA1558@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch separates the method of computing intermediate expressions with respect to overflow (STRICT, MINIMIZED, ELIMINATED), from the actual check for overflow. The method is valid whether or not overflow checks are enabled. Pragma Overflow_Checks no longer takes SUPPRESSED as a possibility, since the suppression of overflow checks is controlled by Suppress/Unsuppress pragmas. The switch -gnato no longer allows 0 as a possibility. It sets the overflow handling method, and also enables overflow checking. The following program: 1. pragma Suppress (Overflow_Check); 2. with Text_IO; use Text_IO; 3. procedure NewOverflow is 4. function Ident (X : Integer) return Integer is 5. begin 6. return X; 7. end; 8. 9. begin 10. declare 11. pragma Overflow_Checks (Minimized); 12. c : Integer; 13. b : Integer range 1 .. 10; 14. begin 15. b := Ident (10); 16. c := (b ** 15) / (b ** 14); 17. Put_Line (c'Img); 18. end; 19. 20. declare 21. pragma Overflow_Checks (Eliminated); 22. c : Integer; 23. b : Integer range 1 .. 10; 24. begin 25. b := Ident (10); 26. c := (b ** 50) / (b ** 49); 27. Put_Line (c'Img); 28. end; 29. end NewOverflow; Outputs 10 10 showing that the use of expanded types to avoid overflows is valid with checks suppressed. Tested on x86_64-pc-linux-gnu, committed on trunk 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. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 193215) +++ exp_util.adb (working copy) @@ -3840,11 +3840,11 @@ 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 @@ -- 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 Index: switch-c.adb =================================================================== --- switch-c.adb (revision 193215) +++ switch-c.adb (working copy) @@ -97,11 +97,8 @@ 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 @@ 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 @@ -- 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 @@ 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; Index: types.ads =================================================================== --- types.ads (revision 193215) +++ types.ads (working copy) @@ -703,43 +703,39 @@ -- 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. + 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. - 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. - 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 @@ 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 -- ----------------------------------- Index: checks.adb =================================================================== --- checks.adb (revision 193215) +++ checks.adb (working copy) @@ -194,18 +194,19 @@ -- 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 @@ 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 @@ 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 @@ -- 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 @@ 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 @@ 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 @@ 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 @@ -- 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 @@ -- 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 @@ -- 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 @@ 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 @@ -- 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 @@ -- 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 @@ 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 @@ 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 @@ -- 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 @@ 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 @@ 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 @@ 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 @@ -- 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 @@ -- 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 @@ 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,19 +6772,25 @@ -- 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ -- 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 @@ 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 @@ 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 @@ 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 @@ -- 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 @@ 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 @@ 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?). + -- Here keep original types, but we need to complete analysis - 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! + -- 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 @@ -- 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 @@ 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 @@ -- 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 @@ 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; ----------------------------- Index: checks.ads =================================================================== --- checks.ads (revision 193215) +++ checks.ads (working copy) @@ -72,12 +72,11 @@ -- 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 @@ -- 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 @@ -- 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 @@ -- 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 @@ -- -- 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 @@ -- 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 Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 193224) +++ sem_prag.adb (working copy) @@ -2121,7 +2121,8 @@ (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 @@ -- If previous error, avoid cascaded errors - Applies := True; + Cascaded_Error; + Applies := True; Effective := True; else @@ -5703,18 +5705,6 @@ ("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 @@ -- 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,20 +12025,9 @@ 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_Strict then + return Strict; - 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; - elsif Chars (Argx) = Name_Minimized then return Minimized; @@ -14545,6 +14525,7 @@ -- 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. Index: sem.adb =================================================================== --- sem.adb (revision 193215) +++ sem.adb (working copy) @@ -723,29 +723,15 @@ 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,27 +762,13 @@ 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_List (L); - 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_List (L); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; - end; - else declare Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); @@ -1051,11 +1023,11 @@ 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 @@ 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 @@ 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 @@ 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 Index: sem_res.adb =================================================================== --- sem_res.adb (revision 193231) +++ sem_res.adb (working copy) @@ -334,27 +334,13 @@ 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; + Scope_Suppress.Suppress := Sva; 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; - end; - else declare Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); @@ -388,27 +374,13 @@ 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); - Scope_Suppress := Svg; + Scope_Suppress.Suppress := Sva; 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); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; - end; - else declare Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); @@ -1690,19 +1662,23 @@ 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 @@ 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 @@ 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 @@ 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; ------------------------------- Index: gnat1drv.adb =================================================================== --- gnat1drv.adb (revision 193215) +++ gnat1drv.adb (working copy) @@ -192,14 +192,12 @@ -- 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 @@ 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 Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 193228) +++ exp_ch4.adb (working copy) @@ -213,19 +213,19 @@ -- 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 @@ 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 @@ -- 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 @@ -- 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 @@ -- 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 @@ -- 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 @@ -- 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 @@ 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; -------------------------------- Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 193227) +++ snames.ads-tmpl (working copy) @@ -665,7 +665,6 @@ 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 @@ 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 + $;