aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorRobert Dewar <dewar@adacore.com>2012-10-01 13:12:26 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2012-10-01 15:12:26 +0200
commitf619427812a37d1249b1a85434dde71b8efdc40a (patch)
tree93e1d49dd1f5bb39c1680522d66c5b96eea18009 /gcc/ada
parente0df453331f97b78cbd77a377a3d2531137eb7b2 (diff)
downloadgcc-f619427812a37d1249b1a85434dde71b8efdc40a.zip
gcc-f619427812a37d1249b1a85434dde71b8efdc40a.tar.gz
gcc-f619427812a37d1249b1a85434dde71b8efdc40a.tar.bz2
checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): Handle case of appearing in range in membership test.
2012-10-01 Robert Dewar <dewar@adacore.com> * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): Handle case of appearing in range in membership test. * exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow): New procedure (Expand_N_In): Use Expand_Membership_Minimize_Eliminate_Overflow. * rtsfind.ads: Add RE_Bignum_In_LLI_Range. * s-bignum.ads, s-bignum.adb (Bignum_In_LLI_Range): New function. * sinfo.ads, sinfo.adb (No_Minimize_Eliminate): New flag. 2012-10-01 Robert Dewar <dewar@adacore.com> * uintp.ads: Minor reformatting. From-SVN: r191918
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog15
-rw-r--r--gcc/ada/checks.adb6
-rw-r--r--gcc/ada/exp_ch4.adb362
-rw-r--r--gcc/ada/rtsfind.ads2
-rw-r--r--gcc/ada/s-bignum.adb27
-rw-r--r--gcc/ada/s-bignum.ads4
-rw-r--r--gcc/ada/sinfo.adb18
-rw-r--r--gcc/ada/sinfo.ads15
-rw-r--r--gcc/ada/uintp.ads63
9 files changed, 470 insertions, 42 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 24d56a1..7753077 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2012-10-01 Robert Dewar <dewar@adacore.com>
+
+ * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
+ Handle case of appearing in range in membership test.
+ * exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow):
+ New procedure (Expand_N_In): Use
+ Expand_Membership_Minimize_Eliminate_Overflow.
+ * rtsfind.ads: Add RE_Bignum_In_LLI_Range.
+ * s-bignum.ads, s-bignum.adb (Bignum_In_LLI_Range): New function.
+ * sinfo.ads, sinfo.adb (No_Minimize_Eliminate): New flag.
+
+2012-10-01 Robert Dewar <dewar@adacore.com>
+
+ * uintp.ads: Minor reformatting.
+
2012-10-01 Ed Schonberg <schonberg@adacore.com>
* checks.adb: Improve warning message.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 219e671..b83c87f 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1091,6 +1091,12 @@ package body Checks is
if Is_Signed_Integer_Arithmetic_Op (P)
or else Nkind (Op) in N_Membership_Test
or else Nkind (Op) in N_Op_Compare
+
+ -- We may also be a range operand in a membership test
+
+ or else (Nkind (Op) = N_Range
+ and then Nkind (Parent (Op)) in N_Membership_Test)
+
then
return;
end if;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9d22e9c..0da3554 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -164,6 +164,12 @@ package body Exp_Ch4 is
-- concatenation. The operands can be of any appropriate type, and can
-- include both arrays and singleton elements.
+ procedure Expand_Membership_Minimize_Eliminate_Overflow (N : Node_Id);
+ -- N is an N_In membership test mode, with the overflow check mode
+ -- set to Minimized or Eliminated, and the type of the left operand
+ -- is a signed integer type. This is a case where top level processing
+ -- is required to handle overflow checks in subtrees.
+
procedure Fixup_Universal_Fixed_Operation (N : Node_Id);
-- N is a N_Op_Divide or N_Op_Multiply node whose result is universal
-- fixed. We do not have such a type at runtime, so the purpose of this
@@ -875,7 +881,7 @@ package body Exp_Ch4 is
end;
end if;
- -- Would be nice to comment the branches of this very long if ???
+ -- Case of tagged type or type requiring finalization
if Is_Tagged_Type (T) or else Needs_Finalization (T) then
if Is_CPP_Constructor_Call (Exp) then
@@ -3705,6 +3711,332 @@ package body Exp_Ch4 is
-- Set_Etype (Cnode, Atyp);
end Expand_Concatenate;
+ ---------------------------------------------------
+ -- Expand_Membership_Minimize_Eliminate_Overflow --
+ ---------------------------------------------------
+
+ procedure Expand_Membership_Minimize_Eliminate_Overflow (N : Node_Id) is
+ pragma Assert (Nkind (N) = N_In);
+ -- Despite the name, this routine applies only to N_In, not to
+ -- N_Not_In. The latter is always rewritten as not (X in Y).
+
+ Loc : constant Source_Ptr := Sloc (N);
+ Lop : constant Node_Id := Left_Opnd (N);
+ Rop : constant Node_Id := Right_Opnd (N);
+ Ltype : constant Entity_Id := Etype (Lop);
+ Rtype : constant Entity_Id := Etype (Rop);
+
+ Restype : constant Entity_Id := Etype (N);
+ -- Save result type
+
+ Lo, Hi : Uint;
+ -- Bounds in Minimize calls, not used yet ???
+
+ LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
+ -- Entity for Long_Long_Integer'Base (Standard should export this???)
+
+ begin
+ Minimize_Eliminate_Overflow_Checks (Lop, Lo, Hi);
+
+ -- If right operand is a subtype name, and the subtype name has no
+ -- predicate, then we can just replace the right operand with an
+ -- explicit range T'First .. T'Last, and use the explicit range code.
+
+ if Nkind (Rop) /= N_Range and then No (Predicate_Function (Rtype)) then
+ Rewrite (Rop,
+ Make_Range (Loc,
+ Low_Bound =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_First,
+ Prefix => New_Reference_To (Rtype, Loc)),
+
+ High_Bound =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Last,
+ Prefix => New_Reference_To (Rtype, Loc))));
+ Analyze_And_Resolve (Rop, Rtype, Suppress => All_Checks);
+ end if;
+
+ -- Here for the explicit range case. Note that the bounds of the range
+ -- have not been processed for minimized or eliminated checks.
+
+ if Nkind (Rop) = N_Range then
+ Minimize_Eliminate_Overflow_Checks (Low_Bound (Rop), Lo, Hi);
+ Minimize_Eliminate_Overflow_Checks (High_Bound (Rop), Lo, Hi);
+
+ -- We have A in B .. C, treated as A >= B and then A <= C
+
+ -- Bignum case
+
+ if Is_RTE (Ltype, RE_Bignum)
+ or else Is_RTE (Etype (Low_Bound (Rop)), RE_Bignum)
+ or else Is_RTE (Etype (High_Bound (Rop)), RE_Bignum)
+ then
+ declare
+ Blk : constant Node_Id := Make_Bignum_Block (Loc);
+ Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+ Lopnd : constant Node_Id := Convert_To_Bignum (Lop);
+ Lbound : constant Node_Id :=
+ Convert_To_Bignum (Low_Bound (Rop));
+ Hbound : constant Node_Id :=
+ Convert_To_Bignum (High_Bound (Rop));
+
+ -- Now we insert code that looks like
+
+ -- Bnn : Boolean;
+
+ -- declare
+ -- M : Mark_Id := SS_Mark;
+ -- L : Bignum := Lopnd;
+ -- begin
+ -- Bnn := Big_GE (L, Lbound) and then Big_LE (L, Hbound)
+ -- SS_Release (M);
+ -- end;
+
+ -- and rewrite the membership test as a reference to Bnn
+
+ begin
+ Insert_After
+ (Last (Declarations (Blk)),
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Bnn,
+ Object_Definition =>
+ New_Occurrence_Of (RTE (RE_Bignum), Loc),
+ Expression => Lopnd));
+
+ Insert_Before
+ (First (Statements (Handled_Statement_Sequence (Blk))),
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Bnn, Loc),
+ Expression =>
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Big_GE), Loc),
+ Parameter_Associations => New_List (Lbound)),
+ Right_Opnd =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Big_GE), Loc),
+ Parameter_Associations => New_List (Hbound)))));
+
+ Insert_Actions (N, New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Bnn,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Boolean, Loc)),
+ Blk));
+
+ Rewrite (N, New_Occurrence_Of (Bnn, Loc));
+ Analyze_And_Resolve (N);
+ return;
+ end;
+
+ -- Here if no bignums around
+
+ else
+ -- Case where types are all the same
+
+ if Ltype = Etype (Low_Bound (Rop))
+ and then
+ Ltype = Etype (High_Bound (Rop))
+ then
+ null;
+
+ -- If types are not all the same, it means that we have rewritten
+ -- at least one of them to be of type Long_Long_Integer, and we
+ -- will convert the other operands to Long_Long_Integer.
+
+ else
+ Convert_To_And_Rewrite (LLIB, Lop);
+ Analyze_And_Resolve (Lop, LLIB, Suppress => All_Checks);
+
+ Convert_To_And_Rewrite (LLIB, Low_Bound (Rop));
+ Convert_To_And_Rewrite (LLIB, High_Bound (Rop));
+ Set_Analyzed (Rop, False);
+ Analyze_And_Resolve (Rop, LLIB, Suppress => All_Checks);
+ end if;
+
+ -- Now the three operands are of the same signed integer type,
+ -- so we can use the normal expansion routine for membership.
+
+ Set_No_Minimize_Eliminate (N);
+ Expand_N_In (N);
+ end if;
+
+ -- Right operand is a subtype name and the subtype has a predicate. We
+ -- have to make sure predicate is checked, and for that we need to use
+ -- the standard N_In circuitry with appropriate types.
+
+ else
+ pragma Assert (Present (Predicate_Function (Rtype)));
+
+ -- If types are "right", just call Expand_N_In preventing recursion
+
+ if Base_Type (Ltype) = Base_Type (Rtype) then
+ Set_No_Minimize_Eliminate (N);
+ Expand_N_In (N);
+
+ -- Bignum case
+
+ elsif Is_RTE (Ltype, RE_Bignum) then
+
+ -- For X in T, we want to insert code that looks like
+
+ -- Bnn : Boolean;
+
+ -- declare
+ -- M : Mark_Id := SS_Mark;
+ -- Lnn : Long_Long_Integer'Base
+ -- Nnn : Bignum;
+
+ -- begin
+ -- Nnn := X;
+
+ -- if not Bignum_In_LLI_Range (Nnn) then
+ -- Bnn := False;
+ -- else
+ -- Lnn := From_Bignum (Nnn);
+ -- Bnn := Lnn in T'Base and then T'Base (Lnn) in T;
+ -- end if;
+ --
+ -- SS_Release (M);
+ -- end;
+
+ -- And then rewrite the original membership as a reference to Bnn.
+ -- A bit gruesome, but here goes.
+
+ declare
+ Blk : constant Node_Id := Make_Bignum_Block (Loc);
+ Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+ Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N);
+ Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N);
+ Nin : Node_Id;
+
+ begin
+ -- The last membership test is marked to prevent recursion
+
+ Nin :=
+ Make_In (Loc,
+ Left_Opnd =>
+ Convert_To (Base_Type (Rtype),
+ New_Occurrence_Of (Lnn, Loc)),
+ Right_Opnd => New_Occurrence_Of (Rtype, Loc));
+ Set_No_Minimize_Eliminate (Nin);
+
+ -- Now decorate the block
+
+ Insert_After
+ (Last (Declarations (Blk)),
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Lnn,
+ Object_Definition => New_Occurrence_Of (LLIB, Loc)));
+
+ Insert_After
+ (Last (Declarations (Blk)),
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Nnn,
+ Object_Definition =>
+ New_Occurrence_Of (RTE (RE_Bignum), Loc)));
+
+ Insert_List_Before
+ (First (Statements (Handled_Statement_Sequence (Blk))),
+ New_List (
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Nnn, Loc),
+ Expression => Relocate_Node (Lop)),
+
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_Bignum_In_LLI_Range), Loc),
+ Parameter_Associations => New_List (
+ New_Occurrence_Of (Nnn, Loc))),
+
+ Then_Statements => New_List (
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Bnn, Loc),
+ Expression =>
+ New_Occurrence_Of (Standard_False, Loc))),
+
+ Else_Statements => New_List (
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Lnn, Loc),
+ Expression =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_From_Bignum), Loc),
+ Parameter_Associations => New_List (
+ New_Occurrence_Of (Nnn, Loc)))),
+
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Bnn, Loc),
+ Expression =>
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_In (Loc,
+ Left_Opnd =>
+ New_Occurrence_Of (Lnn, Loc),
+ Right_Opnd =>
+ New_Occurrence_Of
+ (Base_Type (Rtype), Loc)),
+ Right_Opnd => Nin))))));
+
+ Insert_Actions (N, New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Bnn,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Boolean, Loc)),
+ Blk));
+
+ Rewrite (N, New_Occurrence_Of (Bnn, Loc));
+ Analyze_And_Resolve (N);
+ return;
+ end;
+
+ -- Not bignum case, but types don't match (this means we rewrote the
+ -- left operand to be Long_Long_Integer.
+
+ else
+ pragma Assert (Base_Type (Ltype) = LLIB);
+
+ -- We rewrite the membership test as
+
+ -- Lop in T'Base and then T'Base (Lop) in T
+
+ declare
+ Nin : Node_Id;
+
+ begin
+ -- The last membership test is marked to prevent recursion
+
+ Nin :=
+ Make_In (Loc,
+ Left_Opnd =>
+ Convert_To (Base_Type (Rtype), Duplicate_Subexpr (Lop)),
+ Right_Opnd => New_Occurrence_Of (Rtype, Loc));
+ Set_No_Minimize_Eliminate (Nin);
+
+ -- Now do the rewrite
+
+ Rewrite (N,
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_In (Loc,
+ Left_Opnd => Lop,
+ Right_Opnd =>
+ New_Occurrence_Of (Base_Type (Ltype), Loc)),
+ Right_Opnd => Nin));
+
+ Analyze_And_Resolve (N, Restype, Suppress => All_Checks);
+ end;
+ end if;
+ end if;
+ end Expand_Membership_Minimize_Eliminate_Overflow;
+
------------------------
-- Expand_N_Allocator --
------------------------
@@ -5130,6 +5462,18 @@ package body Exp_Ch4 is
Ltyp := Etype (Left_Opnd (N));
Rtyp := Etype (Right_Opnd (N));
+ -- If Minimize/Eliminate overflow mode and type is a signed integer
+ -- 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
+ and then Is_Signed_Integer_Type (Ltyp)
+ and then not No_Minimize_Eliminate (N)
+ then
+ Expand_Membership_Minimize_Eliminate_Overflow (N);
+ return;
+ end if;
+
-- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid
-- test and give a warning. For floating point types however, this is a
@@ -5225,9 +5569,9 @@ package body Exp_Ch4 is
and then Expr_Value (Type_High_Bound (Ltyp)) = Expr_Value (Hi)
and then Expr_Value (Type_Low_Bound (Ltyp)) = Expr_Value (Lo)
- -- Kill warnings in instances, since they may be cases where we
- -- have a test in the generic that makes sense with some types
- -- and not with other types.
+ -- Kill warnings in instances, since they may be cases where we
+ -- have a test in the generic that makes sense with some types
+ -- and not with other types.
and then not In_Instance
then
@@ -5388,8 +5732,8 @@ package body Exp_Ch4 is
-- type if they come from the original type definition. Also this
-- way we get all the processing above for an explicit range.
- -- Don't do this for predicated types, since in this case we
- -- want to check the predicate!
+ -- Don't do this for predicated types, since in this case we
+ -- want to check the predicate!
elsif Is_Scalar_Type (Typ) then
if No (Predicate_Function (Typ)) then
@@ -5398,12 +5742,12 @@ package body Exp_Ch4 is
Low_Bound =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
- Prefix => New_Reference_To (Typ, Loc)),
+ Prefix => New_Reference_To (Typ, Loc)),
High_Bound =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
- Prefix => New_Reference_To (Typ, Loc))));
+ Prefix => New_Reference_To (Typ, Loc))));
Analyze_And_Resolve (N, Restyp);
end if;
@@ -5423,7 +5767,7 @@ package body Exp_Ch4 is
Reason => PE_Unchecked_Union_Restriction));
-- Prevent Gigi from generating incorrect code by rewriting the
- -- test as False.
+ -- test as False. What is this undocumented thing about ???
Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
goto Leave;
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index b2e757e..ee9919a 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -778,6 +778,7 @@ package Rtsfind is
RE_Big_NE, -- System.Bignums
RE_Bignum, -- System.Bignums
+ RE_Bignum_In_LLI_Range, -- System.Bignums
RE_To_Bignum, -- System.Bignums
RE_From_Bignum, -- System.Bignums
@@ -2021,6 +2022,7 @@ package Rtsfind is
RE_Big_NE => System_Bignums,
RE_Bignum => System_Bignums,
+ RE_Bignum_In_LLI_Range => System_Bignums,
RE_To_Bignum => System_Bignums,
RE_From_Bignum => System_Bignums,
diff --git a/gcc/ada/s-bignum.adb b/gcc/ada/s-bignum.adb
index 06f7efd..3474e1b 100644
--- a/gcc/ada/s-bignum.adb
+++ b/gcc/ada/s-bignum.adb
@@ -963,6 +963,33 @@ package body System.Bignums is
raise Constraint_Error with "expression value out of range";
end From_Bignum;
+ -------------------------
+ -- Bignum_In_LLI_Range --
+ -------------------------
+
+ function Bignum_In_LLI_Range (X : Bignum) return Boolean is
+ begin
+ -- If length is 0 or 1, definitely fits
+
+ if X.Len <= 1 then
+ return True;
+
+ -- If length is greater than 2, definitely does not fit
+
+ elsif X.Len > 2 then
+ return False;
+
+ -- Length is 2, more tests needed
+
+ else
+ declare
+ Mag : constant DD := X.D (1) & X.D (2);
+ begin
+ return Mag < 2 ** 63 or else (X.Neg and then Mag = 2 ** 63);
+ end;
+ end if;
+ end Bignum_In_LLI_Range;
+
---------------
-- Normalize --
---------------
diff --git a/gcc/ada/s-bignum.ads b/gcc/ada/s-bignum.ads
index de414a5..ecc0784 100644
--- a/gcc/ada/s-bignum.ads
+++ b/gcc/ada/s-bignum.ads
@@ -91,6 +91,10 @@ package System.Bignums is
-- Perform indicated comparison on bignums, returning result as Boolean.
-- No exception raised for any input arguments.
+ function Bignum_In_LLI_Range (X : Bignum) return Boolean;
+ -- Returns True if the Bignum value is in the range of Long_Long_Integer,
+ -- so that a call to From_Bignum is guaranteed not to raise an exception.
+
function To_Bignum (X : Long_Long_Integer) return Bignum;
-- Convert Long_Long_Integer to Bignum. No exception can be raised for any
-- input argument.
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index d2413ad..e5773e0 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2235,6 +2235,15 @@ package body Sinfo is
return Flag13 (N);
end No_Initialization;
+ function No_Minimize_Eliminate
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_In
+ or else NT (N).Nkind = N_Not_In);
+ return Flag17 (N);
+ end No_Minimize_Eliminate;
+
function No_Truncation
(N : Node_Id) return Boolean is
begin
@@ -5288,6 +5297,15 @@ package body Sinfo is
Set_Flag13 (N, Val);
end Set_No_Initialization;
+ procedure Set_No_Minimize_Eliminate
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_In
+ or else NT (N).Nkind = N_Not_In);
+ Set_Flag17 (N, Val);
+ end Set_No_Minimize_Eliminate;
+
procedure Set_No_Truncation
(N : Node_Id; Val : Boolean := True) is
begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 31a069c..fd595a7 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1545,6 +1545,11 @@ package Sinfo is
-- should not be taken into account (needed for in place initialization
-- with aggregates).
+ -- No_Minimize_Eliminate (Flag17-Sem)
+ -- This flag is present in membership operator nodes (N_In/N_Not_In).
+ -- It is used to indicate that processing for extended overflow checking
+ -- modes is not required (this is used to prevent infinite recursion).
+
-- No_Truncation (Flag17-Sem)
-- Present in N_Unchecked_Type_Conversion node. This flag has an effect
-- only if the RM_Size of the source is greater than the RM_Size of the
@@ -3675,6 +3680,7 @@ package Sinfo is
-- Left_Opnd (Node2)
-- Right_Opnd (Node3)
-- Alternatives (List4) (set to No_List if only one set alternative)
+ -- No_Minimize_Eliminate (Flag17)
-- plus fields for expression
-- N_Not_In
@@ -3682,6 +3688,7 @@ package Sinfo is
-- Left_Opnd (Node2)
-- Right_Opnd (Node3)
-- Alternatives (List4) (set to No_List if only one set alternative)
+ -- No_Minimize_Eliminate (Flag17)
-- plus fields for expression
--------------------
@@ -8794,6 +8801,9 @@ package Sinfo is
function No_Initialization
(N : Node_Id) return Boolean; -- Flag13
+ function No_Minimize_Eliminate
+ (N : Node_Id) return Boolean; -- Flag17
+
function No_Truncation
(N : Node_Id) return Boolean; -- Flag17
@@ -9766,6 +9776,9 @@ package Sinfo is
procedure Set_No_Initialization
(N : Node_Id; Val : Boolean := True); -- Flag13
+ procedure Set_No_Minimize_Eliminate
+ (N : Node_Id; Val : Boolean := True); -- Flag17
+
procedure Set_No_Truncation
(N : Node_Id; Val : Boolean := True); -- Flag17
@@ -12017,6 +12030,7 @@ package Sinfo is
pragma Inline (No_Elaboration_Check);
pragma Inline (No_Entities_Ref_In_Spec);
pragma Inline (No_Initialization);
+ pragma Inline (No_Minimize_Eliminate);
pragma Inline (No_Truncation);
pragma Inline (Null_Present);
pragma Inline (Null_Exclusion_Present);
@@ -12337,6 +12351,7 @@ package Sinfo is
pragma Inline (Set_No_Elaboration_Check);
pragma Inline (Set_No_Entities_Ref_In_Spec);
pragma Inline (Set_No_Initialization);
+ pragma Inline (Set_No_Minimize_Eliminate);
pragma Inline (Set_No_Truncation);
pragma Inline (Set_Null_Present);
pragma Inline (Set_Null_Exclusion_Present);
diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads
index 41c6ff5..b730f44 100644
--- a/gcc/ada/uintp.ads
+++ b/gcc/ada/uintp.ads
@@ -248,9 +248,9 @@ package Uintp is
-- not in Char_Code range.
function Num_Bits (Input : Uint) return Nat;
- -- Approximate number of binary bits in given universal integer.
- -- This function is used for capacity checks, and it can be one
- -- bit off without affecting its usage.
+ -- Approximate number of binary bits in given universal integer. This
+ -- function is used for capacity checks, and it can be one bit off
+ -- without affecting its usage.
---------------------
-- Output Routines --
@@ -258,8 +258,8 @@ package Uintp is
type UI_Format is (Hex, Decimal, Auto);
-- Used to determine whether UI_Image/UI_Write output is in hexadecimal
- -- or decimal format. Auto, the default setting, lets the routine make
- -- a decision based on the value.
+ -- or decimal format. Auto, the default setting, lets the routine make a
+ -- decision based on the value.
UI_Image_Max : constant := 48; -- Enough for a 128-bit number
UI_Image_Buffer : String (1 .. UI_Image_Max);
@@ -271,8 +271,8 @@ package Uintp is
-- followed by the value in UI_Image_Buffer. The form of the value is an
-- integer literal in either decimal (no base) or hexadecimal (base 16)
-- format. If Hex is True on entry, then hex mode is forced, otherwise
- -- UI_Image makes a guess at which output format is more convenient. The
- -- value must fit in UI_Image_Buffer. If necessary, the result is an
+ -- UI_Image makes a guess at which output format is more convenient.
+ -- The value must fit in UI_Image_Buffer. If necessary, the result is an
-- approximation of the proper value, using an exponential format. The
-- image of No_Uint is output as a single question mark.
@@ -280,9 +280,9 @@ package Uintp is
-- Writes a representation of Uint, consisting of a possible minus sign,
-- followed by the value to the output file. The form of the value is an
-- integer literal in either decimal (no base) or hexadecimal (base 16)
- -- format as appropriate. UI_Format shows which format to use. Auto,
- -- the default, asks UI_Write to make a guess at which output format
- -- will be more convenient to read.
+ -- format as appropriate. UI_Format shows which format to use. Auto, the
+ -- default, asks UI_Write to make a guess at which output format will be
+ -- more convenient to read.
procedure pid (Input : Uint);
pragma Export (Ada, pid);
@@ -355,11 +355,11 @@ package Uintp is
-- Mark/Release Processing --
-----------------------------
- -- The space used by Uint data is not automatically reclaimed. However,
- -- a mark-release regime is implemented which allows storage to be
- -- released back to a previously noted mark. This is used for example
- -- when doing comparisons, where only intermediate results get stored
- -- that do not need to be saved for future use.
+ -- The space used by Uint data is not automatically reclaimed. However, a
+ -- mark-release regime is implemented which allows storage to be released
+ -- back to a previously noted mark. This is used for example when doing
+ -- comparisons, where only intermediate results get stored that do not
+ -- need to be saved for future use.
type Save_Mark is private;
@@ -370,18 +370,16 @@ package Uintp is
-- Release storage allocated since mark was noted
procedure Release_And_Save (M : Save_Mark; UI : in out Uint);
- -- Like Release, except that the given Uint value (which is typically
- -- among the data being released) is recopied after the release, so
- -- that it is the most recent item, and UI is updated to point to
- -- its copied location.
+ -- Like Release, except that the given Uint value (which is typically among
+ -- the data being released) is recopied after the release, so that it is
+ -- the most recent item, and UI is updated to point to its copied location.
procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint);
-- Like Release, except that the given Uint values (which are typically
- -- among the data being released) are recopied after the release, so
- -- that they are the most recent items, and UI1 and UI2 are updated if
- -- necessary to point to the copied locations. This routine is careful
- -- to do things in the right order, so that the values do not clobber
- -- one another.
+ -- among the data being released) are recopied after the release, so that
+ -- they are the most recent items, and UI1 and UI2 are updated if necessary
+ -- to point to the copied locations. This routine is careful to do things
+ -- in the right order, so that the values do not clobber one another.
-----------------------------------
-- Representation of Uint Values --
@@ -499,15 +497,14 @@ private
type UI_Vector is array (Pos range <>) of Int;
-- Vector containing the integer values of a Uint value
- -- Note: An earlier version of this package used pointers of arrays
- -- of Ints (dynamically allocated) for the Uint type. The change
- -- leads to a few less natural idioms used throughout this code, but
- -- eliminates all uses of the heap except for the table package itself.
- -- For example, Uint parameters are often converted to UI_Vectors for
- -- internal manipulation. This is done by creating the local UI_Vector
- -- using the function N_Digits on the Uint to find the size needed for
- -- the vector, and then calling Init_Operand to copy the values out
- -- of the table into the vector.
+ -- Note: An earlier version of this package used pointers of arrays of Ints
+ -- (dynamically allocated) for the Uint type. The change leads to a few
+ -- less natural idioms used throughout this code, but eliminates all uses
+ -- of the heap except for the table package itself. For example, Uint
+ -- parameters are often converted to UI_Vectors for internal manipulation.
+ -- This is done by creating the local UI_Vector using the function N_Digits
+ -- on the Uint to find the size needed for the vector, and then calling
+ -- Init_Operand to copy the values out of the table into the vector.
type Uint_Entry is record
Length : Pos;