-- Local Subprograms --
-----------------------
- procedure Apply_Arithmetic_Overflow_Normal (N : Node_Id);
+ procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id);
-- Used to apply arithmetic overflow checks for all cases except operators
-- on signed arithmetic types in Minimized/Eliminate case (for which we
- -- call Apply_Arithmetic_Overflow_Minimized_Eliminated below).
+ -- call Apply_Arithmetic_Overflow_Minimized_Eliminated below). N is always
+ -- a signed integer arithmetic operator (conditional expression excluded).
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 an signed integer arithmetic op.
+ -- is known to be set) and we have an signed integer arithmetic op (which
+ -- includes the case of conditional expressions).
procedure Apply_Division_Check
(N : Node_Id;
function Is_Signed_Integer_Arithmetic_Op (N : Node_Id) return Boolean;
-- Returns True if node N is for an arithmetic operation with signed
- -- integer operands. This is the kind of node for which special handling
- -- applies in MINIMIZED or EXTENDED overflow checking mode.
+ -- integer operands. This includes unary and binary operators, and also
+ -- if and case expression nodes where the dependent expressions are of
+ -- a signed integer type. These are the kinds of nodes for which special
+ -- handling applies in MINIMIZED or EXTENDED overflow checking mode.
function Range_Or_Validity_Checks_Suppressed
(Expr : Node_Id) return Boolean;
or else not Do_Overflow_Check (N)
or else not Is_Signed_Integer_Arithmetic_Op (N)
then
- Apply_Arithmetic_Overflow_Normal (N);
+ Apply_Arithmetic_Overflow_Checked_Suppressed (N);
-- Otherwise use the new routine for Minimized/Eliminated modes for
-- the case of a signed integer arithmetic op, with Do_Overflow_Check
end if;
end Apply_Arithmetic_Overflow_Check;
- --------------------------------------
- -- Apply_Arithmetic_Overflow_Normal --
- --------------------------------------
+ --------------------------------------------------
+ -- Apply_Arithmetic_Overflow_Checked_Suppressed --
+ --------------------------------------------------
-- 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,
-- 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_Normal (N : Node_Id) is
+ procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Rtyp : constant Entity_Id := Root_Type (Typ);
when RE_Not_Available =>
return;
end;
- end Apply_Arithmetic_Overflow_Normal;
+ end Apply_Arithmetic_Overflow_Checked_Suppressed;
----------------------------------------------------
-- Apply_Arithmetic_Overflow_Minimized_Eliminated --
-- Original result type
Check_Mode : constant Overflow_Check_Type :=
- Overflow_Check_Mode (Etype (Op));
+ Overflow_Check_Mode (Etype (Op));
pragma Assert (Check_Mode in Minimized_Or_Eliminated);
Lo, Hi : Uint;
begin
-- Nothing to do if our parent is one of the following:
- -- Another signed integer arithmetic operation
+ -- Another signed integer arithmetic op
-- A membership operation
-- A comparison operation
return;
end if;
- -- Otherwise, we have a top level arithmetic operator node, and this
+ -- Otherwise, we have a top level arithmetic operation node, and this
-- is where we commence the special processing for minimize/eliminate.
-- This is the case where we tell the machinery not to move into Bignum
-- mode at this top level (of course the top level operation will still
Loc : constant Source_Ptr := Sloc (N);
begin
- -- Nothing to do if Bignum already
+ -- Nothing to do if Bignum already except call Relocate_Node
if Is_RTE (Etype (N), RE_Bignum) then
return Relocate_Node (N);
N_Op_Rem | N_Op_Subtract =>
return Is_Signed_Integer_Type (Etype (N));
+ when N_Conditional_Expression |
+ N_Case_Expression =>
+ return Is_Signed_Integer_Type (Etype (N));
+
+ when N_Case_Expression_Alternative =>
+ return Is_Signed_Integer_Type (Etype (Parent (N)));
+
when others =>
return False;
end case;
Hi : out Uint;
Top_Level : Boolean)
is
- pragma Assert (Is_Signed_Integer_Type (Etype (N)));
+ Rtyp : constant Entity_Id := Etype (N);
+ 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);
pragma Assert (Check_Mode in Minimized_Or_Eliminated);
Loc : constant Source_Ptr := Sloc (N);
Rlo, Rhi : Uint;
- -- Ranges of values for right operand
+ -- Ranges of values for right operand (operator case)
Llo, Lhi : Uint;
- -- Ranges of values for left operand
+ -- Ranges of values for left operand (operator case)
LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
-- Operands and results are of this type when we convert
- LLLo, LLHi : Uint;
+ LLLo : constant Uint := Intval (Type_Low_Bound (LLIB));
+ LLHi : constant Uint := Intval (Type_High_Bound (LLIB));
-- Bounds of Long_Long_Integer
Binary : constant Boolean := Nkind (N) in N_Binary_Op;
Bignum_Operands : Boolean;
-- Set True if one or more operands is already of type Bignum, meaning
-- that for sure (regardless of Top_Level setting) we are committed to
- -- doing the operation in Bignum mode.
+ -- doing the operation in Bignum mode (or in the case of a case or if
+ -- expression, converting all the dependent expressions to bignum).
+
+ Long_Long_Integer_Operands : Boolean;
+ -- Set True if one r more operands is already of type Long_Loong_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.
+
+ function In_Result_Range return Boolean;
+ -- Returns True iff Lo .. Hi are within range of the result type
procedure Max (A : in out Uint; B : Uint);
-- If A is No_Uint, sets A to B, else to UI_Max (A, B);
procedure Min (A : in out Uint; B : Uint);
-- If A is No_Uint, sets A to B, else to UI_Min (A, B);
+ ---------------------
+ -- In_Result_Range --
+ ---------------------
+
+ function In_Result_Range return Boolean is
+ begin
+ if Is_Static_Subtype (Etype (N)) then
+ return Lo >= Expr_Value (Type_Low_Bound (Rtyp))
+ and then
+ Hi <= Expr_Value (Type_High_Bound (Rtyp));
+ else
+ return Lo >= Expr_Value (Type_Low_Bound (Base_Type (Rtyp)))
+ and then
+ Hi <= Expr_Value (Type_High_Bound (Base_Type (Rtyp)));
+ end if;
+ end In_Result_Range;
+
---------
-- Max --
---------
-- Start of processing for Minimize_Eliminate_Overflow_Checks
begin
- -- Case where we do not have an arithmetic operator
+ -- Case where we do not have a signed integer arithmetic operation
if not Is_Signed_Integer_Arithmetic_Op (N) then
return;
- -- If we have an arithmetic oeprator we make recursive calls on the
+ -- Processing for if expression
+
+ elsif Nkind (N) = N_Conditional_Expression then
+ declare
+ Then_DE : constant Node_Id := Next (First (Expressions (N)));
+ Else_DE : constant Node_Id := Next (Then_DE);
+
+ begin
+ Bignum_Operands := False;
+
+ Minimize_Eliminate_Overflow_Checks
+ (Then_DE, Lo, Hi, Top_Level => False);
+
+ if Lo = No_Uint then
+ Bignum_Operands := True;
+ end if;
+
+ Minimize_Eliminate_Overflow_Checks
+ (Else_DE, Rlo, Rhi, Top_Level => False);
+
+ if Rlo = No_Uint then
+ Bignum_Operands := True;
+ else
+ Long_Long_Integer_Operands :=
+ Etype (Then_DE) = LLIB or else Etype (Else_DE) = LLIB;
+
+ Min (Lo, Rlo);
+ Max (Hi, Rhi);
+ end if;
+
+ -- If at least one of our operands is now bignum, we must rebuild
+ -- the if expression to use bignum operands. We will analyze the
+ -- rebuilt if expression with overflow checks off, since once we
+ -- are in bignum mode, we are all done with overflow checks!
+
+ if Bignum_Operands then
+ Rewrite (N,
+ Make_Conditional_Expression (Loc,
+ Expressions => New_List (
+ Remove_Head (Expressions (N)),
+ Convert_To_Bignum (Then_DE),
+ Convert_To_Bignum (Else_DE)),
+ Is_Elsif => Is_Elsif (N)));
+
+ Analyze_And_Resolve
+ (N, RTE (RE_Bignum), Suppress => Overflow_Check);
+
+ -- If we have no Long_Long_Integer operands, then we are in result
+ -- range, since it means that none of our operands felt the need
+ -- to worry about overflow (otherwise it would have already been
+ -- converted to long long integer or bignum).
+
+ elsif not Long_Long_Integer_Operands then
+ Set_Do_Overflow_Check (N, False);
+
+ -- Otherwise convert us to long long integer mode. Note that we
+ -- don't need any further overflow checking at this level.
+
+ else
+ Convert_To_And_Rewrite (LLIB, Then_DE);
+ Convert_To_And_Rewrite (LLIB, Else_DE);
+ Set_Etype (N, LLIB);
+ Set_Do_Overflow_Check (N, False);
+ end if;
+ end;
+
+ return;
+
+ -- Here for case expression
+
+ elsif Nkind (N) = N_Case_Expression then
+ Bignum_Operands := False;
+ Long_Long_Integer_Operands := False;
+ Lo := No_Uint;
+ Hi := No_Uint;
+
+ declare
+ Alt : Node_Id;
+ New_Alts : List_Id;
+ New_Exp : Node_Id;
+ Rtype : Entity_Id;
+
+ begin
+ -- Loop through expressions applying recursive call
+
+ Alt := First (Alternatives (N));
+ while Present (Alt) loop
+ declare
+ Aexp : constant Node_Id := Expression (Alt);
+
+ begin
+ Minimize_Eliminate_Overflow_Checks
+ (Aexp, Lo, Hi, Top_Level => False);
+
+ if Lo = No_Uint then
+ Bignum_Operands := True;
+ elsif Etype (Aexp) = LLIB then
+ Long_Long_Integer_Operands := True;
+ end if;
+ end;
+
+ Next (Alt);
+ end loop;
+
+ -- If we have no bignum or long long integer operands, it means
+ -- that none of our dependent expressions could raise overflow.
+ -- In this case, we simply return with no changes except for
+ -- resetting the overflow flag, since we are done with overflow
+ -- checks for this node. We will reset the Analyzed flag so that
+ -- we will properly reexpand and get the needed expansion for
+ -- the case expression.
+
+ if not (Bignum_Operands or else Long_Long_Integer_Operands) then
+ Set_Do_Overflow_Check (N, False);
+ Set_Analyzed (N, False);
+
+ -- Otherwise we are going to rebuild the case expression using
+ -- either bignum or long long integer operands throughout.
+
+ else
+ New_Alts := New_List;
+ Alt := First (Alternatives (N));
+ while Present (Alt) loop
+ if Bignum_Operands then
+ New_Exp := Convert_To_Bignum (Expression (Alt));
+ Rtype := RTE (RE_Bignum);
+ else
+ New_Exp := Convert_To (LLIB, Expression (Alt));
+ Rtype := LLIB;
+ end if;
+
+ Append_To (New_Alts,
+ Make_Case_Expression_Alternative (Sloc (Alt),
+ Actions => No_List,
+ Discrete_Choices => Discrete_Choices (Alt),
+ Expression => New_Exp));
+
+ Next (Alt);
+ end loop;
+
+ Rewrite (N,
+ Make_Case_Expression (Loc,
+ Expression => Expression (N),
+ Alternatives => New_Alts));
+
+ Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check);
+ end if;
+ end;
+
+ return;
+ end if;
+
+ -- If we have an arithmetic operator we make recursive calls on the
-- operands to get the ranges (and to properly process the subtree
-- that lies below us!)
- else
- Minimize_Eliminate_Overflow_Checks
- (Right_Opnd (N), Rlo, Rhi, Top_Level => False);
+ Minimize_Eliminate_Overflow_Checks
+ (Right_Opnd (N), Rlo, Rhi, Top_Level => False);
- if Binary then
- Minimize_Eliminate_Overflow_Checks
- (Left_Opnd (N), Llo, Lhi, Top_Level => False);
- end if;
+ if Binary then
+ Minimize_Eliminate_Overflow_Checks
+ (Left_Opnd (N), Llo, Lhi, Top_Level => False);
end if;
-- If either operand is a bignum, then result will be a bignum
else
Bignum_Operands := False;
+ Long_Long_Integer_Operands :=
+ Etype (Right_Opnd (N)) = LLIB
+ or else (Binary and then Etype (Left_Opnd (N)) = LLIB);
+
case Nkind (N) is
-- Absolute value
-- 0 .. 1, but the cases are rare and it is not worth the effort.
-- Failing to do this switching back is only an efficiency issue.
- LLLo := Intval (Type_Low_Bound (LLIB));
- LLHi := Intval (Type_High_Bound (LLIB));
-
if Lo = No_Uint or else Lo < LLLo or else Hi > LLHi then
-- OK, we are definitely outside the range of Long_Long_Integer. The
Set_Do_Overflow_Check (N, False);
end if;
+ -- If Result is in range of the result type, and we don't have any
+ -- Long_Long_Integer operands, then overflow checking is not needed
+ -- and we have nothing to do (we have already reset Do_Overflow_Check).
+
+ if In_Result_Range and not Long_Long_Integer_Operands then
+ return;
+ end if;
+
-- Here we will do the operation in Long_Long_Integer. We do this even
-- if we know an overflow check is required, better to do this in long
-- long integer mode, since we are less likely to overflow!
-- See also the description of Do_Range_Check for this case. The only
-- attribute references which use this flag are Pred and Succ, where it
-- means that the result should be checked for going outside the base
- -- range. Note that this flag is not set for modular types.
+ -- range. Note that this flag is not set for modular types. This flag is
+ -- also set on conditional expression nodes if we are operating in either
+ -- MINIMIZED or ELIMINATED overflow checking mode (to make sure that we
+ -- properly process overflow checking for dependent expressions).
-- Do_Range_Check (Flag9-Sem)
-- This flag is set on an expression which appears in a context where a
-- Note on overflow handling: When the overflow checking mode is set to
-- MINIMIZED or ELIMINATED, nodes for signed arithmetic operations may
-- be modified to use a larger type for the operands and result. In
- -- these cases, the back end does not need the Entity field anyway, so
- -- there is no point in setting it. In fact we reuse the Entity field to
- -- record the possible range of the result. Entity points to an N_Range
- -- node whose Low_Bound and High_Bound fields point to integer literal
- -- nodes containing the computed bounds. These range nodes are only set
- -- for intermediate nodes whose parents are themselves either arithmetic
- -- operators, or comparison or membership tests. The computed ranges are
- -- then used in processing the parent operation. In the case where the
- -- computed range exceeds that of Long_Long_Integer, and we are running
- -- in ELIMINATED mode, the operator node will be changed to be a call to
- -- the appropriate routine in System.Bignums, and in this case we forget
- -- about keeping track of the range.
+ -- the case where the computed range exceeds that of Long_Long_Integer,
+ -- and we are running in ELIMINATED mode, the operator node will be
+ -- changed to be a call to the appropriate routine in System.Bignums.
+
+ ------------------------------------
+ -- 4.5.7 Conditional Expressions --
+ ------------------------------------
+
+ -- CONDITIONAL_EXPRESSION ::= IF_EXPRESSION | CASE_EXPRESSION
+
+ --------------------------
+ -- 4.5.7 If Expression --
+ ----------------------------
+
+ -- IF_EXPRESSION ::=
+ -- if CONDITION then DEPENDENT_EXPRESSION
+ -- {elsif CONDITION then DEPENDENT_EXPRESSION}
+ -- [else DEPENDENT_EXPRESSION]
+
+ -- DEPENDENT_EXPRESSION ::= EXPRESSION
+
+ -- Note: if we have (IF x1 THEN x2 ELSIF x3 THEN x4 ELSE x5) then it
+ -- is represented as (IF x1 THEN x2 ELSE (IF x3 THEN x4 ELSE x5)) and
+ -- the Is_Elsif flag is set on the inner conditional expression.
+
+ -- Note: to be consistent with the grammar, the following node should
+ -- really be named N_If_Expression, but historically it was always
+ -- N_Conditional_Expression, so it would be a bit of an earthquake
+ -- to change, and actually conditional expression seems a bit clearer
+ -- than if expression in typical contexts, so we decide to leave it!
+
+ -- N_Conditional_Expression
+ -- Sloc points to IF or ELSIF keyword
+ -- Expressions (List1)
+ -- Then_Actions (List2-Sem)
+ -- Else_Actions (List3-Sem)
+ -- Is_Elsif (Flag13) (set if comes from ELSIF)
+ -- Do_Overflow_Check (Flag17-Sem)
+ -- plus fields for expression
+
+ -- Expressions here is a three-element list, whose first element is the
+ -- condition, the second element is the dependent expression after THEN
+ -- and the third element is the dependent expression after the ELSE
+ -- (explicitly set to True if missing).
+
+ -- Note: the Then_Actions and Else_Actions fields are always set to
+ -- No_List in the tree passed to Gigi. These fields are used only
+ -- for temporary processing purposes in the expander.
+
+ ----------------------------
+ -- 4.5.7 Case Expression --
+ ----------------------------
+
+ -- CASE_EXPRESSION ::=
+ -- case SELECTING_EXPRESSION is
+ -- CASE_EXPRESSION_ALTERNATIVE
+ -- {CASE_EXPRESSION_ALTERNATIVE}
+
+ -- Note that the Alternatives cannot include pragmas (this contrasts
+ -- with the situation of case statements where pragmas are allowed).
+
+ -- N_Case_Expression
+ -- Sloc points to CASE
+ -- Expression (Node3) (the selecting expression)
+ -- Alternatives (List4) (the case expression alternatives)
+ -- Do_Overflow_Check (Flag17-Sem)
+
+ ----------------------------------------
+ -- 4.5.7 Case Expression Alternative --
+ ----------------------------------------
+
+ -- CASE_EXPRESSION_ALTERNATIVE ::=
+ -- when DISCRETE_CHOICE_LIST =>
+ -- DEPENDENT_EXPRESSION
+
+ -- N_Case_Expression_Alternative
+ -- Sloc points to WHEN
+ -- Actions (List1)
+ -- Discrete_Choices (List4)
+ -- Expression (Node3)
+
+ -- Note: The Actions field temporarily holds any actions associated with
+ -- evaluation of the Expression. During expansion of the case expression
+ -- these actions are wrapped into an N_Expressions_With_Actions node
+ -- replacing the original expression.
---------------------------------
-- 4.5.9 Quantified Expression --
-- show this syntax.
-- Note: Case_Expression and Conditional_Expression is in this section for
- -- now, since they are extensions. We will move them to their appropriate
- -- places when they are officially approved as extensions (and then we will
- -- know what the exact grammar and place in the Reference Manual is!)
-
- ---------------------
- -- Case Expression --
- ---------------------
-
- -- CASE_EXPRESSION ::=
- -- case EXPRESSION is
- -- CASE_EXPRESSION_ALTERNATIVE
- -- {CASE_EXPRESSION_ALTERNATIVE}
-
- -- Note that the Alternatives cannot include pragmas (this contrasts
- -- with the situation of case statements where pragmas are allowed).
-
- -- N_Case_Expression
- -- Sloc points to CASE
- -- Expression (Node3)
- -- Alternatives (List4)
-
- ---------------------------------
- -- Case Expression Alternative --
- ---------------------------------
-
- -- CASE_STATEMENT_ALTERNATIVE ::=
- -- when DISCRETE_CHOICE_LIST =>
- -- EXPRESSION
-
- -- N_Case_Expression_Alternative
- -- Sloc points to WHEN
- -- Actions (List1)
- -- Discrete_Choices (List4)
- -- Expression (Node3)
-
- -- Note: The Actions field temporarily holds any actions associated with
- -- evaluation of the Expression. During expansion of the case expression
- -- these actions are wrapped into an N_Expressions_With_Actions node
- -- replacing the original expression.
-
- ----------------------------
- -- Conditional Expression --
- ----------------------------
-
- -- This node is used to represent an expression corresponding to the
- -- C construct (condition ? then-expression : else_expression), where
- -- Expressions is a three element list, whose first expression is the
- -- condition, and whose second and third expressions are the then and
- -- else expressions respectively.
-
- -- Note: the Then_Actions and Else_Actions fields are always set to
- -- No_List in the tree passed to Gigi. These fields are used only
- -- for temporary processing purposes in the expander.
-
- -- The Ada language does not permit conditional expressions, however
- -- this is under discussion as a possible extension by the ARG, and we
- -- have implemented a form of this capability in GNAT under control of
- -- the -gnatX switch. The syntax is:
-
- -- CONDITIONAL_EXPRESSION ::=
- -- if EXPRESSION then EXPRESSION
- -- {elsif EXPRESSION then EXPRESSION}
- -- [else EXPRESSION]
-
- -- And we add the additional constructs
-
- -- PRIMARY ::= ( CONDITIONAL_EXPRESSION )
- -- PRAGMA_ARGUMENT_ASSOCIATION ::= CONDITIONAL_EXPRESSION
-
- -- Note: if we have (IF x1 THEN x2 ELSIF x3 THEN x4 ELSE x5) then it
- -- is represented as (IF x1 THEN x2 ELSE (IF x3 THEN x4 ELSE x5)) and
- -- the Is_Elsif flag is set on the inner conditional expression.
-
- -- N_Conditional_Expression
- -- Sloc points to IF or ELSIF keyword
- -- Expressions (List1)
- -- Then_Actions (List2-Sem)
- -- Else_Actions (List3-Sem)
- -- Is_Elsif (Flag13) (set if comes from ELSIF)
- -- plus fields for expression
+ -- historical reasons, since they were initially extensions. Now that they
+ -- are an official part of Ada 2012, we should move them to the appropriate
+ -- section of this package. ???
--------------
-- Contract --
projects / platform / upstream / gcc.git / commitdiff