git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Robert Dewar 2012-10-01 13:12:26 +00:00 committed by Arnaud Charlet
parent e0df453331
commit f619427812
9 changed files with 470 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -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.

6
gcc/ada/checks.adb
View File

@ -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;

362
gcc/ada/exp_ch4.adb
View File

@ -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;

2
gcc/ada/rtsfind.ads
View File

@ -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,

27
gcc/ada/s-bignum.adb
View File

@ -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 --
---------------

4
gcc/ada/s-bignum.ads
View File

@ -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.

18
gcc/ada/sinfo.adb
View File

@ -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

15
gcc/ada/sinfo.ads
View File

@ -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);

63
gcc/ada/uintp.ads
View File

@ -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;