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

[multiple changes] 

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>
* 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;
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 :=
new Elements_Type'(Right.Last, RE);
begin
return (Controlled with Elements, Right.Last, 0, 0);
return (Controlled with Elements, Right.Last, others => <>);
end;
end if;
@ -102,7 +109,7 @@ package body Ada.Containers.Vectors is
Elements : constant Elements_Access :=
new Elements_Type'(Left.Last, LE);
begin
return (Controlled with Elements, Left.Last, 0, 0);
return (Controlled with Elements, Left.Last, others => <>);
end;
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
-- 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
-- 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 :=
new Elements_Type'(Last, LE & RE);
begin
return (Controlled with Elements, Last, 0, 0);
return (Controlled with Elements, Last, others => <>);
end;
end "&";
@ -223,7 +230,7 @@ package body Ada.Containers.Vectors is
EA => (others => Right));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
return (Controlled with Elements, Index_Type'First, others => <>);
end;
end if;
@ -248,7 +255,7 @@ package body Ada.Containers.Vectors is
Elements : constant Elements_Access :=
new Elements_Type'(Last => Last, EA => LE & Right);
begin
return (Controlled with Elements, Last, 0, 0);
return (Controlled with Elements, Last, others => <>);
end;
end "&";
@ -268,7 +275,7 @@ package body Ada.Containers.Vectors is
(Last => Index_Type'First,
EA => (others => Left));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
return (Controlled with Elements, Index_Type'First, others => <>);
end;
end if;
@ -298,7 +305,7 @@ package body Ada.Containers.Vectors is
EA => Left & RE);
begin
return (Controlled with Elements, Last, 0, 0);
return (Controlled with Elements, Last, others => <>);
end;
end "&";
@ -328,7 +335,7 @@ package body Ada.Containers.Vectors is
EA => (Left, Right));
begin
return (Controlled with Elements, Last, 0, 0);
return (Controlled with Elements, Last, others => <>);
end;
end "&";
@ -456,6 +463,45 @@ package body Ada.Containers.Vectors is
New_Item : Element_Type;
Count : Count_Type := 1)
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
if Count = 0 then
return;
@ -464,7 +510,7 @@ package body Ada.Containers.Vectors is
else
Insert (Container, Container.Last + 1, New_Item, Count);
end if;
end Append;
end Append_Slow_Path;
------------
-- 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 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);
J := Index + Index_Type'Base (Count);
else
@ -814,7 +860,7 @@ package body Ada.Containers.Vectors is
if Count >= Container.Length then
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);
else
@ -858,14 +904,14 @@ package body Ada.Containers.Vectors is
X : Elements_Access := Container.Elements;
begin
Container.Elements := null;
Container.Last := No_Index;
Free (X);
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is busy)";
else
Container.Elements := null;
Container.Last := No_Index;
Free (X);
end if;
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
-- proper error.)
if Before > Container.Last and then Before > Container.Last + 1 then
if Before > Container.Last + 1 then
raise Constraint_Error with
"Before index is out of range (too large)";
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
-- 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
-- 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
-- handled above).
if Index_Type'Last - No_Index >=
Count_Type'Pos (Count_Type'Last)
then
if Index_Type'Last - No_Index >= Count_Type_Last then
-- 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 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
-- 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);
else
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
-- 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);
else
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
-- 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);
else
Dst_Last :=
@ -1616,7 +1661,7 @@ package body Ada.Containers.Vectors is
-- The new items are being inserted before some existing elements,
-- 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);
else
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
-- 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);
else
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
-- 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);
else
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
-- 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);
else
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
-- proper error.)
if Before > Container.Last and then Before > Container.Last + 1 then
if Before > Container.Last + 1 then
raise Constraint_Error with
"Before index is out of range (too large)";
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
-- 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
-- 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
-- handled above).
if Index_Type'Last - No_Index >=
Count_Type'Pos (Count_Type'Last)
then
if Index_Type'Last - No_Index >= Count_Type_Last then
-- 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 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
-- 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);
else
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
-- 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);
else
@ -2238,7 +2282,7 @@ package body Ada.Containers.Vectors 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.
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);
else
Dst_Last :=
@ -2269,7 +2313,7 @@ package body Ada.Containers.Vectors is
-- The space is being inserted before some existing elements, 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);
else
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
-- 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
-- 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
-- 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
-- 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);
return Vector'(Controlled with Elements, Last, 0, 0);
return Vector'(Controlled with Elements, Last, others => <>);
end 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
-- 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
-- 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));
return Vector'(Controlled with Elements, Last, 0, 0);
return Vector'(Controlled with Elements, Last, others => <>);
end To_Vector;
--------------------

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

@ -352,6 +352,7 @@ package Ada.Containers.Vectors is
private
pragma Inline (Append);
pragma Inline (First_Index);
pragma Inline (Last_Index);
pragma Inline (Element);
@ -368,24 +369,23 @@ private
type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
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);
end record;
type Elements_Access is access Elements_Type;
type Elements_Access is access all Elements_Type;
use Ada.Finalization;
use Ada.Streams;
type Vector is new Controlled with record
Elements : Elements_Access;
Elements : Elements_Access := null;
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
overriding procedure Adjust (Container : in out Vector);
overriding procedure Finalize (Container : in out Vector);
procedure Write
@ -495,6 +495,10 @@ private
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;

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

@ -387,6 +387,15 @@ package body Switch.C is
Osint.Fail
("-gnatd.b must be first if combined "
& "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;
-- Not a dotted flag