Skip to content

R
riscv-gcc-1
Commit 0b5b2bbc by Arnaud Charlet
Options

[multiple changes] 

2011-09-15  Robert Dewar  <dewar@adacore.com>

	* a-cdlili.adb, a-coinve.adb, a-stzunb-shared.ads, a-suezst.adb,
	a-suenco.adb, a-stwiun-shared.ads, a-cobove.adb, a-convec.adb,
	a-btgbso.adb, a-cbdlli.adb, a-suewst.adb: Minor reformatting.

2011-09-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): Code cleanup:
	if the expression function is not a completion, create a
	new specification for the generated declaration, and keep the
	original specification in the generated body. Shorter code also
	ensures that proper warnings are generated for unused formals
	in all cases.

2011-09-15  Sergey Rybin  <rybin@adacore.com>

	* tree_io.ads: Update ASIS_Version_Number because of the changes
	in the tree structures for expression functions.

2011-09-15  Arnaud Charlet  <charlet@adacore.com>

	* s-osinte-aix.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads,
	s-osinte-hpux.ads, s-osinte-lynxos.ads, s-osinte-solaris-posix.ads,
	s-taprop-posix.adb (CLOCK_MONOTONIC): New constant.
	(CLOCK_REALTIME): Fix wrong value on some OSes.
	* s-taprop-posix.adb (Monotonic_Clock): Use CLOCK_MONOTONIC.

From-SVN: r178877
parent 21f1e8ce
Showing with 293 additions and 198 deletions
gcc/ada/ChangeLog
2011-09-15 Robert Dewar <dewar@adacore.com>
* a-cdlili.adb, a-coinve.adb, a-stzunb-shared.ads, a-suezst.adb,
a-suenco.adb, a-stwiun-shared.ads, a-cobove.adb, a-convec.adb,
a-btgbso.adb, a-cbdlli.adb, a-suewst.adb: Minor reformatting.
2011-09-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): Code cleanup:
if the expression function is not a completion, create a
new specification for the generated declaration, and keep the
original specification in the generated body. Shorter code also
ensures that proper warnings are generated for unused formals
in all cases.
2011-09-15 Sergey Rybin <rybin@adacore.com>
* tree_io.ads: Update ASIS_Version_Number because of the changes
in the tree structures for expression functions.
2011-09-15 Arnaud Charlet <charlet@adacore.com>
* s-osinte-aix.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads,
s-osinte-hpux.ads, s-osinte-lynxos.ads, s-osinte-solaris-posix.ads,
s-taprop-posix.adb (CLOCK_MONOTONIC): New constant.
(CLOCK_REALTIME): Fix wrong value on some OSes.
* s-taprop-posix.adb (Monotonic_Clock): Use CLOCK_MONOTONIC.
2011-09-11 Eric Botcazou <ebotcazou@adacore.com> 2011-09-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (maybe_unconstrained_array): In the reference * gcc-interface/utils.c (maybe_unconstrained_array): In the reference
......
gcc/ada/a-btgbso.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -546,11 +546,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is ...@@ -546,11 +546,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is
"attempt to tamper with cursors (container is busy)"; "attempt to tamper with cursors (container is busy)";
end if; end if;
-- Note that there's no way to decide a priori whether the -- Note that there's no way to decide a priori whether the target has
-- target has enough capacity for the union with source. -- enough capacity for the union with source. We cannot simply compare
-- We cannot simply compare the sum of the existing lengths -- the sum of the existing lengths to the capacity of the target,
-- to the capacity of the target, because equivalent items -- because equivalent items from source are not included in the union.
-- from source are not included in the union.
Iterate (Source); Iterate (Source);
end Set_Union; end Set_Union;
......
gcc/ada/a-cbdlli.adb
...@@ -582,52 +582,52 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -582,52 +582,52 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- The list container actually contains two lists: one for the "active" -- The list container actually contains two lists: one for the "active"
-- nodes that contain elements that have been inserted onto the list, -- nodes that contain elements that have been inserted onto the list,
-- and another for the "inactive" nodes for the free store. -- and another for the "inactive" nodes for the free store.
--
-- We desire that merely declaring an object should have only minimal -- We desire that merely declaring an object should have only minimal
-- cost; specially, we want to avoid having to initialize the free -- cost; specially, we want to avoid having to initialize the free
-- store (to fill in the links), especially if the capacity is large. -- store (to fill in the links), especially if the capacity is large.
--
-- The head of the free list is indicated by Container.Free. If its -- The head of the free list is indicated by Container.Free. If its
-- value is non-negative, then the free store has been initialized -- value is non-negative, then the free store has been initialized in
-- in the "normal" way: Container.Free points to the head of the list -- the "normal" way: Container.Free points to the head of the list of
-- of free (inactive) nodes, and the value 0 means the free list is -- free (inactive) nodes, and the value 0 means the free list is empty.
-- empty. Each node on the free list has been initialized to point -- Each node on the free list has been initialized to point to the next
-- to the next free node (via its Next component), and the value 0 -- free node (via its Next component), and the value 0 means that this
-- means that this is the last free node. -- is the last free node.
--
-- If Container.Free is negative, then the links on the free store -- If Container.Free is negative, then the links on the free store have
-- have not been initialized. In this case the link values are -- not been initialized. In this case the link values are implied: the
-- implied: the free store comprises the components of the node array -- free store comprises the components of the node array started with
-- started with the absolute value of Container.Free, and continuing -- the absolute value of Container.Free, and continuing until the end of
-- until the end of the array (Nodes'Last). -- the array (Nodes'Last).
--
-- If the list container is manipulated on one end only (for example -- If the list container is manipulated on one end only (for example if
-- if the container were being used as a stack), then there is no -- the container were being used as a stack), then there is no need to
-- need to initialize the free store, since the inactive nodes are -- initialize the free store, since the inactive nodes are physically
-- physically contiguous (in fact, they lie immediately beyond the -- contiguous (in fact, they lie immediately beyond the logical end
-- logical end being manipulated). The only time we need to actually -- being manipulated). The only time we need to actually initialize the
-- initialize the nodes in the free store is if the node that becomes -- nodes in the free store is if the node that becomes inactive is not
-- inactive is not at the end of the list. The free store would then -- at the end of the list. The free store would then be discontiguous
-- be discontiguous and so its nodes would need to be linked in the -- and so its nodes would need to be linked in the traditional way.
-- traditional way.
--
-- ??? -- ???
-- It might be possible to perform an optimization here. Suppose that -- It might be possible to perform an optimization here. Suppose that
-- the free store can be represented as having two parts: one -- the free store can be represented as having two parts: one comprising
-- comprising the non-contiguous inactive nodes linked together -- the non-contiguous inactive nodes linked together in the normal way,
-- in the normal way, and the other comprising the contiguous -- and the other comprising the contiguous inactive nodes (that are not
-- inactive nodes (that are not linked together, at the end of the -- linked together, at the end of the nodes array). This would allow us
-- nodes array). This would allow us to never have to initialize -- to never have to initialize the free store, except in a lazy way as
-- the free store, except in a lazy way as nodes become inactive. -- nodes become inactive.
-- When an element is deleted from the list container, its node -- When an element is deleted from the list container, its node becomes
-- becomes inactive, and so we set its Prev component to a negative -- inactive, and so we set its Prev component to a negative value, to
-- value, to indicate that it is now inactive. This provides a useful -- indicate that it is now inactive. This provides a useful way to
-- way to detect a dangling cursor reference. -- detect a dangling cursor reference.
N (X).Prev := -1; -- Node is deallocated (not on active list) N (X).Prev := -1; -- Node is deallocated (not on active list)
if Container.Free >= 0 then if Container.Free >= 0 then
-- The free store has previously been initialized. All we need to -- The free store has previously been initialized. All we need to
-- do here is link the newly-free'd node onto the free list. -- do here is link the newly-free'd node onto the free list.
...@@ -635,11 +635,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -635,11 +635,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Container.Free := X; Container.Free := X;
elsif X + 1 = abs Container.Free then elsif X + 1 = abs Container.Free then
-- The free store has not been initialized, and the node becoming -- The free store has not been initialized, and the node becoming
-- inactive immediately precedes the start of the free store. All -- inactive immediately precedes the start of the free store. All
-- we need to do is move the start of the free store back by one. -- we need to do is move the start of the free store back by one.
N (X).Next := 0; -- Not strictly necessary, but marginally safer N (X).Next := 0; -- not strictly necessary, but marginally safer
Container.Free := Container.Free + 1; Container.Free := Container.Free + 1;
else else
...@@ -650,11 +651,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -650,11 +651,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- node onto the head of the free store. -- node onto the head of the free store.
-- ??? -- ???
-- See the comments above for an optimization opportunity. If -- See the comments above for an optimization opportunity. If the
-- the next link for a node on the free store is negative, then -- next link for a node on the free store is negative, then this
-- this means the remaining nodes on the free store are -- means the remaining nodes on the free store are physically
-- physically contiguous, starting as the absolute value of -- contiguous, starting as the absolute value of that index value.
-- that index value.
Container.Free := abs Container.Free; Container.Free := abs Container.Free;
...@@ -689,7 +689,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -689,7 +689,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Node : Count_Type := Container.First; Node : Count_Type := Container.First;
begin begin
for I in 2 .. Container.Length loop for J in 2 .. Container.Length loop
if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then
return False; return False;
end if; end if;
...@@ -766,17 +766,20 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -766,17 +766,20 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
N : Node_Array renames Container.Nodes; N : Node_Array renames Container.Nodes;
procedure Partition (Pivot, Back : Count_Type); procedure Partition (Pivot, Back : Count_Type);
-- What does this do ???
procedure Sort (Front, Back : Count_Type); procedure Sort (Front, Back : Count_Type);
-- Internal procedure, what does it do??? rename it???
--------------- ---------------
-- Partition -- -- Partition --
--------------- ---------------
procedure Partition (Pivot, Back : Count_Type) is procedure Partition (Pivot, Back : Count_Type) is
Node : Count_Type := N (Pivot).Next; Node : Count_Type;
begin begin
Node := N (Pivot).Next;
while Node /= Back loop while Node /= Back loop
if N (Node).Element < N (Pivot).Element then if N (Node).Element < N (Pivot).Element then
declare declare
...@@ -2066,21 +2069,21 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -2066,21 +2069,21 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
return False; return False;
end if; end if;
if Position.Node = L.First then -- eliminates earlier disjunct -- Eliminate earlier disjunct
if Position.Node = L.First then
return True; return True;
end if; end if;
-- If we get here, we know, per disjunctive syllogism (modus -- If we get here, we know (disjunctive syllogism) that this
-- tollendo ponens), that this predicate is true: -- predicate is true: N (Position.Node).Prev /= 0
-- N (Position.Node).Prev /= 0
if Position.Node = L.Last then -- eliminates earlier disjunct if Position.Node = L.Last then -- eliminates earlier disjunct
return True; return True;
end if; end if;
-- If we get here, we know, per disjunctive syllogism (modus -- If we get here, we know (disjunctive syllogism) that this
-- tollendo ponens), that this predicate is true: -- predicate is true: N (Position.Node).Next /= 0
-- N (Position.Node).Next /= 0
if N (N (Position.Node).Next).Prev /= Position.Node then if N (N (Position.Node).Next).Prev /= Position.Node then
return False; return False;
......
gcc/ada/a-cdlili.adb
...@@ -1890,21 +1890,23 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1890,21 +1890,23 @@ package body Ada.Containers.Doubly_Linked_Lists is
return False; return False;
end if; end if;
if Position.Node = L.First then -- eliminates earlier disjunct -- Eliminate earlier disjunct
if Position.Node = L.First then
return True; return True;
end if; end if;
-- If we get here, we know, per disjunctive syllogism (modus -- If we get here, we know (disjunctive syllogism) that this
-- tollendo ponens), that this predicate is true: -- predicate is true: Position.Node.Prev /= null
-- Position.Node.Prev /= null
-- Eliminate earlier disjunct
if Position.Node = L.Last then -- eliminates earlier disjunct if Position.Node = L.Last then
return True; return True;
end if; end if;
-- If we get here, we know, per disjunctive syllogism (modus -- If we get here, we know (disjunctive syllogism) that this
-- tollendo ponens), that this predicate is true: -- predicate is true: Position.Node.Next /= null
-- Position.Node.Next /= null
if Position.Node.Next.Prev /= Position.Node then if Position.Node.Next.Prev /= Position.Node then
return False; return False;
......
gcc/ada/a-cobove.adb
...@@ -1394,8 +1394,8 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1394,8 +1394,8 @@ package body Ada.Containers.Bounded_Vectors is
-- There are two constraints we need to satisfy. The first constraint is -- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so -- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion -- we must check the sum of the current length and the insertion count.
-- count. Note that we cannot simply add these values, because of the -- Note that we cannot simply add these values, because of the
-- possibility of overflow. -- possibility of overflow.
if Old_Length > Count_Type'Last - Count then if Old_Length > Count_Type'Last - Count then
......
gcc/ada/a-coinve.adb
...@@ -651,6 +651,41 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -651,6 +651,41 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
end Clear; end Clear;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : Vector;
Position : Cursor) return Constant_Reference_Type
is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element => Position.Container.Elements.EA (Position.Index).all'Access);
end Constant_Reference;
function Constant_Reference
(Container : Vector;
Position : Index_Type) return Constant_Reference_Type
is
begin
if (Position) > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
return (Element => Container.Elements.EA (Position).all'Access);
end Constant_Reference;
-------------- --------------
-- Contains -- -- Contains --
-------------- --------------
...@@ -1365,8 +1400,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1365,8 +1400,8 @@ package body Ada.Containers.Indefinite_Vectors is
-- There are two constraints we need to satisfy. The first constraint is -- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so -- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion -- we must check the sum of the current length and the insertion count.
-- count. Note that we cannot simply add these values, because of the -- Note that we cannot simply add these values, because of the
-- possibility of overflow. -- possibility of overflow.
if Old_Length > Count_Type'Last - Count then if Old_Length > Count_Type'Last - Count then
...@@ -1385,10 +1420,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1385,10 +1420,12 @@ package body Ada.Containers.Indefinite_Vectors is
-- acceptable, then we compute the new last index from that. -- acceptable, then we compute the new last index from that.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We have to handle the case when there might be more values in the -- We have to handle the case when there might be more values in the
-- range of Index_Type than in the range of Count_Type. -- range of Index_Type than in the range of Count_Type.
if Index_Type'First <= 0 then if Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is -- We know that No_Index (the same as Index_Type'First - 1) is
-- less than 0, so it is safe to compute the following sum without -- less than 0, so it is safe to compute the following sum without
-- fear of overflow. -- fear of overflow.
...@@ -1396,6 +1433,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1396,6 +1433,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index := No_Index + Index_Type'Base (Count_Type'Last); Index := No_Index + Index_Type'Base (Count_Type'Last);
if Index <= Index_Type'Last then if Index <= Index_Type'Last then
-- We have determined that range of Index_Type has at least as -- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the -- many values as in Count_Type, so Count_Type'Last is the
-- maximum number of items that are allowed. -- maximum number of items that are allowed.
...@@ -1420,6 +1458,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1420,6 +1458,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is less -- We know that No_Index (the same as Index_Type'First - 1) is less
-- than 0, so it is safe to compute the following sum without fear of -- than 0, so it is safe to compute the following sum without fear of
-- overflow. -- overflow.
...@@ -1427,6 +1466,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1427,6 +1466,7 @@ package body Ada.Containers.Indefinite_Vectors is
J := Count_Type'Base (No_Index) + Count_Type'Last; J := Count_Type'Base (No_Index) + Count_Type'Last;
if J <= Count_Type'Base (Index_Type'Last) then if J <= Count_Type'Base (Index_Type'Last) then
-- We have determined that range of Index_Type has at least as -- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the maximum -- many values as in Count_Type, so Count_Type'Last is the maximum
-- number of items that are allowed. -- number of items that are allowed.
...@@ -1491,6 +1531,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1491,6 +1531,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- allocate the elements. -- allocate the elements.
for Idx in Container.Elements.EA'Range loop for Idx in Container.Elements.EA'Range loop
-- In order to preserve container invariants, we always attempt -- In order to preserve container invariants, we always attempt
-- the element allocation first, before setting the Last index -- the element allocation first, before setting the Last index
-- value, in case the allocation fails (either because there is no -- value, in case the allocation fails (either because there is no
...@@ -1519,6 +1560,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1519,6 +1560,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if New_Length <= Container.Elements.EA'Length then if New_Length <= Container.Elements.EA'Length then
-- In this case, we're inserting elements into a vector that has -- In this case, we're inserting elements into a vector that has
-- already allocated an internal array, and the existing array has -- already allocated an internal array, and the existing array has
-- enough unused storage for the new items. -- enough unused storage for the new items.
...@@ -1529,10 +1571,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1529,10 +1571,12 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if Before > Container.Last then if Before > Container.Last then
-- The new items are being appended to the vector, so no -- The new items are being appended to the vector, so no
-- sliding of existing elements is required. -- sliding of existing elements is required.
for Idx in Before .. New_Last loop for Idx in Before .. New_Last loop
-- In order to preserve container invariants, we always -- In order to preserve container invariants, we always
-- attempt the element allocation first, before setting the -- attempt the element allocation first, before setting the
-- Last index value, in case the allocation fails (either -- Last index value, in case the allocation fails (either
...@@ -1556,7 +1600,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1556,7 +1600,6 @@ package body Ada.Containers.Indefinite_Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Index := Before + Index_Type'Base (Count); Index := Before + Index_Type'Base (Count);
else else
Index := Index_Type'Base (Count_Type'Base (Before) + Count); Index := Index_Type'Base (Count_Type'Base (Before) + Count);
end if; end if;
...@@ -1622,6 +1665,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1622,6 +1665,7 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
if New_Capacity > Max_Length then if New_Capacity > Max_Length then
-- We have reached the limit of capacity, so no further expansion -- We have reached the limit of capacity, so no further expansion
-- will occur. (This is not a problem, as there is never a need to -- will occur. (This is not a problem, as there is never a need to
-- have more capacity than the maximum container length.) -- have more capacity than the maximum container length.)
...@@ -1659,6 +1703,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1659,6 +1703,7 @@ package body Ada.Containers.Indefinite_Vectors is
Src.EA (Index_Type'First .. Before - 1); Src.EA (Index_Type'First .. Before - 1);
if Before > Container.Last then if Before > Container.Last then
-- The new items are being appended to the vector, so no -- The new items are being appended to the vector, so no
-- sliding of existing elements is required. -- sliding of existing elements is required.
...@@ -1672,6 +1717,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1672,6 +1717,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- Now we append the new items. -- Now we append the new items.
for Idx in Before .. New_Last loop for Idx in Before .. New_Last loop
-- In order to preserve container invariants, we always -- In order to preserve container invariants, we always
-- attempt the element allocation first, before setting the -- attempt the element allocation first, before setting the
-- Last index value, in case the allocation fails (either -- Last index value, in case the allocation fails (either
...@@ -1712,6 +1758,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1712,6 +1758,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- items. -- items.
for Idx in Before .. Index - 1 loop for Idx in Before .. Index - 1 loop
-- Note that container invariants have already been satisfied -- Note that container invariants have already been satisfied
-- (in particular, the Last index value of the vector has -- (in particular, the Last index value of the vector has
-- already been updated), so if this allocation fails we simply -- already been updated), so if this allocation fails we simply
...@@ -1738,6 +1785,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1738,6 +1785,7 @@ package body Ada.Containers.Indefinite_Vectors is
Insert_Space (Container, Before, Count => N); Insert_Space (Container, Before, Count => N);
if N = 0 then if N = 0 then
-- There's nothing else to do here (vetting of parameters was -- There's nothing else to do here (vetting of parameters was
-- performed already in Insert_Space), so we simply return. -- performed already in Insert_Space), so we simply return.
...@@ -1745,6 +1793,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1745,6 +1793,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Container'Address /= New_Item'Address then if Container'Address /= New_Item'Address then
-- This is the simple case. New_Item denotes an object different -- This is the simple case. New_Item denotes an object different
-- from Container, so there's nothing special we need to do to copy -- from Container, so there's nothing special we need to do to copy
-- the source items to their destination, because all of the source -- the source items to their destination, because all of the source
...@@ -1812,6 +1861,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1812,6 +1861,7 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
if Src'Length = N then if Src'Length = N then
-- The new items were effectively appended to the container, so we -- The new items were effectively appended to the container, so we
-- have already copied all of the items that need to be copied. -- have already copied all of the items that need to be copied.
-- We return early here, even though the source slice below is -- We return early here, even though the source slice below is
...@@ -1824,12 +1874,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1824,12 +1874,11 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
-- Index value J is the first index of the second source slice. (It is -- Index value J is the first index of the second source slice. (It is
-- also 1 greater than the last index of the destination slice.) Note -- also 1 greater than the last index of the destination slice.) Note:
-- that we want to avoid computing J, if J is greater than -- avoid computing J if J is greater than Index_Type'Base'Last, in order
-- Index_Type'Base'Last, in order to avoid overflow. We prevent that by -- to avoid overflow. Prevent that by returning early above, immediately
-- returning early above, immediately after copying the first slice of -- after copying the first slice of the source, and determining that
-- the source, and determining that this second slice of the source is -- this second slice of the source is empty.
-- empty.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
J := Before + Index_Type'Base (N); J := Before + Index_Type'Base (N);
...@@ -1850,11 +1899,10 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1850,11 +1899,10 @@ package body Ada.Containers.Indefinite_Vectors is
Dst_Index : Index_Type'Base; Dst_Index : Index_Type'Base;
begin begin
-- We next copy the source items that follow the space we -- We next copy the source items that follow the space we inserted.
-- inserted. Index value Dst_Index is the first index of that portion -- Index value Dst_Index is the first index of that portion of the
-- of the destination that receives this slice of the source. (For -- destination that receives this slice of the source. (For the
-- the reasons given above, this slice is guaranteed to be -- reasons given above, this slice is guaranteed to be non-empty.)
-- non-empty.)
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Dst_Index := J - Index_Type'Base (Src'Length); Dst_Index := J - Index_Type'Base (Src'Length);
...@@ -2122,6 +2170,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2122,6 +2170,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- range of Index_Type than in the range of Count_Type. -- range of Index_Type than in the range of Count_Type.
if Index_Type'First <= 0 then if Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is -- We know that No_Index (the same as Index_Type'First - 1) is
-- less than 0, so it is safe to compute the following sum without -- less than 0, so it is safe to compute the following sum without
-- fear of overflow. -- fear of overflow.
...@@ -2129,6 +2178,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2129,6 +2178,7 @@ package body Ada.Containers.Indefinite_Vectors is
Index := No_Index + Index_Type'Base (Count_Type'Last); Index := No_Index + Index_Type'Base (Count_Type'Last);
if Index <= Index_Type'Last then if Index <= Index_Type'Last then
-- We have determined that range of Index_Type has at least as -- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the -- many values as in Count_Type, so Count_Type'Last is the
-- maximum number of items that are allowed. -- maximum number of items that are allowed.
...@@ -2153,6 +2203,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2153,6 +2203,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is less -- We know that No_Index (the same as Index_Type'First - 1) is less
-- than 0, so it is safe to compute the following sum without fear of -- than 0, so it is safe to compute the following sum without fear of
-- overflow. -- overflow.
...@@ -2160,6 +2211,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2160,6 +2211,7 @@ package body Ada.Containers.Indefinite_Vectors is
J := Count_Type'Base (No_Index) + Count_Type'Last; J := Count_Type'Base (No_Index) + Count_Type'Last;
if J <= Count_Type'Base (Index_Type'Last) then if J <= Count_Type'Base (Index_Type'Last) then
-- We have determined that range of Index_Type has at least as -- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the maximum -- many values as in Count_Type, so Count_Type'Last is the maximum
-- number of items that are allowed. -- number of items that are allowed.
...@@ -2216,9 +2268,9 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2216,9 +2268,9 @@ package body Ada.Containers.Indefinite_Vectors is
-- In an indefinite vector, elements are allocated individually, and -- In an indefinite vector, elements are allocated individually, and
-- stored as access values on the internal array (the length of which -- stored as access values on the internal array (the length of which
-- represents the vector "capacity"), which is separately -- represents the vector "capacity"), which is separately allocated.
-- allocated. We have no elements here (because we're inserting -- We have no elements here (because we're inserting "space"), so all
-- "space"), so all we need to do is allocate the backbone. -- we need to do is allocate the backbone.
Container.Elements := new Elements_Type (New_Last); Container.Elements := new Elements_Type (New_Last);
Container.Last := New_Last; Container.Last := New_Last;
...@@ -2228,9 +2280,9 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2228,9 +2280,9 @@ package body Ada.Containers.Indefinite_Vectors is
-- The tampering bits exist to prevent an item from being harmfully -- The tampering bits exist to prevent an item from being harmfully
-- manipulated while it is being visited. Query, Update, and Iterate -- manipulated while it is being visited. Query, Update, and Iterate
-- increment the busy count on entry, and decrement the count on -- increment the busy count on entry, and decrement the count on exit.
-- exit. Insert checks the count to determine whether it is being called -- Insert checks the count to determine whether it is being called while
-- while the associated callback procedure is executing. -- the associated callback procedure is executing.
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
...@@ -2247,6 +2299,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2247,6 +2299,7 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
if Before <= Container.Last then if Before <= Container.Last then
-- The new space is being inserted before some existing -- The new space is being inserted before some existing
-- elements, so we must slide the existing elements up to their -- elements, so we must slide the existing elements up to their
-- new home. We use the wider of Index_Type'Base and -- new home. We use the wider of Index_Type'Base and
...@@ -2288,6 +2341,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2288,6 +2341,7 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
if New_Capacity > Max_Length then if New_Capacity > Max_Length then
-- We have reached the limit of capacity, so no further expansion -- We have reached the limit of capacity, so no further expansion
-- will occur. (This is not a problem, as there is never a need to -- will occur. (This is not a problem, as there is never a need to
-- have more capacity than the maximum container length.) -- have more capacity than the maximum container length.)
...@@ -2325,6 +2379,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2325,6 +2379,7 @@ package body Ada.Containers.Indefinite_Vectors is
Src.EA (Index_Type'First .. Before - 1); Src.EA (Index_Type'First .. Before - 1);
if Before <= Container.Last then if Before <= Container.Last then
-- The new items are being inserted before some existing elements, -- The new items are being inserted before some existing elements,
-- so we must slide the existing elements up to their new home. -- so we must slide the existing elements up to their new home.
...@@ -2778,37 +2833,10 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2778,37 +2833,10 @@ package body Ada.Containers.Indefinite_Vectors is
-- Reference -- -- Reference --
--------------- ---------------
function Constant_Reference function Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED (Container : Vector;
return Constant_Reference_Type is Position : Cursor) return Reference_Type
begin is
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element => Position.Container.Elements.EA (Position.Index).all'Access);
end Constant_Reference;
function Constant_Reference
(Container : Vector; Position : Index_Type)
return Constant_Reference_Type is
begin
if (Position) > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
return (Element => Container.Elements.EA (Position).all'Access);
end Constant_Reference;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type is
begin begin
pragma Unreferenced (Container); pragma Unreferenced (Container);
...@@ -2825,8 +2853,10 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2825,8 +2853,10 @@ package body Ada.Containers.Indefinite_Vectors is
Position.Container.Elements.EA (Position.Index).all'Access); Position.Container.Elements.EA (Position.Index).all'Access);
end Reference; end Reference;
function Reference (Container : Vector; Position : Index_Type) function Reference
return Reference_Type is (Container : Vector;
Position : Index_Type) return Reference_Type
is
begin begin
if Position > Container.Last then if Position > Container.Last then
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
...@@ -2916,10 +2946,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2916,10 +2946,12 @@ package body Ada.Containers.Indefinite_Vectors is
-- container length. -- container length.
if Capacity = 0 then if Capacity = 0 then
-- This is a request to trim back storage, to the minimum amount -- This is a request to trim back storage, to the minimum amount
-- possible given the current state of the container. -- possible given the current state of the container.
if N = 0 then if N = 0 then
-- The container is empty, so in this unique case we can -- The container is empty, so in this unique case we can
-- deallocate the entire internal array. Note that an empty -- deallocate the entire internal array. Note that an empty
-- container can never be busy, so there's no need to check the -- container can never be busy, so there's no need to check the
...@@ -2927,6 +2959,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2927,6 +2959,7 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
-- First we remove the internal array from the container, to -- First we remove the internal array from the container, to
-- handle the case when the deallocation raises an exception -- handle the case when the deallocation raises an exception
...@@ -2942,6 +2975,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2942,6 +2975,7 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
elsif N < Container.Elements.EA'Length then elsif N < Container.Elements.EA'Length then
-- The container is not empty, and the current length is less than -- The container is not empty, and the current length is less than
-- the current capacity, so there's storage available to trim. In -- the current capacity, so there's storage available to trim. In
-- this case, we allocate a new internal array having a length -- this case, we allocate a new internal array having a length
...@@ -2994,6 +3028,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2994,6 +3028,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- any possibility of overflow. -- any possibility of overflow.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We perform a two-part test. First we determine whether the -- We perform a two-part test. First we determine whether the
-- computed Last value lies in the base range of the type, and then -- computed Last value lies in the base range of the type, and then
-- determine whether it lies in the range of the index (sub)type. -- determine whether it lies in the range of the index (sub)type.
...@@ -3022,6 +3057,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3022,6 +3057,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- Here we can compute Last directly, in the normal way. We know that -- Here we can compute Last directly, in the normal way. We know that
-- No_Index is less than 0, so there is no danger of overflow when -- No_Index is less than 0, so there is no danger of overflow when
-- adding the (positive) value of Capacity. -- adding the (positive) value of Capacity.
...@@ -3060,6 +3096,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3060,6 +3096,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- this is a request for expansion or contraction of storage. -- this is a request for expansion or contraction of storage.
if Container.Elements = null then if Container.Elements = null then
-- The container is empty (it doesn't even have an internal array), -- The container is empty (it doesn't even have an internal array),
-- so this represents a request to allocate storage having the given -- so this represents a request to allocate storage having the given
-- capacity. -- capacity.
...@@ -3069,17 +3106,19 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3069,17 +3106,19 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Capacity <= N then if Capacity <= N then
-- This is a request to trim back storage, but only to the limit of -- This is a request to trim back storage, but only to the limit of
-- what's already in the container. (Reserve_Capacity never deletes -- what's already in the container. (Reserve_Capacity never deletes
-- active elements, it only reclaims excess storage.) -- active elements, it only reclaims excess storage.)
if N < Container.Elements.EA'Length then if N < Container.Elements.EA'Length then
-- The container is not empty (because the requested capacity is -- The container is not empty (because the requested capacity is
-- positive, and less than or equal to the container length), and -- positive, and less than or equal to the container length), and
-- the current length is less than the current capacity, so -- the current length is less than the current capacity, so there
-- there's storage available to trim. In this case, we allocate a -- is storage available to trim. In this case, we allocate a new
-- new internal array having a length that exactly matches the -- internal array having a length that exactly matches the number
-- number of items in the container. -- of items in the container.
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
...@@ -3122,6 +3161,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3122,6 +3161,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- current capacity is. -- current capacity is.
if Capacity = Container.Elements.EA'Length then if Capacity = Container.Elements.EA'Length then
-- The requested capacity matches the existing capacity, so there's -- The requested capacity matches the existing capacity, so there's
-- nothing to do here. We treat this case as a no-op, and simply -- nothing to do here. We treat this case as a no-op, and simply
-- return without checking the busy bit. -- return without checking the busy bit.
...@@ -3441,6 +3481,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3441,6 +3481,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- create a Last index value greater than Index_Type'Last. -- create a Last index value greater than Index_Type'Last.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We perform a two-part test. First we determine whether the -- We perform a two-part test. First we determine whether the
-- computed Last value lies in the base range of the type, and then -- computed Last value lies in the base range of the type, and then
-- determine whether it lies in the range of the index (sub)type. -- determine whether it lies in the range of the index (sub)type.
...@@ -3469,6 +3510,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3469,6 +3510,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- Here we can compute Last directly, in the normal way. We know that -- Here we can compute Last directly, in the normal way. We know that
-- No_Index is less than 0, so there is no danger of overflow when -- No_Index is less than 0, so there is no danger of overflow when
-- adding the (positive) value of Length. -- adding the (positive) value of Length.
...@@ -3529,6 +3571,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3529,6 +3571,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- create a Last index value greater than Index_Type'Last. -- create a Last index value greater than Index_Type'Last.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We perform a two-part test. First we determine whether the -- We perform a two-part test. First we determine whether the
-- computed Last value lies in the base range of the type, and then -- computed Last value lies in the base range of the type, and then
-- determine whether it lies in the range of the index (sub)type. -- determine whether it lies in the range of the index (sub)type.
...@@ -3557,6 +3600,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3557,6 +3600,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- Here we can compute Last directly, in the normal way. We know that -- Here we can compute Last directly, in the normal way. We know that
-- No_Index is less than 0, so there is no danger of overflow when -- No_Index is less than 0, so there is no danger of overflow when
-- adding the (positive) value of Length. -- adding the (positive) value of Length.
...@@ -3603,6 +3647,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -3603,6 +3647,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- initialized when the handler executes. So here we initialize our loop -- initialized when the handler executes. So here we initialize our loop
-- variable earlier than we prefer, before entering the block, so there -- variable earlier than we prefer, before entering the block, so there
-- is no ambiguity. -- is no ambiguity.
Last := Index_Type'First; Last := Index_Type'First;
begin begin
......
gcc/ada/a-convec.adb
...@@ -1022,9 +1022,9 @@ package body Ada.Containers.Vectors is ...@@ -1022,9 +1022,9 @@ package body Ada.Containers.Vectors is
-- There are two constraints we need to satisfy. The first constraint is -- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so -- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion -- we must check the sum of the current length and the insertion count.
-- count. Note that we cannot simply add these values, because of the -- Note: we cannot simply add these values, because of the possibility
-- possibility of overflow. -- of overflow.
if Old_Length > Count_Type'Last - Count then if Old_Length > Count_Type'Last - Count then
raise Constraint_Error with "Count is out of range"; raise Constraint_Error with "Count is out of range";
...@@ -1130,7 +1130,6 @@ package body Ada.Containers.Vectors is ...@@ -1130,7 +1130,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
New_Last := No_Index + Index_Type'Base (New_Length); New_Last := No_Index + Index_Type'Base (New_Length);
else else
New_Last := Index_Type'Base (Count_Type'Base (No_Index) + New_Length); New_Last := Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
end if; end if;
...@@ -1690,9 +1689,9 @@ package body Ada.Containers.Vectors is ...@@ -1690,9 +1689,9 @@ package body Ada.Containers.Vectors is
-- There are two constraints we need to satisfy. The first constraint is -- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so -- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion -- we must check the sum of the current length and the insertion count.
-- count. Note that we cannot simply add these values, because of the -- Note: we cannot simply add these values, because of the possibility
-- possibility of overflow. -- of overflow.
if Old_Length > Count_Type'Last - Count then if Old_Length > Count_Type'Last - Count then
raise Constraint_Error with "Count is out of range"; raise Constraint_Error with "Count is out of range";
......
gcc/ada/a-stwiun-shared.ads
...@@ -410,10 +410,10 @@ private ...@@ -410,10 +410,10 @@ private
type Shared_Wide_String (Max_Length : Natural) is limited record type Shared_Wide_String (Max_Length : Natural) is limited record
Counter : System.Atomic_Counters.Atomic_Counter; Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter. -- Reference counter
Last : Natural := 0; Last : Natural := 0;
Data : Wide_String (1 .. Max_Length); Data : Wide_String (1 .. Max_Length);
-- Last is the index of last significant element of the Data. All -- Last is the index of last significant element of the Data. All
-- elements with larger indices are just an extra room. -- elements with larger indices are just an extra room.
end record; end record;
...@@ -424,8 +424,7 @@ private ...@@ -424,8 +424,7 @@ private
-- Increment reference counter. -- Increment reference counter.
procedure Unreference (Item : not null Shared_Wide_String_Access); procedure Unreference (Item : not null Shared_Wide_String_Access);
-- Decrement reference counter. Deallocate Item when reference counter is -- Decrement reference counter. Deallocate Item when ref counter is zero
-- zero.
function Can_Be_Reused function Can_Be_Reused
(Item : Shared_Wide_String_Access; (Item : Shared_Wide_String_Access;
...@@ -445,7 +444,7 @@ private ...@@ -445,7 +444,7 @@ private
function To_Unbounded (S : Wide_String) return Unbounded_Wide_String function To_Unbounded (S : Wide_String) return Unbounded_Wide_String
renames To_Unbounded_Wide_String; renames To_Unbounded_Wide_String;
-- This renames are here only to be used in the pragma Stream_Convert. -- This renames are here only to be used in the pragma Stream_Convert
type Unbounded_Wide_String is new AF.Controlled with record type Unbounded_Wide_String is new AF.Controlled with record
Reference : Shared_Wide_String_Access := Empty_Shared_Wide_String'Access; Reference : Shared_Wide_String_Access := Empty_Shared_Wide_String'Access;
...@@ -453,22 +452,25 @@ private ...@@ -453,22 +452,25 @@ private
-- The Unbounded_Wide_String uses several techniques to increase speed of -- The Unbounded_Wide_String uses several techniques to increase speed of
-- the application: -- the application:
-- - implicit sharing or copy-on-write. Unbounded_Wide_String contains -- - implicit sharing or copy-on-write. Unbounded_Wide_String contains
-- only the reference to the data which is shared between several -- only the reference to the data which is shared between several
-- instances. The shared data is reallocated only when its value is -- instances. The shared data is reallocated only when its value is
-- changed and the object mutation can't be used or it is inefficient to -- changed and the object mutation can't be used or it is inefficient to
-- use it; -- use it;
-- - object mutation. Shared data object can be reused without memory -- - object mutation. Shared data object can be reused without memory
-- reallocation when all of the following requirements are meat: -- reallocation when all of the following requirements are meat:
-- - shared data object don't used anywhere longer; -- - shared data object don't used anywhere longer;
-- - its size is sufficient to store new value; -- - its size is sufficient to store new value;
-- - the gap after reuse is less then some threshold. -- - the gap after reuse is less then some threshold.
-- - memory preallocation. Most of used memory allocation algorithms -- - memory preallocation. Most of used memory allocation algorithms
-- aligns allocated segment on the some boundary, thus some amount of -- aligns allocated segment on the some boundary, thus some amount of
-- additional memory can be preallocated without any impact. Such -- additional memory can be preallocated without any impact. Such
-- preallocated memory can used later by Append/Insert operations -- preallocated memory can used later by Append/Insert operations
-- without reallocation. -- without reallocation.
--
-- Reference counting uses GCC builtin atomic operations, which allows to -- Reference counting uses GCC builtin atomic operations, which allows to
-- safely share internal data between Ada tasks. Nevertheless, this not -- safely share internal data between Ada tasks. Nevertheless, this not
-- make objects of Unbounded_Wide_String thread-safe, so each instance -- make objects of Unbounded_Wide_String thread-safe, so each instance
...@@ -485,7 +487,8 @@ private ...@@ -485,7 +487,8 @@ private
overriding procedure Finalize (Object : in out Unbounded_Wide_String); overriding procedure Finalize (Object : in out Unbounded_Wide_String);
Null_Unbounded_Wide_String : constant Unbounded_Wide_String := Null_Unbounded_Wide_String : constant Unbounded_Wide_String :=
(AF.Controlled with (AF.Controlled with
Reference => Empty_Shared_Wide_String'Access); Reference =>
Empty_Shared_Wide_String'Access);
end Ada.Strings.Wide_Unbounded; end Ada.Strings.Wide_Unbounded;
gcc/ada/a-stzunb-shared.ads
...@@ -419,10 +419,10 @@ private ...@@ -419,10 +419,10 @@ private
type Shared_Wide_Wide_String (Max_Length : Natural) is limited record type Shared_Wide_Wide_String (Max_Length : Natural) is limited record
Counter : System.Atomic_Counters.Atomic_Counter; Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter. -- Reference counter
Last : Natural := 0; Last : Natural := 0;
Data : Wide_Wide_String (1 .. Max_Length); Data : Wide_Wide_String (1 .. Max_Length);
-- Last is the index of last significant element of the Data. All -- Last is the index of last significant element of the Data. All
-- elements with larger indices are just an extra room. -- elements with larger indices are just an extra room.
end record; end record;
...@@ -466,22 +466,25 @@ private ...@@ -466,22 +466,25 @@ private
-- The Unbounded_Wide_Wide_String uses several techniques to increase speed -- The Unbounded_Wide_Wide_String uses several techniques to increase speed
-- of the application: -- of the application:
-- - implicit sharing or copy-on-write. Unbounded_Wide_Wide_String -- - implicit sharing or copy-on-write. Unbounded_Wide_Wide_String
-- contains only the reference to the data which is shared between -- contains only the reference to the data which is shared between
-- several instances. The shared data is reallocated only when its value -- several instances. The shared data is reallocated only when its value
-- is changed and the object mutation can't be used or it is inefficient -- is changed and the object mutation can't be used or it is inefficient
-- to use it; -- to use it;
-- - object mutation. Shared data object can be reused without memory -- - object mutation. Shared data object can be reused without memory
-- reallocation when all of the following requirements are meat: -- reallocation when all of the following requirements are meat:
-- - shared data object don't used anywhere longer; -- - shared data object don't used anywhere longer;
-- - its size is sufficient to store new value; -- - its size is sufficient to store new value;
-- - the gap after reuse is less then some threshold. -- - the gap after reuse is less then some threshold.
-- - memory preallocation. Most of used memory allocation algorithms -- - memory preallocation. Most of used memory allocation algorithms
-- aligns allocated segment on the some boundary, thus some amount of -- aligns allocated segment on the some boundary, thus some amount of
-- additional memory can be preallocated without any impact. Such -- additional memory can be preallocated without any impact. Such
-- preallocated memory can used later by Append/Insert operations -- preallocated memory can used later by Append/Insert operations
-- without reallocation. -- without reallocation.
--
-- Reference counting uses GCC builtin atomic operations, which allows to -- Reference counting uses GCC builtin atomic operations, which allows to
-- safely share internal data between Ada tasks. Nevertheless, this not -- safely share internal data between Ada tasks. Nevertheless, this not
-- make objects of Unbounded_Wide_Wide_String thread-safe, so each instance -- make objects of Unbounded_Wide_Wide_String thread-safe, so each instance
...@@ -502,8 +505,9 @@ private ...@@ -502,8 +505,9 @@ private
(Object : in out Unbounded_Wide_Wide_String); (Object : in out Unbounded_Wide_Wide_String);
Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String := Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String :=
(AF.Controlled with (AF.Controlled with
Reference => Reference =>
Empty_Shared_Wide_Wide_String'Access); Empty_Shared_Wide_Wide_String'
Access);
end Ada.Strings.Wide_Wide_Unbounded; end Ada.Strings.Wide_Wide_Unbounded;
gcc/ada/a-suenco.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2010, Free Software Foundation, Inc. -- -- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -92,10 +92,10 @@ package body Ada.Strings.UTF_Encoding.Conversions is ...@@ -92,10 +92,10 @@ package body Ada.Strings.UTF_Encoding.Conversions is
-- Output UTF-16 code -- Output UTF-16 code
procedure Get_Continuation; procedure Get_Continuation;
-- Reads a continuation byte of the form 10xxxxxx, shifts R left -- Reads a continuation byte of the form 10xxxxxx, shifts R left by 6
-- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On -- bits, and or's in the xxxxxx to the low order 6 bits. On return Ptr
-- return Ptr is incremented. Raises exception if continuation -- is incremented. Raises exception if continuation byte does not exist
-- byte does not exist or is invalid. -- or is invalid.
---------------------- ----------------------
-- Get_Continuation -- -- Get_Continuation --
...@@ -114,8 +114,8 @@ package body Ada.Strings.UTF_Encoding.Conversions is ...@@ -114,8 +114,8 @@ package body Ada.Strings.UTF_Encoding.Conversions is
Raise_Encoding_Error (Iptr - 1); Raise_Encoding_Error (Iptr - 1);
else else
R := Shift_Left (R, 6) or R :=
Unsigned_16 (C and 2#00_111111#); Shift_Left (R, 6) or Unsigned_16 (C and 2#00_111111#);
end if; end if;
end if; end if;
end Get_Continuation; end Get_Continuation;
......
gcc/ada/a-suewst.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2010, Free Software Foundation, Inc. -- -- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -66,10 +66,10 @@ package body Ada.Strings.UTF_Encoding.Wide_Strings is ...@@ -66,10 +66,10 @@ package body Ada.Strings.UTF_Encoding.Wide_Strings is
R : Unsigned_16; R : Unsigned_16;
procedure Get_Continuation; procedure Get_Continuation;
-- Reads a continuation byte of the form 10xxxxxx, shifts R left -- Reads a continuation byte of the form 10xxxxxx, shifts R left by 6
-- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On -- bits, and or's in the xxxxxx to the low order 6 bits. On return Ptr
-- return Ptr is incremented. Raises exception if continuation -- is incremented. Raises exception if continuation byte does not exist
-- byte does not exist or is invalid. -- or is invalid.
---------------------- ----------------------
-- Get_Continuation -- -- Get_Continuation --
......
gcc/ada/a-suezst.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2010, Free Software Foundation, Inc. -- -- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -66,10 +66,10 @@ package body Ada.Strings.UTF_Encoding.Wide_Wide_Strings is ...@@ -66,10 +66,10 @@ package body Ada.Strings.UTF_Encoding.Wide_Wide_Strings is
R : Unsigned_32; R : Unsigned_32;
procedure Get_Continuation; procedure Get_Continuation;
-- Reads a continuation byte of the form 10xxxxxx, shifts R left -- Reads a continuation byte of the form 10xxxxxx, shifts R left by 6
-- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On -- bits, and or's in the xxxxxx to the low order 6 bits. On return Ptr
-- return Ptr is incremented. Raises exception if continuation -- is incremented. Raises exception if continuation byte does not exist
-- byte does not exist or is invalid. -- or is invalid.
---------------------- ----------------------
-- Get_Continuation -- -- Get_Continuation --
......
gcc/ada/s-osinte-aix.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -199,7 +199,8 @@ package System.OS_Interface is ...@@ -199,7 +199,8 @@ package System.OS_Interface is
type clockid_t is private; type clockid_t is private;
CLOCK_REALTIME : constant clockid_t; CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime function clock_gettime
(clock_id : clockid_t; (clock_id : clockid_t;
...@@ -539,7 +540,8 @@ private ...@@ -539,7 +540,8 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type clockid_t is new int; type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0; CLOCK_REALTIME : constant clockid_t := 9;
CLOCK_MONOTONIC : constant clockid_t := 10;
type pthread_attr_t is new System.Address; type pthread_attr_t is new System.Address;
pragma Convention (C, pthread_attr_t); pragma Convention (C, pthread_attr_t);
......
gcc/ada/s-osinte-darwin.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -185,7 +185,8 @@ package System.OS_Interface is ...@@ -185,7 +185,8 @@ package System.OS_Interface is
type clockid_t is private; type clockid_t is private;
CLOCK_REALTIME : constant clockid_t; CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime function clock_gettime
(clock_id : clockid_t; (clock_id : clockid_t;
...@@ -516,7 +517,8 @@ private ...@@ -516,7 +517,8 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type clockid_t is new int; type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0; CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-- --
-- Darwin specific signal implementation -- Darwin specific signal implementation
......
gcc/ada/s-osinte-freebsd.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -202,7 +202,8 @@ package System.OS_Interface is ...@@ -202,7 +202,8 @@ package System.OS_Interface is
type clockid_t is private; type clockid_t is private;
CLOCK_REALTIME : constant clockid_t; CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime function clock_gettime
(clock_id : clockid_t; (clock_id : clockid_t;
...@@ -635,7 +636,8 @@ private ...@@ -635,7 +636,8 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type clockid_t is new int; type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0; CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_MONOTONIC : constant clockid_t := 4;
type pthread_t is new System.Address; type pthread_t is new System.Address;
type pthread_attr_t is new System.Address; type pthread_attr_t is new System.Address;
......
gcc/ada/s-osinte-hpux.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -182,7 +182,8 @@ package System.OS_Interface is ...@@ -182,7 +182,8 @@ package System.OS_Interface is
type clockid_t is private; type clockid_t is private;
CLOCK_REALTIME : constant clockid_t; CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime function clock_gettime
(clock_id : clockid_t; (clock_id : clockid_t;
...@@ -521,7 +522,8 @@ private ...@@ -521,7 +522,8 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type clockid_t is new int; type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 1; CLOCK_REALTIME : constant clockid_t := 1;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
type pthread_attr_t is new int; type pthread_attr_t is new int;
type pthread_condattr_t is new int; type pthread_condattr_t is new int;
......
gcc/ada/s-osinte-lynxos.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -199,7 +199,8 @@ package System.OS_Interface is ...@@ -199,7 +199,8 @@ package System.OS_Interface is
type clockid_t is private; type clockid_t is private;
CLOCK_REALTIME : constant clockid_t; CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime function clock_gettime
(clock_id : clockid_t; (clock_id : clockid_t;
...@@ -517,7 +518,8 @@ private ...@@ -517,7 +518,8 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type clockid_t is new unsigned_char; type clockid_t is new unsigned_char;
CLOCK_REALTIME : constant clockid_t := 0; CLOCK_REALTIME : constant clockid_t := 1;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
type st_attr_t is record type st_attr_t is record
stksize : int; stksize : int;
......
gcc/ada/s-osinte-solaris-posix.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -189,7 +189,8 @@ package System.OS_Interface is ...@@ -189,7 +189,8 @@ package System.OS_Interface is
type clockid_t is private; type clockid_t is private;
CLOCK_REALTIME : constant clockid_t; CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime function clock_gettime
(clock_id : clockid_t; (clock_id : clockid_t;
...@@ -512,7 +513,8 @@ private ...@@ -512,7 +513,8 @@ private
pragma Convention (C, timespec); pragma Convention (C, timespec);
type clockid_t is new int; type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0; CLOCK_REALTIME : constant clockid_t := 3;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
type pthread_attr_t is record type pthread_attr_t is record
pthread_attrp : System.Address; pthread_attrp : System.Address;
......
gcc/ada/s-taprop-posix.adb
...@@ -666,7 +666,7 @@ package body System.Task_Primitives.Operations is ...@@ -666,7 +666,7 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
Result := clock_gettime Result := clock_gettime
(clock_id => CLOCK_REALTIME, tp => TS'Unchecked_Access); (clock_id => CLOCK_MONOTONIC, tp => TS'Unchecked_Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
return To_Duration (TS); return To_Duration (TS);
end Monotonic_Clock; end Monotonic_Clock;
......
gcc/ada/sem_ch6.adb
...@@ -268,6 +268,7 @@ package body Sem_Ch6 is ...@@ -268,6 +268,7 @@ package body Sem_Ch6 is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
LocX : constant Source_Ptr := Sloc (Expression (N)); LocX : constant Source_Ptr := Sloc (Expression (N));
Def_Id : constant Entity_Id := Defining_Entity (Specification (N)); Def_Id : constant Entity_Id := Defining_Entity (Specification (N));
Expr : constant Node_Id := Expression (N);
New_Body : Node_Id; New_Body : Node_Id;
New_Decl : Node_Id; New_Decl : Node_Id;
...@@ -315,31 +316,28 @@ package body Sem_Ch6 is ...@@ -315,31 +316,28 @@ package body Sem_Ch6 is
Set_Is_Inlined (Prev); Set_Is_Inlined (Prev);
Analyze (N); Analyze (N);
-- If this is not a completion, create both a declaration and a body, -- If this is not a completion, create both a declaration and a body, so
-- so that the expression can be inlined whenever possible. -- that the expression can be inlined whenever possible. The spec of the
-- new subprogram declaration is a copy of the original specification,
-- which is now part of the subprogram body.
else else
New_Decl := New_Decl :=
Make_Subprogram_Declaration (Loc, Make_Subprogram_Declaration (Loc,
Specification => Specification (N)); Specification => Copy_Separate_Tree (Specification (N)));
Rewrite (N, New_Decl); Rewrite (N, New_Decl);
Analyze (N); Analyze (N);
Set_Is_Inlined (Defining_Entity (New_Decl)); Set_Is_Inlined (Defining_Entity (New_Decl));
-- Create new set of formals for specification in body.
Set_Specification (New_Body,
Make_Function_Specification (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Loc, Chars (Defining_Entity (N))),
Parameter_Specifications =>
Copy_Parameter_List (Defining_Entity (New_Decl)),
Result_Definition =>
New_Copy_Tree (Result_Definition (Specification (New_Decl)))));
Insert_After (N, New_Body); Insert_After (N, New_Body);
Analyze (New_Body); Analyze (New_Body);
end if; end if;
-- If the return expression is a static constant, we suppress warning
-- messages on unused formals, which in most cases will be noise.
Set_Is_Trivial_Subprogram (Defining_Entity (New_Body),
Is_OK_Static_Expression (Expr));
end Analyze_Expression_Function; end Analyze_Expression_Function;
---------------------------------------- ----------------------------------------
......
gcc/ada/tree_io.ads
...@@ -47,12 +47,14 @@ package Tree_IO is ...@@ -47,12 +47,14 @@ package Tree_IO is
Tree_Format_Error : exception; Tree_Format_Error : exception;
-- Raised if a format error is detected in the input file -- Raised if a format error is detected in the input file
ASIS_Version_Number : constant := 26; ASIS_Version_Number : constant := 27;
-- ASIS Version. This is used to check for consistency between the compiler -- ASIS Version. This is used to check for consistency between the compiler
-- used to generate trees and an ASIS application that is reading the -- used to generate trees and an ASIS application that is reading the
-- trees. It must be incremented whenever a change is made to the tree -- trees. It must be incremented whenever a change is made to the tree
-- format that would result in the compiler being incompatible with an -- format that would result in the compiler being incompatible with an
-- older version of ASIS. -- older version of ASIS.
--
-- 27 2011-09-06 Changes in the tree structures for expression functions
procedure Tree_Read_Initialize (Desc : File_Descriptor); procedure Tree_Read_Initialize (Desc : File_Descriptor);
-- Called to initialize reading of a tree file. This call must be made -- Called to initialize reading of a tree file. This call must be made
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment