+2012-11-06 Robert Dewar <dewar@adacore.com>
+
+ * 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 <schonberg@adacore.com>
* sem_res.adb (Preanalyze_And_Resolve): In Alfa mode do not
-- 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;
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
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,
-- 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:
when RE_Not_Available =>
return;
end;
- end Apply_Arithmetic_Overflow_Checked_Suppressed;
+ end Apply_Arithmetic_Overflow_Strict;
----------------------------------------------------
-- Apply_Arithmetic_Overflow_Minimized_Eliminated --
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);
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;
-- 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
-- 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
-- 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
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;
-- 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);
-- 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).
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
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;
-- 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
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");
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
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
-- 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
-- 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;
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);
-- 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
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
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
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
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.
-- 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;
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
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.
Expression => Expression (N),
Alternatives => New_Alts));
- Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check);
+ Reanalyze (Rtype, Suppress => True);
end;
end if;
end;
-- 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;
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
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
-- 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);
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
-- 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
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;
-----------------------------
-- 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 --
-- 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;
-- 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
-- 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).
--
-- 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 --
-- 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
-- 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
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;
-- 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.
-- 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
-- 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
-- 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);
-- 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
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;
--------------------------------
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
-- 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
-- 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;
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
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;
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
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
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
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
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
(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);
-- If previous error, avoid cascaded errors
- Applies := True;
+ Cascaded_Error;
+ Applies := True;
Effective := True;
else
("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
-- 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
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;
-- 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.
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
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
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;
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
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;
-------------------------------
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;
-------------------------------
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 + $;
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 + $;
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;
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
-- 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;
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;
-- 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
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 --
-----------------------------------
projects / platform / upstream / gcc.git / commitdiff