diff options
author | Robert Dewar <dewar@adacore.com> | 2012-10-01 13:12:26 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-10-01 15:12:26 +0200 |
commit | f619427812a37d1249b1a85434dde71b8efdc40a (patch) | |
tree | 93e1d49dd1f5bb39c1680522d66c5b96eea18009 /gcc/ada | |
parent | e0df453331f97b78cbd77a377a3d2531137eb7b2 (diff) | |
download | gcc-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/ChangeLog | 15 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 362 | ||||
-rw-r--r-- | gcc/ada/rtsfind.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-bignum.adb | 27 | ||||
-rw-r--r-- | gcc/ada/s-bignum.ads | 4 | ||||
-rw-r--r-- | gcc/ada/sinfo.adb | 18 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 15 | ||||
-rw-r--r-- | gcc/ada/uintp.ads | 63 |
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; |