diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1b35fd8f91d..15dc2189fe7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2015-05-22 Bob Duff + + * 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 + + * switch-c.adb (Scan_Front_End_Switches): Insist on -gnatc + for -gnatd.V. + 2015-05-22 Arnaud Charlet * gnatvsn.ads: Minor code reorg to remember more easily to update diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 5eb82fe739d..bf7c08b23ba 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -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; -------------------- diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads index cb1bce17507..fb801b8aaae 100644 --- a/gcc/ada/a-convec.ads +++ b/gcc/ada/a-convec.ads @@ -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; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 7e8f50e099d..c3ebbaab332 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -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