OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2015-05-22  Bob Duff  <duff@adacore.com>

	* a-convec.ads, a-convec.adb (Append): Check for fast path. Split
	out slow path into separate procedure. Inline Append. Fast path
	now avoids calling Insert.
	(Finalize): Do the busy checking last, so the container gets emptied.
	(Insert, Insert_Space): Remove redundancy.

2015-05-22  Robert Dewar  <dewar@adacore.com>

	* switch-c.adb (Scan_Front_End_Switches): Insist on -gnatc
	for -gnatd.V.

From-SVN: r223567
This commit is contained in:
Arnaud Charlet 2015-05-22 15:09:47 +02:00
parent 84238eb02a
commit d992a425b7
4 changed files with 118 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
2015-05-22 Bob Duff <duff@adacore.com>
* a-convec.ads, a-convec.adb (Append): Check for fast path. Split
out slow path into separate procedure. Inline Append. Fast path
now avoids calling Insert.
(Finalize): Do the busy checking last, so the container gets emptied.
(Insert, Insert_Space): Remove redundancy.
2015-05-22 Robert Dewar <dewar@adacore.com>
* switch-c.adb (Scan_Front_End_Switches): Insist on -gnatc
for -gnatd.V.
2015-05-22 Arnaud Charlet <charlet@adacore.com> 2015-05-22 Arnaud Charlet <charlet@adacore.com>
* gnatvsn.ads: Minor code reorg to remember more easily to update * gnatvsn.ads: Minor code reorg to remember more easily to update

130
gcc/ada/a-convec.adb
View File

@ -59,6 +59,13 @@ package body Ada.Containers.Vectors is
(Object : Iterator; (Object : Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
procedure Append_Slow_Path
(Container : in out Vector;
New_Item : Element_Type;
Count : Count_Type);
-- This is the slow path for Append. This is split out to minimize the size
-- of Append, because we have Inline (Append).
--------- ---------
-- "&" -- -- "&" --
--------- ---------
@ -91,7 +98,7 @@ package body Ada.Containers.Vectors is
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(Right.Last, RE); new Elements_Type'(Right.Last, RE);
begin begin
return (Controlled with Elements, Right.Last, 0, 0); return (Controlled with Elements, Right.Last, others => <>);
end; end;
end if; end if;
@ -102,7 +109,7 @@ package body Ada.Containers.Vectors is
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(Left.Last, LE); new Elements_Type'(Left.Last, LE);
begin begin
return (Controlled with Elements, Left.Last, 0, 0); return (Controlled with Elements, Left.Last, others => <>);
end; end;
end if; end if;
@ -129,7 +136,7 @@ package body Ada.Containers.Vectors is
-- exceed Index_Type'Last. We use the wider of Index_Type'Base and -- exceed Index_Type'Last. We use the wider of Index_Type'Base and
-- Count_Type'Base as the type for intermediate values. -- Count_Type'Base as the type for intermediate values.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= 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
@ -202,7 +209,7 @@ package body Ada.Containers.Vectors is
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(Last, LE & RE); new Elements_Type'(Last, LE & RE);
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, others => <>);
end; end;
end "&"; end "&";
@ -223,7 +230,7 @@ package body Ada.Containers.Vectors is
EA => (others => Right)); EA => (others => Right));
begin begin
return (Controlled with Elements, Index_Type'First, 0, 0); return (Controlled with Elements, Index_Type'First, others => <>);
end; end;
end if; end if;
@ -248,7 +255,7 @@ package body Ada.Containers.Vectors is
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type'(Last => Last, EA => LE & Right); new Elements_Type'(Last => Last, EA => LE & Right);
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, others => <>);
end; end;
end "&"; end "&";
@ -268,7 +275,7 @@ package body Ada.Containers.Vectors is
(Last => Index_Type'First, (Last => Index_Type'First,
EA => (others => Left)); EA => (others => Left));
begin begin
return (Controlled with Elements, Index_Type'First, 0, 0); return (Controlled with Elements, Index_Type'First, others => <>);
end; end;
end if; end if;
@ -298,7 +305,7 @@ package body Ada.Containers.Vectors is
EA => Left & RE); EA => Left & RE);
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, others => <>);
end; end;
end "&"; end "&";
@ -328,7 +335,7 @@ package body Ada.Containers.Vectors is
EA => (Left, Right)); EA => (Left, Right));
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, others => <>);
end; end;
end "&"; end "&";
@ -456,6 +463,45 @@ package body Ada.Containers.Vectors is
New_Item : Element_Type; New_Item : Element_Type;
Count : Count_Type := 1) Count : Count_Type := 1)
is is
begin
-- In the general case, we pass the buck to Insert, but for efficiency,
-- we check for the usual case where Count = 1 and the vector has enough
-- room for at least one more element.
if Count = 1
and then Container.Elements /= null
and then Container.Last /= Container.Elements.Last
then
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is busy)";
end if;
-- Increment Container.Last after assigning the New_Item, so we
-- leave the Container unmodified in case Finalize/Adjust raises
-- an exception.
declare
New_Last : constant Index_Type := Container.Last + 1;
begin
Container.Elements.EA (New_Last) := New_Item;
Container.Last := New_Last;
end;
else
Append_Slow_Path (Container, New_Item, Count);
end if;
end Append;
----------------------
-- Append_Slow_Path --
----------------------
procedure Append_Slow_Path
(Container : in out Vector;
New_Item : Element_Type;
Count : Count_Type)
is
begin begin
if Count = 0 then if Count = 0 then
return; return;
@ -464,7 +510,7 @@ package body Ada.Containers.Vectors is
else else
Insert (Container, Container.Last + 1, New_Item, Count); Insert (Container, Container.Last + 1, New_Item, Count);
end if; end if;
end Append; end Append_Slow_Path;
------------ ------------
-- Assign -- -- Assign --
@ -705,7 +751,7 @@ package body Ada.Containers.Vectors is
-- index value New_Last is the last index value of their new home, and -- index value New_Last is the last index value of their new home, and
-- index value J is the first index of their old home. -- index value J is the first index of their old home.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
New_Last := Old_Last - Index_Type'Base (Count); New_Last := Old_Last - Index_Type'Base (Count);
J := Index + Index_Type'Base (Count); J := Index + Index_Type'Base (Count);
else else
@ -814,7 +860,7 @@ package body Ada.Containers.Vectors is
if Count >= Container.Length then if Count >= Container.Length then
Container.Last := No_Index; Container.Last := No_Index;
elsif Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then elsif Index_Type'Base'Last >= Count_Type_Last then
Container.Last := Container.Last - Index_Type'Base (Count); Container.Last := Container.Last - Index_Type'Base (Count);
else else
@ -858,14 +904,14 @@ package body Ada.Containers.Vectors is
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
Container.Elements := null;
Container.Last := No_Index;
Free (X);
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error with raise Program_Error with
"attempt to tamper with cursors (vector is busy)"; "attempt to tamper with cursors (vector is busy)";
else
Container.Elements := null;
Container.Last := No_Index;
Free (X);
end if; end if;
end Finalize; end Finalize;
@ -1334,7 +1380,7 @@ package body Ada.Containers.Vectors is
-- deeper flaw in the caller's algorithm, so that case is treated as a -- deeper flaw in the caller's algorithm, so that case is treated as a
-- proper error.) -- proper error.)
if Before > Container.Last and then Before > Container.Last + 1 then if Before > Container.Last + 1 then
raise Constraint_Error with raise Constraint_Error with
"Before index is out of range (too large)"; "Before index is out of range (too large)";
end if; end if;
@ -1367,7 +1413,7 @@ package body Ada.Containers.Vectors is
-- compare the new length to the maximum length. If the new length is -- compare the new length to the maximum length. If the new length 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_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.
@ -1402,9 +1448,8 @@ package body Ada.Containers.Vectors is
-- worry about if No_Index were less than 0, but that case is -- worry about if No_Index were less than 0, but that case is
-- handled above). -- handled above).
if Index_Type'Last - No_Index >= if Index_Type'Last - No_Index >= Count_Type_Last then
Count_Type'Pos (Count_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.
@ -1469,7 +1514,7 @@ package body Ada.Containers.Vectors is
-- insertion. Use the wider of Index_Type'Base and Count_Type'Base to -- insertion. Use the wider of Index_Type'Base and Count_Type'Base to
-- compute its value from the New_Length. -- compute its value from the New_Length.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= 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);
@ -1537,7 +1582,7 @@ package body Ada.Containers.Vectors is
-- new home. We use the wider of Index_Type'Base and -- new home. We use the wider of Index_Type'Base and
-- Count_Type'Base as the type for intermediate index values. -- Count_Type'Base as the type for intermediate index values.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= 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);
@ -1583,7 +1628,7 @@ package body Ada.Containers.Vectors is
-- We have computed the length of the new internal array (and this is -- We have computed the length of the new internal array (and this is
-- what "vector capacity" means), so use that to compute its last index. -- what "vector capacity" means), so use that to compute its last index.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
Dst_Last := No_Index + Index_Type'Base (New_Capacity); Dst_Last := No_Index + Index_Type'Base (New_Capacity);
else else
Dst_Last := Dst_Last :=
@ -1616,7 +1661,7 @@ package body Ada.Containers.Vectors is
-- 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.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= 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);
@ -1679,7 +1724,7 @@ package body Ada.Containers.Vectors is
-- We calculate the last index value of the destination slice using the -- We calculate the last index value of the destination slice using the
-- wider of Index_Type'Base and count_Type'Base. -- wider of Index_Type'Base and count_Type'Base.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
J := (Before - 1) + Index_Type'Base (N); J := (Before - 1) + Index_Type'Base (N);
else else
J := Index_Type'Base (Count_Type'Base (Before - 1) + N); J := Index_Type'Base (Count_Type'Base (Before - 1) + N);
@ -1722,7 +1767,7 @@ package body Ada.Containers.Vectors is
-- equals Index_Type'First, then this first source slice will be -- equals Index_Type'First, then this first source slice will be
-- empty, which is harmless.) -- empty, which is harmless.)
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
K := L + Index_Type'Base (Src'Length); K := L + Index_Type'Base (Src'Length);
else else
K := Index_Type'Base (Count_Type'Base (L) + Src'Length); K := Index_Type'Base (Count_Type'Base (L) + Src'Length);
@ -1765,7 +1810,7 @@ package body Ada.Containers.Vectors is
-- destination that receives this slice of the source. (For the -- destination that receives this slice of the source. (For the
-- reasons given above, this slice is guaranteed to be non-empty.) -- reasons given above, this slice is guaranteed to be non-empty.)
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
K := F - Index_Type'Base (Src'Length); K := F - Index_Type'Base (Src'Length);
else else
K := Index_Type'Base (Count_Type'Base (F) - Src'Length); K := Index_Type'Base (Count_Type'Base (F) - Src'Length);
@ -1996,7 +2041,7 @@ package body Ada.Containers.Vectors is
-- deeper flaw in the caller's algorithm, so that case is treated as a -- deeper flaw in the caller's algorithm, so that case is treated as a
-- proper error.) -- proper error.)
if Before > Container.Last and then Before > Container.Last + 1 then if Before > Container.Last + 1 then
raise Constraint_Error with raise Constraint_Error with
"Before index is out of range (too large)"; "Before index is out of range (too large)";
end if; end if;
@ -2029,7 +2074,7 @@ package body Ada.Containers.Vectors is
-- compare the new length to the maximum length. If the new length is -- compare the new length to the maximum length. If the new length 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_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.
@ -2064,9 +2109,8 @@ package body Ada.Containers.Vectors is
-- worry about if No_Index were less than 0, but that case is -- worry about if No_Index were less than 0, but that case is
-- handled above). -- handled above).
if Index_Type'Last - No_Index >= if Index_Type'Last - No_Index >= Count_Type_Last then
Count_Type'Pos (Count_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.
@ -2131,7 +2175,7 @@ package body Ada.Containers.Vectors is
-- insertion. Use the wider of Index_Type'Base and Count_Type'Base to -- insertion. Use the wider of Index_Type'Base and Count_Type'Base to
-- compute its value from the New_Length. -- compute its value from the New_Length.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= 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);
@ -2192,7 +2236,7 @@ package body Ada.Containers.Vectors is
-- home. We use the wider of Index_Type'Base and -- home. We use the wider of Index_Type'Base and
-- Count_Type'Base as the type for intermediate index values. -- Count_Type'Base as the type for intermediate index values.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
Index := Before + Index_Type'Base (Count); Index := Before + Index_Type'Base (Count);
else else
@ -2238,7 +2282,7 @@ package body Ada.Containers.Vectors is
-- We have computed the length of the new internal array (and this is -- We have computed the length of the new internal array (and this is
-- what "vector capacity" means), so use that to compute its last index. -- what "vector capacity" means), so use that to compute its last index.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type_Last then
Dst_Last := No_Index + Index_Type'Base (New_Capacity); Dst_Last := No_Index + Index_Type'Base (New_Capacity);
else else
Dst_Last := Dst_Last :=
@ -2269,7 +2313,7 @@ package body Ada.Containers.Vectors is
-- The space is being inserted before some existing elements, so -- The space is being inserted before some existing elements, so
-- we must slide the existing elements up to their new home. -- we must slide the existing elements up to their new home.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= 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);
@ -3011,7 +3055,7 @@ package body Ada.Containers.Vectors is
-- the Last index value of the new internal array, in a way that avoids -- the Last index value of the new internal array, in a way that avoids
-- 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_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
@ -3528,7 +3572,7 @@ package body Ada.Containers.Vectors is
-- index). We must therefore check whether the specified Length would -- index). We must therefore check whether the specified Length would
-- 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_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
@ -3595,7 +3639,7 @@ package body Ada.Containers.Vectors is
Elements := new Elements_Type (Last); Elements := new Elements_Type (Last);
return Vector'(Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, others => <>);
end To_Vector; end To_Vector;
function To_Vector function To_Vector
@ -3618,7 +3662,7 @@ package body Ada.Containers.Vectors is
-- index). We must therefore check whether the specified Length would -- index). We must therefore check whether the specified Length would
-- 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_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
@ -3685,7 +3729,7 @@ package body Ada.Containers.Vectors is
Elements := new Elements_Type'(Last, EA => (others => New_Item)); Elements := new Elements_Type'(Last, EA => (others => New_Item));
return Vector'(Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, others => <>);
end To_Vector; end To_Vector;
-------------------- --------------------

14
gcc/ada/a-convec.ads
View File

@ -352,6 +352,7 @@ package Ada.Containers.Vectors is
private private
pragma Inline (Append);
pragma Inline (First_Index); pragma Inline (First_Index);
pragma Inline (Last_Index); pragma Inline (Last_Index);
pragma Inline (Element); pragma Inline (Element);
@ -368,24 +369,23 @@ private
type Elements_Array is array (Index_Type range <>) of aliased Element_Type; type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract; function "=" (L, R : Elements_Array) return Boolean is abstract;
type Elements_Type (Last : Index_Type) is limited record type Elements_Type (Last : Extended_Index) is limited record
EA : Elements_Array (Index_Type'First .. Last); EA : Elements_Array (Index_Type'First .. Last);
end record; end record;
type Elements_Access is access Elements_Type; type Elements_Access is access all Elements_Type;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams; use Ada.Streams;
type Vector is new Controlled with record type Vector is new Controlled with record
Elements : Elements_Access; Elements : Elements_Access := null;
Last : Extended_Index := No_Index; Last : Extended_Index := No_Index;
Busy : Natural := 0; Busy : Natural := 0;
Lock : Natural := 0; Lock : Natural := 0;
end record; end record;
overriding procedure Adjust (Container : in out Vector); overriding procedure Adjust (Container : in out Vector);
overriding procedure Finalize (Container : in out Vector); overriding procedure Finalize (Container : in out Vector);
procedure Write procedure Write
@ -495,6 +495,10 @@ private
No_Element : constant Cursor := Cursor'(null, Index_Type'First); No_Element : constant Cursor := Cursor'(null, Index_Type'First);
Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0); Empty_Vector : constant Vector := (Controlled with others => <>);
Count_Type_Last : constant := Count_Type'Last;
-- Count_Type'Last as a universal_integer, so we can compare Index_Type
-- values against this without type conversions that might overflow.
end Ada.Containers.Vectors; end Ada.Containers.Vectors;

9
gcc/ada/switch-c.adb
View File

@ -387,6 +387,15 @@ package body Switch.C is
Osint.Fail Osint.Fail
("-gnatd.b must be first if combined " ("-gnatd.b must be first if combined "
& "with other switches"); & "with other switches");
-- Special check, -gnatd.V must occur after -gnatc
elsif C = 'V'
and then Operating_Mode /= Check_Semantics
then
Osint.Fail
("gnatd.V requires previous occurrence "
& "of -gnatc");
end if; end if;
-- Not a dotted flag -- Not a dotted flag