2015-10-16 Bob Duff <duff@adacore.com>

	* a-contai.ads: Add two check names: Container_Checks and
	Tampering_Check.  Move the tampering check machinery from
	Ada.Containers.Vectors to Ada.Containers. Later we can share it
	with other containers.
	Disable the tampering machinery in the presence of
	Suppress(Tampering_Check).
	Simplify the implementation of tampering checks. E.g. use RAII
	to make incrementing/decrementing of the counts more concise.
	* a-contai.adb: New package body, implementing the above.
	* a-convec.ads, a-convec.adb: Use tampering check machinery
	in Ada.Containers.
	Disable all checking code when checks are suppressed.
	Simplify many of the operations. Implement "&" in terms of Append,
	rather than "by hand".
	Remove: function "=" (L, R : Elements_Array) return Boolean is
	abstract; so we can call the predefined "=" on Elements_Array.
	For "=" on Vectors: Previously, we returned True immediately if
	Left'Address = Right'Address.  That seems like a non-optimization
	("if X = X" is unusual), so removed that.  Simplify by using
	slice comparison ("=" on Element_Array will automatically call
	"=" on the components, even if user defined).

2015-10-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Chek_Record_Representation_Clause): When
	iterating over components, skip anonymous subtypes created for
	constrained array components.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@228896 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 728 insertions, 895 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 228d10c4d24..0e639383935 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+2015-10-16  Bob Duff  <duff@adacore.com>
+
+	* a-contai.ads: Add two check names: Container_Checks and
+	Tampering_Check.  Move the tampering check machinery from
+	Ada.Containers.Vectors to Ada.Containers. Later we can share it
+	with other containers.
+	Disable the tampering machinery in the presence of
+	Suppress(Tampering_Check).
+	Simplify the implementation of tampering checks. E.g. use RAII
+	to make incrementing/decrementing of the counts more concise.
+	* a-contai.adb: New package body, implementing the above.
+	* a-convec.ads, a-convec.adb: Use tampering check machinery
+	in Ada.Containers.
+	Disable all checking code when checks are suppressed.
+	Simplify many of the operations. Implement "&" in terms of Append,
+	rather than "by hand".
+	Remove: function "=" (L, R : Elements_Array) return Boolean is
+	abstract; so we can call the predefined "=" on Elements_Array.
+	For "=" on Vectors: Previously, we returned True immediately if
+	Left'Address = Right'Address.  That seems like a non-optimization
+	("if X = X" is unusual), so removed that.  Simplify by using
+	slice comparison ("=" on Element_Array will automatically call
+	"=" on the components, even if user defined).
+
+2015-10-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Chek_Record_Representation_Clause): When
+	iterating over components, skip anonymous subtypes created for
+	constrained array components.
+
 2015-10-16  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* a-tags.ads (Parent_Size): Remove obsolete pragma Export.
diff --git a/gcc/ada/a-contai.adb b/gcc/ada/a-contai.adb
new file mode 100644
index 00000000000..2ed760cb3ba
--- /dev/null
+++ b/gcc/ada/a-contai.adb
@@ -0,0 +1,189 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                       A D A . C O N T A I N E R S                        --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2015, Free Software Foundation, Inc.            --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+------------------------------------------------------------------------------
+
+package body Ada.Containers is
+
+   package body Generic_Implementation is
+
+      ------------
+      -- Adjust --
+      ------------
+
+      procedure Adjust (Control : in out Reference_Control_Type) is
+         pragma Assert (T_Check); -- not called if check suppressed
+      begin
+         if Control.T_Counts /= null then
+            Lock (Control.T_Counts.all);
+         end if;
+      end Adjust;
+
+      ----------
+      -- Busy --
+      ----------
+
+      procedure Busy (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            declare
+               B : Natural renames T_Counts.Busy;
+            begin
+               B := B + 1;
+            end;
+         end if;
+      end Busy;
+
+      --------------
+      -- Finalize --
+      --------------
+
+      procedure Finalize (Control : in out Reference_Control_Type) is
+         pragma Assert (T_Check); -- not called if check suppressed
+      begin
+         if Control.T_Counts /= null then
+            Unlock (Control.T_Counts.all);
+            Control.T_Counts := null;
+         end if;
+      end Finalize;
+
+      --  No need to protect against double Finalize here, because these types
+      --  are limited.
+
+      procedure Finalize (Busy : in out With_Busy) is
+         pragma Assert (T_Check); -- not called if check suppressed
+      begin
+         Unbusy (Busy.T_Counts.all);
+      end Finalize;
+
+      procedure Finalize (Lock : in out With_Lock) is
+         pragma Assert (T_Check); -- not called if check suppressed
+      begin
+         Unlock (Lock.T_Counts.all);
+      end Finalize;
+
+      ----------------
+      -- Initialize --
+      ----------------
+
+      procedure Initialize (Busy : in out With_Busy) is
+         pragma Assert (T_Check); -- not called if check suppressed
+      begin
+         Generic_Implementation.Busy (Busy.T_Counts.all);
+      end Initialize;
+
+      procedure Initialize (Lock : in out With_Lock) is
+         pragma Assert (T_Check); -- not called if check suppressed
+      begin
+         Generic_Implementation.Lock (Lock.T_Counts.all);
+      end Initialize;
+
+      ----------
+      -- Lock --
+      ----------
+
+      procedure Lock (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            declare
+               B : Natural renames T_Counts.Busy;
+               L : Natural renames T_Counts.Lock;
+            begin
+               L := L + 1;
+               B := B + 1;
+            end;
+         end if;
+      end Lock;
+
+      --------------
+      -- TC_Check --
+      --------------
+
+      procedure TC_Check (T_Counts : Tamper_Counts) is
+      begin
+         if T_Check and then T_Counts.Busy > 0 then
+            raise Program_Error with
+              "attempt to tamper with cursors";
+         end if;
+      end TC_Check;
+
+      --------------
+      -- TE_Check --
+      --------------
+
+      procedure TE_Check (T_Counts : Tamper_Counts) is
+      begin
+         if T_Check and then T_Counts.Lock > 0 then
+            raise Program_Error with
+              "attempt to tamper with elements";
+         end if;
+      end TE_Check;
+
+      ------------
+      -- Unbusy --
+      ------------
+
+      procedure Unbusy (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            declare
+               B : Natural renames T_Counts.Busy;
+            begin
+               B := B - 1;
+            end;
+         end if;
+      end Unbusy;
+
+      ------------
+      -- Unlock --
+      ------------
+
+      procedure Unlock (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            declare
+               B : Natural renames T_Counts.Busy;
+               L : Natural renames T_Counts.Lock;
+            begin
+               L := L - 1;
+               B := B - 1;
+            end;
+         end if;
+      end Unlock;
+
+      -----------------
+      -- Zero_Counts --
+      -----------------
+
+      procedure Zero_Counts (T_Counts : out Tamper_Counts) is
+      begin
+         if T_Check then
+            T_Counts := (others => <>);
+         end if;
+      end Zero_Counts;
+
+   end Generic_Implementation;
+
+end Ada.Containers;
diff --git a/gcc/ada/a-contai.ads b/gcc/ada/a-contai.ads
index be8a808747b..26f1f8d5ce9 100644
--- a/gcc/ada/a-contai.ads
+++ b/gcc/ada/a-contai.ads
@@ -13,6 +13,17 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+pragma Check_Name (Container_Checks);
+pragma Check_Name (Tampering_Check);
+--  The above checks are not in the Ada RM. They are added in order to allow
+--  suppression of checks within containers packages. Suppressing
+--  Tampering_Check suppresses the tampering checks and associated machinery,
+--  which is very expensive. Suppressing Container_Checks suppresses
+--  Tampering_Check as well as all the other (not-so-expensive) containers
+--  checks.
+
+private with Ada.Finalization;
+
 package Ada.Containers is
    pragma Pure;
 
@@ -21,4 +32,123 @@ package Ada.Containers is
 
    Capacity_Error : exception;
 
+private
+
+   type Tamper_Counts is record
+      Busy : Natural := 0;
+      Lock : Natural := 0;
+   end record;
+
+   --  Busy is positive when tampering with cursors is prohibited. Busy and
+   --  Lock are both positive when tampering with elements is prohibited.
+
+   type Tamper_Counts_Access is access all Tamper_Counts;
+   for Tamper_Counts_Access'Storage_Size use 0;
+
+   generic
+   package Generic_Implementation is
+
+      --  Generic package used in the implementation of containers.
+      --  ???Currently used by Vectors; not yet by all other containers.
+
+      --  This needs to be generic so that the 'Enabled attribute will return
+      --  the value that is relevant at the point where a container generic is
+      --  instantiated. For example:
+      --
+      --     pragma Suppress (Container_Checks);
+      --     package My_Vectors is new Ada.Containers.Vectors (...);
+      --
+      --  should suppress all container-related checks within the instance
+      --  My_Vectors.
+
+      --  Shorthands for "checks enabled" and "tampering checks enabled". Note
+      --  that suppressing either Container_Checks or Tampering_Check disables
+      --  tampering checks. Note that this code needs to be in a generic
+      --  package, because we want to take account of check suppressions at the
+      --  instance. We use these flags, along with pragma Inline, to ensure
+      --  that the compiler can optimize away the checks, as well as the
+      --  tampering check machinery, when checks are suppressed.
+
+      Checks : constant Boolean := Container_Checks'Enabled;
+      T_Check : constant Boolean :=
+        Container_Checks'Enabled and Tampering_Check'Enabled;
+
+      --  Reference_Control_Type is used as a component of reference types, to
+      --  prohibit tampering with elements so long as references exist.
+
+      type Reference_Control_Type is
+         new Finalization.Controlled with record
+            T_Counts : Tamper_Counts_Access;
+         end record
+           with Disable_Controlled => not T_Check;
+
+      overriding procedure Adjust (Control : in out Reference_Control_Type);
+      pragma Inline (Adjust);
+
+      overriding procedure Finalize (Control : in out Reference_Control_Type);
+      pragma Inline (Finalize);
+
+      procedure Zero_Counts (T_Counts : out Tamper_Counts);
+      pragma Inline (Zero_Counts);
+      --  Set Busy and Lock to zero
+
+      procedure Busy (T_Counts : in out Tamper_Counts);
+      pragma Inline (Busy);
+      --  Prohibit tampering with cursors
+
+      procedure Unbusy (T_Counts : in out Tamper_Counts);
+      pragma Inline (Unbusy);
+      --  Allow tampering with cursors
+
+      procedure Lock (T_Counts : in out Tamper_Counts);
+      pragma Inline (Lock);
+      --  Prohibit tampering with elements
+
+      procedure Unlock (T_Counts : in out Tamper_Counts);
+      pragma Inline (Unlock);
+      --  Allow tampering with elements
+
+      procedure TC_Check (T_Counts : Tamper_Counts);
+      pragma Inline (TC_Check);
+      --  Tampering-with-cursors check
+
+      procedure TE_Check (T_Counts : Tamper_Counts);
+      pragma Inline (TE_Check);
+      --  Tampering-with-elements check
+
+      -----------------
+      --  RAII Types --
+      -----------------
+
+      --  Initialize of With_Busy increments the Busy count, and Finalize
+      --  decrements it. Thus, to prohibit tampering with elements within a
+      --  given scope, declare an object of type With_Busy. The Busy count
+      --  will be correctly decremented in case of exception or abort.
+
+      --  With_Lock is the same as With_Busy, except it increments/decrements
+      --  BOTH Busy and Lock, thus prohibiting tampering with cursors.
+
+      type With_Busy (T_Counts : not null access Tamper_Counts) is
+        new Finalization.Limited_Controlled with null record
+          with Disable_Controlled => not T_Check;
+      overriding procedure Initialize (Busy : in out With_Busy);
+      overriding procedure Finalize (Busy : in out With_Busy);
+
+      type With_Lock (T_Counts : not null access Tamper_Counts) is
+        new Finalization.Limited_Controlled with null record
+          with Disable_Controlled => not T_Check;
+      overriding procedure Initialize (Lock : in out With_Lock);
+      overriding procedure Finalize (Lock : in out With_Lock);
+
+      --  Variables of type With_Busy and With_Lock are declared only for the
+      --  effects of Initialize and Finalize, so they are not referenced;
+      --  disable warnings about that. Note that all variables of these types
+      --  have names starting with "Busy" or "Lock". These pragmas need to be
+      --  present wherever these types are used.
+
+      pragma Warnings (Off, "variable ""Busy*"" is not referenced");
+      pragma Warnings (Off, "variable ""Lock*"" is not referenced");
+
+   end Generic_Implementation;
+
 end Ada.Containers;
diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb
index bf7c08b23ba..23d8d9766c0 100644
--- a/gcc/ada/a-convec.adb
+++ b/gcc/ada/a-convec.adb
@@ -36,29 +36,13 @@ package body Ada.Containers.Vectors is
 
    pragma Annotate (CodePeer, Skip_Analysis);
 
+   pragma Warnings (Off, "variable ""Busy*"" is not referenced");
+   pragma Warnings (Off, "variable ""Lock*"" is not referenced");
+   --  See comment in Ada.Containers
+
    procedure Free is
      new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
 
-   type Iterator is new Limited_Controlled and
-     Vector_Iterator_Interfaces.Reversible_Iterator with
-   record
-      Container : Vector_Access;
-      Index     : Index_Type'Base;
-   end record;
-
-   overriding procedure Finalize (Object : in out Iterator);
-
-   overriding function First (Object : Iterator) return Cursor;
-   overriding function Last  (Object : Iterator) return Cursor;
-
-   overriding function Next
-     (Object   : Iterator;
-      Position : Cursor) return Cursor;
-
-   overriding function Previous
-     (Object   : Iterator;
-      Position : Cursor) return Cursor;
-
    procedure Append_Slow_Path
      (Container : in out Vector;
       New_Item  : Element_Type;
@@ -70,273 +54,45 @@ package body Ada.Containers.Vectors is
    -- "&" --
    ---------
 
-   function "&" (Left, Right : Vector) return Vector is
-      LN   : constant Count_Type := Length (Left);
-      RN   : constant Count_Type := Length (Right);
-      N    : Count_Type'Base;  -- length of result
-      J    : Count_Type'Base;  -- for computing intermediate index values
-      Last : Index_Type'Base;  -- Last index of result
+   --  We decide that the capacity of the result of "&" is the minimum needed
+   --  -- the sum of the lengths of the vector parameters. We could decide to
+   --  make it larger, but we have no basis for knowing how much larger, so we
+   --  just allocate the minimum amount of storage.
 
+   function "&" (Left, Right : Vector) return Vector is
    begin
-      --  We decide that the capacity of the result is the sum of the lengths
-      --  of the vector parameters. We could decide to make it larger, but we
-      --  have no basis for knowing how much larger, so we just allocate the
-      --  minimum amount of storage.
-
-      --  Here we handle the easy cases first, when one of the vector
-      --  parameters is empty. (We say "easy" because there's nothing to
-      --  compute, that can potentially overflow.)
-
-      if LN = 0 then
-         if RN = 0 then
-            return Empty_Vector;
-         end if;
-
-         declare
-            RE       : Elements_Array renames
-                         Right.Elements.EA (Index_Type'First .. Right.Last);
-            Elements : constant Elements_Access :=
-                         new Elements_Type'(Right.Last, RE);
-         begin
-            return (Controlled with Elements, Right.Last, others => <>);
-         end;
-      end if;
-
-      if RN = 0 then
-         declare
-            LE       : Elements_Array renames
-                         Left.Elements.EA (Index_Type'First .. Left.Last);
-            Elements : constant Elements_Access :=
-                         new Elements_Type'(Left.Last, LE);
-         begin
-            return (Controlled with Elements, Left.Last, others => <>);
-         end;
-
-      end if;
-
-      --  Neither of the vector parameters is empty, so must compute the length
-      --  of the result vector and its last index. (This is the harder case,
-      --  because our computations must avoid overflow.)
-
-      --  There are two constraints we need to satisfy. The first constraint is
-      --  that a container cannot have more than Count_Type'Last elements, so
-      --  we must check the sum of the combined lengths. Note that we cannot
-      --  simply add the lengths, because of the possibility of overflow.
-
-      if LN > Count_Type'Last - RN then
-         raise Constraint_Error with "new length is out of range";
-      end if;
-
-      --  It is now safe compute the length of the new vector, without fear of
-      --  overflow.
-
-      N := LN + RN;
-
-      --  The second constraint is that the new Last index value cannot
-      --  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_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
-         --  determine whether it lies in the range of the index (sub)type.
-
-         --  Last must satisfy this relation:
-         --    First + Length - 1 <= Last
-         --  We regroup terms:
-         --    First - 1 <= Last - Length
-         --  Which can rewrite as:
-         --    No_Index <= Last - Length
-
-         if Index_Type'Base'Last - Index_Type'Base (N) < No_Index then
-            raise Constraint_Error with "new length is out of range";
-         end if;
-
-         --  We now know that the computed value of Last is within the base
-         --  range of the type, so it is safe to compute its value:
-
-         Last := No_Index + Index_Type'Base (N);
-
-         --  Finally we test whether the value is within the range of the
-         --  generic actual index subtype:
-
-         if Last > Index_Type'Last then
-            raise Constraint_Error with "new length is out of range";
-         end if;
-
-      elsif Index_Type'First <= 0 then
-
-         --  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
-         --  adding the (positive) value of length.
-
-         J := Count_Type'Base (No_Index) + N;  -- Last
-
-         if J > Count_Type'Base (Index_Type'Last) then
-            raise Constraint_Error with "new length is out of range";
-         end if;
-
-         --  We know that the computed value (having type Count_Type) of Last
-         --  is within the range of the generic actual index subtype, so it is
-         --  safe to convert to Index_Type:
-
-         Last := Index_Type'Base (J);
-
-      else
-         --  Here Index_Type'First (and Index_Type'Last) is positive, so we
-         --  must test the length indirectly (by working backwards from the
-         --  largest possible value of Last), in order to prevent overflow.
-
-         J := Count_Type'Base (Index_Type'Last) - N;  -- No_Index
-
-         if J < Count_Type'Base (No_Index) then
-            raise Constraint_Error with "new length is out of range";
-         end if;
-
-         --  We have determined that the result length would not create a Last
-         --  index value outside of the range of Index_Type, so we can now
-         --  safely compute its value.
-
-         Last := Index_Type'Base (Count_Type'Base (No_Index) + N);
-      end if;
-
-      declare
-         LE       : Elements_Array renames
-                      Left.Elements.EA (Index_Type'First .. Left.Last);
-         RE       : Elements_Array renames
-                      Right.Elements.EA (Index_Type'First .. Right.Last);
-         Elements : constant Elements_Access :=
-                      new Elements_Type'(Last, LE & RE);
-      begin
-         return (Controlled with Elements, Last, others => <>);
-      end;
+      return Result : Vector do
+         Reserve_Capacity (Result, Length (Left) + Length (Right));
+         Append (Result, Left);
+         Append (Result, Right);
+      end return;
    end "&";
 
    function "&" (Left  : Vector; Right : Element_Type) return Vector is
    begin
-      --  We decide that the capacity of the result is the sum of the lengths
-      --  of the parameters. We could decide to make it larger, but we have no
-      --  basis for knowing how much larger, so we just allocate the minimum
-      --  amount of storage.
-
-      --  Handle easy case first, when the vector parameter (Left) is empty
-
-      if Left.Is_Empty then
-         declare
-            Elements : constant Elements_Access :=
-              new Elements_Type'
-                (Last => Index_Type'First,
-                 EA   => (others => Right));
-
-         begin
-            return (Controlled with Elements, Index_Type'First, others => <>);
-         end;
-      end if;
-
-      --  The vector parameter is not empty, so we must compute the length of
-      --  the result vector and its last index, but in such a way that overflow
-      --  is avoided. We must satisfy two constraints: the new length cannot
-      --  exceed Count_Type'Last, and the new Last index cannot exceed
-      --  Index_Type'Last.
-
-      if Left.Length = Count_Type'Last then
-         raise Constraint_Error with "new length is out of range";
-      end if;
-
-      if Left.Last >= Index_Type'Last then
-         raise Constraint_Error with "new length is out of range";
-      end if;
-
-      declare
-         Last     : constant Index_Type := Left.Last + 1;
-         LE       : Elements_Array renames
-                      Left.Elements.EA (Index_Type'First .. Left.Last);
-         Elements : constant Elements_Access :=
-                      new Elements_Type'(Last => Last, EA => LE & Right);
-      begin
-         return (Controlled with Elements, Last, others => <>);
-      end;
+      return Result : Vector do
+         Reserve_Capacity (Result, Length (Left) + 1);
+         Append (Result, Left);
+         Append (Result, Right);
+      end return;
    end "&";
 
    function "&" (Left  : Element_Type; Right : Vector) return Vector is
    begin
-      --  We decide that the capacity of the result is the sum of the lengths
-      --  of the parameters. We could decide to make it larger, but we have no
-      --  basis for knowing how much larger, so we just allocate the minimum
-      --  amount of storage.
-
-      --  Handle easy case first, when the vector parameter (Right) is empty
-
-      if Right.Is_Empty then
-         declare
-            Elements : constant Elements_Access :=
-              new Elements_Type'
-                (Last => Index_Type'First,
-                 EA   => (others => Left));
-         begin
-            return (Controlled with Elements, Index_Type'First, others => <>);
-         end;
-      end if;
-
-      --  The vector parameter is not empty, so we must compute the length of
-      --  the result vector and its last index, but in such a way that overflow
-      --  is avoided. We must satisfy two constraints: the new length cannot
-      --  exceed Count_Type'Last, and the new Last index cannot exceed
-      --  Index_Type'Last.
-
-      if Right.Length = Count_Type'Last then
-         raise Constraint_Error with "new length is out of range";
-      end if;
-
-      if Right.Last >= Index_Type'Last then
-         raise Constraint_Error with "new length is out of range";
-      end if;
-
-      declare
-         Last : constant Index_Type := Right.Last + 1;
-
-         RE : Elements_Array renames
-                Right.Elements.EA (Index_Type'First .. Right.Last);
-
-         Elements : constant Elements_Access :=
-           new Elements_Type'
-             (Last => Last,
-              EA   => Left & RE);
-
-      begin
-         return (Controlled with Elements, Last, others => <>);
-      end;
+      return Result : Vector do
+         Reserve_Capacity (Result, 1 + Length (Right));
+         Append (Result, Left);
+         Append (Result, Right);
+      end return;
    end "&";
 
    function "&" (Left, Right : Element_Type) return Vector is
    begin
-      --  We decide that the capacity of the result is the sum of the lengths
-      --  of the parameters. We could decide to make it larger, but we have no
-      --  basis for knowing how much larger, so we just allocate the minimum
-      --  amount of storage.
-
-      --  We must compute the length of the result vector and its last index,
-      --  but in such a way that overflow is avoided. We must satisfy two
-      --  constraints: the new length cannot exceed Count_Type'Last (here, we
-      --  know that that condition is satisfied), and the new Last index cannot
-      --  exceed Index_Type'Last.
-
-      if Index_Type'First >= Index_Type'Last then
-         raise Constraint_Error with "new length is out of range";
-      end if;
-
-      declare
-         Last : constant Index_Type := Index_Type'First + 1;
-
-         Elements : constant Elements_Access :=
-           new Elements_Type'
-             (Last => Last,
-              EA   => (Left, Right));
-
-      begin
-         return (Controlled with Elements, Last, others => <>);
-      end;
+      return Result : Vector do
+         Reserve_Capacity (Result, 1 + 1);
+         Append (Result, Left);
+         Append (Result, Right);
+      end return;
    end "&";
 
    ---------
@@ -344,57 +100,20 @@ package body Ada.Containers.Vectors is
    ---------
 
    overriding function "=" (Left, Right : Vector) return Boolean is
-      BL : Natural renames Left'Unrestricted_Access.Busy;
-      LL : Natural renames Left'Unrestricted_Access.Lock;
-
-      BR : Natural renames Right'Unrestricted_Access.Busy;
-      LR : Natural renames Right'Unrestricted_Access.Lock;
-
-      Result : Boolean;
-
    begin
-      if Left'Address = Right'Address then
-         return True;
-      end if;
-
-      if Left.Last /= Right.Last then
-         return False;
-      end if;
-
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
-      BL := BL + 1;
-      LL := LL + 1;
-
-      BR := BR + 1;
-      LR := LR + 1;
-
-      Result := True;
-      for J in Index_Type range Index_Type'First .. Left.Last loop
-         if Left.Elements.EA (J) /= Right.Elements.EA (J) then
-            Result := False;
-            exit;
-         end if;
-      end loop;
-
-      BL := BL - 1;
-      LL := LL - 1;
-
-      BR := BR - 1;
-      LR := LR - 1;
-
-      return Result;
-
-   exception
-      when others =>
-         BL := BL - 1;
-         LL := LL - 1;
-
-         BR := BR - 1;
-         LR := LR - 1;
-
-         raise;
+      declare
+         Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
+         Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
+         Left_Valid : Elements_Array renames
+           Left.Elements.EA (Index_Type'First .. Left.Last);
+         Right_Valid : Elements_Array renames
+           Right.Elements.EA (Index_Type'First .. Right.Last);
+      begin
+         return Left_Valid = Right_Valid;
+      end;
    end "=";
 
    ------------
@@ -415,8 +134,7 @@ package body Ada.Containers.Vectors is
 
       begin
          Container.Elements := null;
-         Container.Busy := 0;
-         Container.Lock := 0;
+         Zero_Counts (Container.TC);
 
          --  Note: it may seem that the following assignment to Container.Last
          --  is useless, since we assign it to L below. However this code is
@@ -429,20 +147,6 @@ package body Ada.Containers.Vectors is
       end;
    end Adjust;
 
-   procedure Adjust (Control : in out Reference_Control_Type) is
-   begin
-      if Control.Container /= null then
-         declare
-            C : Vector renames Control.Container.all;
-            B : Natural renames C.Busy;
-            L : Natural renames C.Lock;
-         begin
-            B := B + 1;
-            L := L + 1;
-         end;
-      end if;
-   end Adjust;
-
    ------------
    -- Append --
    ------------
@@ -451,7 +155,7 @@ package body Ada.Containers.Vectors is
    begin
       if Is_Empty (New_Item) then
          return;
-      elsif Container.Last = Index_Type'Last then
+      elsif Checks and then Container.Last = Index_Type'Last then
          raise Constraint_Error with "vector is already at its maximum length";
       else
          Insert (Container, Container.Last + 1, New_Item);
@@ -472,10 +176,7 @@ package body Ada.Containers.Vectors is
         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;
+         TC_Check (Container.TC);
 
          --  Increment Container.Last after assigning the New_Item, so we
          --  leave the Container unmodified in case Finalize/Adjust raises
@@ -505,7 +206,7 @@ package body Ada.Containers.Vectors is
    begin
       if Count = 0 then
          return;
-      elsif Container.Last = Index_Type'Last then
+      elsif Checks and then Container.Last = Index_Type'Last then
          raise Constraint_Error with "vector is already at its maximum length";
       else
          Insert (Container, Container.Last + 1, New_Item, Count);
@@ -545,12 +246,8 @@ package body Ada.Containers.Vectors is
 
    procedure Clear (Container : in out Vector) is
    begin
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      else
-         Container.Last := No_Index;
-      end if;
+      TC_Check (Container.TC);
+      Container.Last := No_Index;
    end Clear;
 
    ------------------------
@@ -562,31 +259,37 @@ package body Ada.Containers.Vectors is
       Position  : Cursor) return Constant_Reference_Type
    is
    begin
-      if Position.Container = null then
-         raise Constraint_Error with "Position cursor has no element";
-      end if;
+      if Checks then
+         if Position.Container = null then
+            raise Constraint_Error with "Position cursor has no element";
+         end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor denotes wrong container";
-      end if;
+         if Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Position cursor denotes wrong container";
+         end if;
 
-      if Position.Index > Position.Container.Last then
-         raise Constraint_Error with "Position cursor is out of range";
+         if Position.Index > Position.Container.Last then
+            raise Constraint_Error with "Position cursor is out of range";
+         end if;
       end if;
 
-      declare
-         C : Vector renames Position.Container.all;
-         B : Natural renames C.Busy;
-         L : Natural renames C.Lock;
-      begin
+      if T_Check then
+         declare
+            TC : constant Tamper_Counts_Access :=
+              Container.TC'Unrestricted_Access;
+         begin
+            return R : constant Constant_Reference_Type :=
+              (Element => Container.Elements.EA (Position.Index)'Access,
+               Control => (Controlled with TC))
+            do
+               Lock (TC.all);
+            end return;
+         end;
+      else
          return R : constant Constant_Reference_Type :=
            (Element => Container.Elements.EA (Position.Index)'Access,
-            Control => (Controlled with Container'Unrestricted_Access))
-         do
-            B := B + 1;
-            L := L + 1;
-         end return;
-      end;
+            Control => (Controlled with null));
+      end if;
    end Constant_Reference;
 
    function Constant_Reference
@@ -594,22 +297,26 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type) return Constant_Reference_Type
    is
    begin
-      if Index > Container.Last then
+      if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
-      else
+      end if;
+
+      if T_Check then
          declare
-            C : Vector renames Container'Unrestricted_Access.all;
-            B : Natural renames C.Busy;
-            L : Natural renames C.Lock;
+            TC : constant Tamper_Counts_Access :=
+              Container.TC'Unrestricted_Access;
          begin
             return R : constant Constant_Reference_Type :=
               (Element => Container.Elements.EA (Index)'Access,
-               Control => (Controlled with Container'Unrestricted_Access))
+               Control => (Controlled with TC))
             do
-               B := B + 1;
-               L := L + 1;
+               Lock (TC.all);
             end return;
          end;
+      else
+         return R : constant Constant_Reference_Type :=
+           (Element => Container.Elements.EA (Index)'Access,
+            Control => (Controlled with null));
       end if;
    end Constant_Reference;
 
@@ -642,7 +349,7 @@ package body Ada.Containers.Vectors is
       elsif Capacity >= Source.Length then
          C := Capacity;
 
-      else
+      elsif Checks then
          raise Capacity_Error with
            "Requested capacity is less than Source length";
       end if;
@@ -685,7 +392,7 @@ package body Ada.Containers.Vectors is
       --  in the base range that immediately precede and immediately follow the
       --  values in the Index_Type.)
 
-      if Index < Index_Type'First then
+      if Checks and then Index < Index_Type'First then
          raise Constraint_Error with "Index is out of range (too small)";
       end if;
 
@@ -697,7 +404,7 @@ package body Ada.Containers.Vectors is
       --  algorithm, so that case is treated as a proper error.)
 
       if Index > Old_Last then
-         if Index > Old_Last + 1 then
+         if Checks and then Index > Old_Last + 1 then
             raise Constraint_Error with "Index is out of range (too large)";
          else
             return;
@@ -717,10 +424,7 @@ package body Ada.Containers.Vectors is
       --  the count on exit. Delete checks the count to determine whether it is
       --  being called while the associated callback procedure is executing.
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
 
       --  We first calculate what's available for deletion starting at
       --  Index. Here and elsewhere we use the wider of Index_Type'Base and
@@ -778,22 +482,21 @@ package body Ada.Containers.Vectors is
       Position  : in out Cursor;
       Count     : Count_Type := 1)
    is
-      pragma Warnings (Off, Position);
-
    begin
-      if Position.Container = null then
-         raise Constraint_Error with "Position cursor has no element";
-
-      elsif Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor denotes wrong container";
+      if Checks then
+         if Position.Container = null then
+            raise Constraint_Error with "Position cursor has no element";
 
-      elsif Position.Index > Container.Last then
-         raise Program_Error with "Position index is out of range";
+         elsif Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Position cursor denotes wrong container";
 
-      else
-         Delete (Container, Position.Index, Count);
-         Position := No_Element;
+         elsif Position.Index > Container.Last then
+            raise Program_Error with "Position index is out of range";
+         end if;
       end if;
+
+      Delete (Container, Position.Index, Count);
+      Position := No_Element;
    end Delete;
 
    ------------------
@@ -842,10 +545,7 @@ package body Ada.Containers.Vectors is
       --  it is being called while the associated callback procedure is
       --  executing.
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
 
       --  There is no restriction on how large Count can be when deleting
       --  items. If it is equal or greater than the current length, then this
@@ -878,7 +578,7 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type) return Element_Type
    is
    begin
-      if Index > Container.Last then
+      if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       else
          return Container.Elements.EA (Index);
@@ -887,13 +587,15 @@ package body Ada.Containers.Vectors is
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      if Position.Container = null then
-         raise Constraint_Error with "Position cursor has no element";
-      elsif Position.Index > Position.Container.Last then
-         raise Constraint_Error with "Position cursor is out of range";
-      else
-         return Position.Container.Elements.EA (Position.Index);
+      if Checks then
+         if Position.Container = null then
+            raise Constraint_Error with "Position cursor has no element";
+         elsif Position.Index > Position.Container.Last then
+            raise Constraint_Error with "Position cursor is out of range";
+         end if;
       end if;
+
+      return Position.Container.Elements.EA (Position.Index);
    end Element;
 
    --------------
@@ -909,32 +611,13 @@ package body Ada.Containers.Vectors is
 
       Free (X);
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
    end Finalize;
 
    procedure Finalize (Object : in out Iterator) is
-      B : Natural renames Object.Container.Busy;
-   begin
-      B := B - 1;
-   end Finalize;
-
-   procedure Finalize (Control : in out Reference_Control_Type) is
+      pragma Assert (T_Check); -- not called if check suppressed
    begin
-      if Control.Container /= null then
-         declare
-            C : Vector renames Control.Container.all;
-            B : Natural renames C.Busy;
-            L : Natural renames C.Lock;
-         begin
-            B := B - 1;
-            L := L - 1;
-         end;
-
-         Control.Container := null;
-      end if;
+      Unbusy (Object.Container.TC);
    end Finalize;
 
    ----------
@@ -947,7 +630,7 @@ package body Ada.Containers.Vectors is
       Position  : Cursor := No_Element) return Cursor
    is
    begin
-      if Position.Container /= null then
+      if Checks and then Position.Container /= null then
          if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error with "Position cursor denotes wrong container";
          end if;
@@ -961,38 +644,15 @@ package body Ada.Containers.Vectors is
       --  element tampering by a generic actual subprogram.
 
       declare
-         B : Natural renames Container'Unrestricted_Access.Busy;
-         L : Natural renames Container'Unrestricted_Access.Lock;
-
-         Result : Index_Type'Base;
-
+         Lock : With_Lock (Container.TC'Unrestricted_Access);
       begin
-         B := B + 1;
-         L := L + 1;
-
-         Result := No_Index;
          for J in Position.Index .. Container.Last loop
             if Container.Elements.EA (J) = Item then
-               Result := J;
-               exit;
+               return Cursor'(Container'Unrestricted_Access, J);
             end if;
          end loop;
 
-         B := B - 1;
-         L := L - 1;
-
-         if Result = No_Index then
-            return No_Element;
-         else
-            return Cursor'(Container'Unrestricted_Access, Result);
-         end if;
-
-      exception
-         when others =>
-            B := B - 1;
-            L := L - 1;
-
-            raise;
+         return No_Element;
       end;
    end Find;
 
@@ -1005,37 +665,18 @@ package body Ada.Containers.Vectors is
       Item      : Element_Type;
       Index     : Index_Type := Index_Type'First) return Extended_Index
    is
-      B : Natural renames Container'Unrestricted_Access.Busy;
-      L : Natural renames Container'Unrestricted_Access.Lock;
-
-      Result : Index_Type'Base;
-
-   begin
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
-      B := B + 1;
-      L := L + 1;
-
-      Result := No_Index;
+      Lock : With_Lock (Container.TC'Unrestricted_Access);
+   begin
       for Indx in Index .. Container.Last loop
          if Container.Elements.EA (Indx) = Item then
-            Result := Indx;
-            exit;
+            return Indx;
          end if;
       end loop;
 
-      B := B - 1;
-      L := L - 1;
-
-      return Result;
-
-   exception
-      when others =>
-         B := B - 1;
-         L := L - 1;
-
-         raise;
+      return No_Index;
    end Find_Index;
 
    -----------
@@ -1080,7 +721,7 @@ package body Ada.Containers.Vectors is
 
    function First_Element (Container : Vector) return Element_Type is
    begin
-      if Container.Last = No_Index then
+      if Checks and then Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
       else
          return Container.Elements.EA (Index_Type'First);
@@ -1117,36 +758,16 @@ package body Ada.Containers.Vectors is
          --  element tampering by a generic actual subprogram.
 
          declare
-            EA : Elements_Array renames Container.Elements.EA;
-
-            B : Natural renames Container'Unrestricted_Access.Busy;
-            L : Natural renames Container'Unrestricted_Access.Lock;
-
-            Result : Boolean;
-
+            Lock : With_Lock (Container.TC'Unrestricted_Access);
+            EA   : Elements_Array renames Container.Elements.EA;
          begin
-            B := B + 1;
-            L := L + 1;
-
-            Result := True;
             for J in Index_Type'First .. Container.Last - 1 loop
                if EA (J + 1) < EA (J) then
-                  Result := False;
-                  exit;
+                  return False;
                end if;
             end loop;
 
-            B := B - 1;
-            L := L - 1;
-
-            return Result;
-
-         exception
-            when others =>
-               B := B - 1;
-               L := L - 1;
-
-               raise;
+            return True;
          end;
       end Is_Sorted;
 
@@ -1171,7 +792,7 @@ package body Ada.Containers.Vectors is
             return;
          end if;
 
-         if Target'Address = Source'Address then
+         if Checks and then Target'Address = Source'Address then
             raise Program_Error with
               "Target and Source denote same non-empty container";
          end if;
@@ -1181,10 +802,7 @@ package body Ada.Containers.Vectors is
             return;
          end if;
 
-         if Source.Busy > 0 then
-            raise Program_Error with
-              "attempt to tamper with cursors (vector is busy)";
-         end if;
+         TC_Check (Source.TC);
 
          Target.Set_Length (Length (Target) + Length (Source));
 
@@ -1195,19 +813,9 @@ package body Ada.Containers.Vectors is
             TA : Elements_Array renames Target.Elements.EA;
             SA : Elements_Array renames Source.Elements.EA;
 
-            TB : Natural renames Target.Busy;
-            TL : Natural renames Target.Lock;
-
-            SB : Natural renames Source.Busy;
-            SL : Natural renames Source.Lock;
-
+            Lock_Target : With_Lock (Target.TC'Unchecked_Access);
+            Lock_Source : With_Lock (Source.TC'Unchecked_Access);
          begin
-            TB := TB + 1;
-            TL := TL + 1;
-
-            SB := SB + 1;
-            SL := SL + 1;
-
             J := Target.Last;
             while Source.Last >= Index_Type'First loop
                pragma Assert (Source.Last <= Index_Type'First
@@ -1236,22 +844,6 @@ package body Ada.Containers.Vectors is
 
                J := J - 1;
             end loop;
-
-            TB := TB - 1;
-            TL := TL - 1;
-
-            SB := SB - 1;
-            SL := SL - 1;
-
-         exception
-            when others =>
-               TB := TB - 1;
-               TL := TL - 1;
-
-               SB := SB - 1;
-               SL := SL - 1;
-
-               raise;
          end;
       end Merge;
 
@@ -1283,33 +875,15 @@ package body Ada.Containers.Vectors is
          --  an artifact of our array-based implementation. Logically Sort
          --  requires a check for cursor tampering.
 
-         if Container.Busy > 0 then
-            raise Program_Error with
-              "attempt to tamper with cursors (vector is busy)";
-         end if;
+         TC_Check (Container.TC);
 
          --  Per AI05-0022, the container implementation is required to detect
          --  element tampering by a generic actual subprogram.
 
          declare
-            B : Natural renames Container.Busy;
-            L : Natural renames Container.Lock;
-
+            Lock : With_Lock (Container.TC'Unchecked_Access);
          begin
-            B := B + 1;
-            L := L + 1;
-
             Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
-
-            B := B - 1;
-            L := L - 1;
-
-         exception
-            when others =>
-               B := B - 1;
-               L := L - 1;
-
-               raise;
          end;
       end Sort;
 
@@ -1358,31 +932,33 @@ package body Ada.Containers.Vectors is
       Dst          : Elements_Access;  -- new, expanded internal array
 
    begin
-      --  As a precondition on the generic actual Index_Type, the base type
-      --  must include Index_Type'Pred (Index_Type'First); this is the value
-      --  that Container.Last assumes when the vector is empty. However, we do
-      --  not allow that as the value for Index when specifying where the new
-      --  items should be inserted, so we must manually check. (That the user
-      --  is allowed to specify the value at all here is a consequence of the
-      --  declaration of the Extended_Index subtype, which includes the values
-      --  in the base range that immediately precede and immediately follow the
-      --  values in the Index_Type.)
+      if Checks then
+         --  As a precondition on the generic actual Index_Type, the base type
+         --  must include Index_Type'Pred (Index_Type'First); this is the value
+         --  that Container.Last assumes when the vector is empty. However, we
+         --  do not allow that as the value for Index when specifying where the
+         --  new items should be inserted, so we must manually check. (That the
+         --  user is allowed to specify the value at all here is a consequence
+         --  of the declaration of the Extended_Index subtype, which includes
+         --  the values in the base range that immediately precede and
+         --  immediately follow the values in the Index_Type.)
 
-      if Before < Index_Type'First then
-         raise Constraint_Error with
-           "Before index is out of range (too small)";
-      end if;
+         if Before < Index_Type'First then
+            raise Constraint_Error with
+              "Before index is out of range (too small)";
+         end if;
 
-      --  We do allow a value greater than Container.Last to be specified as
-      --  the Index, but only if it's immediately greater. This allows for the
-      --  case of appending items to the back end of the vector. (It is assumed
-      --  that specifying an index value greater than Last + 1 indicates some
-      --  deeper flaw in the caller's algorithm, so that case is treated as a
-      --  proper error.)
+         --  We do allow a value greater than Container.Last to be specified as
+         --  the Index, but only if it's immediately greater. This allows for
+         --  the case of appending items to the back end of the vector. (It is
+         --  assumed that specifying an index value greater than Last + 1
+         --  indicates some deeper flaw in the caller's algorithm, so that case
+         --  is treated as a proper error.)
 
-      if Before > Container.Last + 1 then
-         raise Constraint_Error with
-           "Before index is out of range (too large)";
+         if Before > Container.Last + 1 then
+            raise Constraint_Error with
+              "Before index is out of range (too large)";
+         end if;
       end if;
 
       --  We treat inserting 0 items into the container as a no-op, even when
@@ -1398,7 +974,7 @@ package body Ada.Containers.Vectors is
       --  Note: we cannot simply add these values, because of the possibility
       --  of overflow.
 
-      if Old_Length > Count_Type'Last - Count then
+      if Checks and then Old_Length > Count_Type'Last - Count then
          raise Constraint_Error with "Count is out of range";
       end if;
 
@@ -1506,7 +1082,7 @@ package body Ada.Containers.Vectors is
       --  an internal array with a last index value greater than
       --  Index_Type'Last, with no way to index those elements).
 
-      if New_Length > Max_Length then
+      if Checks and then New_Length > Max_Length then
          raise Constraint_Error with "Count is out of range";
       end if;
 
@@ -1551,10 +1127,7 @@ package body Ada.Containers.Vectors is
       --  exit. Insert checks the count to determine whether it is being called
       --  while the associated callback procedure is executing.
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
 
       --  An internal array has already been allocated, so we must determine
       --  whether there is enough unused storage for the new items.
@@ -1828,7 +1401,7 @@ package body Ada.Containers.Vectors is
       Index : Index_Type'Base;
 
    begin
-      if Before.Container /= null
+      if Checks and then Before.Container /= null
         and then Before.Container /= Container'Unrestricted_Access
       then
          raise Program_Error with "Before cursor denotes wrong container";
@@ -1839,7 +1412,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Before.Container = null or else Before.Index > Container.Last then
-         if Container.Last = Index_Type'Last then
+         if Checks and then Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
          end if;
@@ -1862,7 +1435,7 @@ package body Ada.Containers.Vectors is
       Index : Index_Type'Base;
 
    begin
-      if Before.Container /= null
+      if Checks and then Before.Container /= null
         and then Before.Container /= Container'Unrestricted_Access
       then
          raise Program_Error with "Before cursor denotes wrong container";
@@ -1879,7 +1452,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Before.Container = null or else Before.Index > Container.Last then
-         if Container.Last = Index_Type'Last then
+         if Checks and then Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
          end if;
@@ -1904,7 +1477,7 @@ package body Ada.Containers.Vectors is
       Index : Index_Type'Base;
 
    begin
-      if Before.Container /= null
+      if Checks and then Before.Container /= null
         and then Before.Container /= Container'Unrestricted_Access
       then
          raise Program_Error with "Before cursor denotes wrong container";
@@ -1915,7 +1488,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Before.Container = null or else Before.Index > Container.Last then
-         if Container.Last = Index_Type'Last then
+         if Checks and then Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
          else
@@ -1939,7 +1512,7 @@ package body Ada.Containers.Vectors is
       Index : Index_Type'Base;
 
    begin
-      if Before.Container /= null
+      if Checks and then Before.Container /= null
         and then Before.Container /= Container'Unrestricted_Access
       then
          raise Program_Error with "Before cursor denotes wrong container";
@@ -1956,7 +1529,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Before.Container = null or else Before.Index > Container.Last then
-         if Container.Last = Index_Type'Last then
+         if Checks and then Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
          end if;
@@ -2019,31 +1592,33 @@ package body Ada.Containers.Vectors is
       Dst          : Elements_Access;  -- new, expanded internal array
 
    begin
-      --  As a precondition on the generic actual Index_Type, the base type
-      --  must include Index_Type'Pred (Index_Type'First); this is the value
-      --  that Container.Last assumes when the vector is empty. However, we do
-      --  not allow that as the value for Index when specifying where the new
-      --  items should be inserted, so we must manually check. (That the user
-      --  is allowed to specify the value at all here is a consequence of the
-      --  declaration of the Extended_Index subtype, which includes the values
-      --  in the base range that immediately precede and immediately follow the
-      --  values in the Index_Type.)
+      if Checks then
+         --  As a precondition on the generic actual Index_Type, the base type
+         --  must include Index_Type'Pred (Index_Type'First); this is the value
+         --  that Container.Last assumes when the vector is empty. However, we
+         --  do not allow that as the value for Index when specifying where the
+         --  new items should be inserted, so we must manually check. (That the
+         --  user is allowed to specify the value at all here is a consequence
+         --  of the declaration of the Extended_Index subtype, which includes
+         --  the values in the base range that immediately precede and
+         --  immediately follow the values in the Index_Type.)
 
-      if Before < Index_Type'First then
-         raise Constraint_Error with
-           "Before index is out of range (too small)";
-      end if;
+         if Before < Index_Type'First then
+            raise Constraint_Error with
+              "Before index is out of range (too small)";
+         end if;
 
-      --  We do allow a value greater than Container.Last to be specified as
-      --  the Index, but only if it's immediately greater. This allows for the
-      --  case of appending items to the back end of the vector. (It is assumed
-      --  that specifying an index value greater than Last + 1 indicates some
-      --  deeper flaw in the caller's algorithm, so that case is treated as a
-      --  proper error.)
+         --  We do allow a value greater than Container.Last to be specified as
+         --  the Index, but only if it's immediately greater. This allows for
+         --  the case of appending items to the back end of the vector. (It is
+         --  assumed that specifying an index value greater than Last + 1
+         --  indicates some deeper flaw in the caller's algorithm, so that case
+         --  is treated as a proper error.)
 
-      if Before > Container.Last + 1 then
-         raise Constraint_Error with
-           "Before index is out of range (too large)";
+         if Before > Container.Last + 1 then
+            raise Constraint_Error with
+              "Before index is out of range (too large)";
+         end if;
       end if;
 
       --  We treat inserting 0 items into the container as a no-op, even when
@@ -2059,7 +1634,7 @@ package body Ada.Containers.Vectors is
       --  Note: we cannot simply add these values, because of the possibility
       --  of overflow.
 
-      if Old_Length > Count_Type'Last - Count then
+      if Checks and then Old_Length > Count_Type'Last - Count then
          raise Constraint_Error with "Count is out of range";
       end if;
 
@@ -2167,7 +1742,7 @@ package body Ada.Containers.Vectors is
       --  an internal array with a last index value greater than
       --  Index_Type'Last, with no way to index those elements).
 
-      if New_Length > Max_Length then
+      if Checks and then New_Length > Max_Length then
          raise Constraint_Error with "Count is out of range";
       end if;
 
@@ -2211,10 +1786,7 @@ package body Ada.Containers.Vectors is
       --  exit. Insert checks the count to determine whether it is being called
       --  while the associated callback procedure is executing.
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
 
       --  An internal array has already been allocated, so we must determine
       --  whether there is enough unused storage for the new items.
@@ -2360,7 +1932,7 @@ package body Ada.Containers.Vectors is
       Index : Index_Type'Base;
 
    begin
-      if Before.Container /= null
+      if Checks and then Before.Container /= null
         and then Before.Container /= Container'Unrestricted_Access
       then
          raise Program_Error with "Before cursor denotes wrong container";
@@ -2377,7 +1949,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Before.Container = null or else Before.Index > Container.Last then
-         if Container.Last = Index_Type'Last then
+         if Checks and then Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
          else
@@ -2410,22 +1982,11 @@ package body Ada.Containers.Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor))
    is
-      B : Natural renames Container'Unrestricted_Access.all.Busy;
-
+      Busy : With_Busy (Container.TC'Unrestricted_Access);
    begin
-      B := B + 1;
-
-      begin
-         for Indx in Index_Type'First .. Container.Last loop
-            Process (Cursor'(Container'Unrestricted_Access, Indx));
-         end loop;
-      exception
-         when others =>
-            B := B - 1;
-            raise;
-      end;
-
-      B := B - 1;
+      for Indx in Index_Type'First .. Container.Last loop
+         Process (Cursor'(Container'Unrestricted_Access, Indx));
+      end loop;
    end Iterate;
 
    function Iterate
@@ -2433,8 +1994,6 @@ package body Ada.Containers.Vectors is
       return Vector_Iterator_Interfaces.Reversible_Iterator'Class
    is
       V : constant Vector_Access := Container'Unrestricted_Access;
-      B : Natural renames V.Busy;
-
    begin
       --  The value of its Index component influences the behavior of the First
       --  and Last selector functions of the iterator object. When the Index
@@ -2451,7 +2010,7 @@ package body Ada.Containers.Vectors is
                        Container => V,
                        Index     => No_Index)
       do
-         B := B + 1;
+         Busy (Container.TC'Unrestricted_Access.all);
       end return;
    end Iterate;
 
@@ -2461,8 +2020,6 @@ package body Ada.Containers.Vectors is
       return Vector_Iterator_Interfaces.Reversible_Iterator'class
    is
       V : constant Vector_Access := Container'Unrestricted_Access;
-      B : Natural renames V.Busy;
-
    begin
       --  It was formerly the case that when Start = No_Element, the partial
       --  iterator was defined to behave the same as for a complete iterator,
@@ -2475,19 +2032,21 @@ package body Ada.Containers.Vectors is
       --  however, that it is not possible to use a partial iterator to specify
       --  an empty sequence of items.
 
-      if Start.Container = null then
-         raise Constraint_Error with
-           "Start position for iterator equals No_Element";
-      end if;
+      if Checks then
+         if Start.Container = null then
+            raise Constraint_Error with
+              "Start position for iterator equals No_Element";
+         end if;
 
-      if Start.Container /= V then
-         raise Program_Error with
-           "Start cursor of Iterate designates wrong vector";
-      end if;
+         if Start.Container /= V then
+            raise Program_Error with
+              "Start cursor of Iterate designates wrong vector";
+         end if;
 
-      if Start.Index > V.Last then
-         raise Constraint_Error with
-           "Start position for iterator equals No_Element";
+         if Start.Index > V.Last then
+            raise Constraint_Error with
+              "Start position for iterator equals No_Element";
+         end if;
       end if;
 
       --  The value of its Index component influences the behavior of the First
@@ -2504,7 +2063,7 @@ package body Ada.Containers.Vectors is
                        Container => V,
                        Index     => Start.Index)
       do
-         B := B + 1;
+         Busy (Container.TC'Unrestricted_Access.all);
       end return;
    end Iterate;
 
@@ -2549,7 +2108,7 @@ package body Ada.Containers.Vectors is
 
    function Last_Element (Container : Vector) return Element_Type is
    begin
-      if Container.Last = No_Index then
+      if Checks and then Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
       else
          return Container.Elements.EA (Container.Last);
@@ -2612,15 +2171,8 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (Target is busy)";
-      end if;
-
-      if Source.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (Source is busy)";
-      end if;
+      TC_Check (Target.TC);
+      TC_Check (Source.TC);
 
       declare
          Target_Elements : constant Elements_Access := Target.Elements;
@@ -2652,7 +2204,7 @@ package body Ada.Containers.Vectors is
    begin
       if Position.Container = null then
          return No_Element;
-      elsif Position.Container /= Object.Container then
+      elsif Checks and then Position.Container /= Object.Container then
          raise Program_Error with
            "Position cursor of Next designates wrong vector";
       else
@@ -2708,7 +2260,7 @@ package body Ada.Containers.Vectors is
    begin
       if Position.Container = null then
          return No_Element;
-      elsif Position.Container /= Object.Container then
+      elsif Checks and then Position.Container /= Object.Container then
          raise Program_Error with
            "Position cursor of Previous designates wrong vector";
       else
@@ -2734,15 +2286,10 @@ package body Ada.Containers.Vectors is
    function Pseudo_Reference
      (Container : aliased Vector'Class) return Reference_Control_Type
    is
-      C : constant Vector_Access := Container'Unrestricted_Access;
-      B : Natural renames C.Busy;
-      L : Natural renames C.Lock;
+      TC : constant Tamper_Counts_Access := Container.TC'Unrestricted_Access;
    begin
-      return R : constant Reference_Control_Type :=
-        (Controlled with C)
-      do
-         B := B + 1;
-         L := L + 1;
+      return R : constant Reference_Control_Type := (Controlled with TC) do
+         Lock (TC.all);
       end return;
    end Pseudo_Reference;
 
@@ -2755,29 +2302,15 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type;
       Process   : not null access procedure (Element : Element_Type))
    is
+      Lock : With_Lock (Container.TC'Unrestricted_Access);
       V : Vector renames Container'Unrestricted_Access.all;
-      B : Natural renames V.Busy;
-      L : Natural renames V.Lock;
 
    begin
-      if Index > Container.Last then
+      if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       end if;
 
-      B := B + 1;
-      L := L + 1;
-
-      begin
-         Process (V.Elements.EA (Index));
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
-
-      L := L - 1;
-      B := B - 1;
+      Process (V.Elements.EA (Index));
    end Query_Element;
 
    procedure Query_Element
@@ -2785,7 +2318,7 @@ package body Ada.Containers.Vectors is
       Process  : not null access procedure (Element : Element_Type))
    is
    begin
-      if Position.Container = null then
+      if Checks and then Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
       else
          Query_Element (Position.Container.all, Position.Index, Process);
@@ -2852,31 +2385,37 @@ package body Ada.Containers.Vectors is
       Position  : Cursor) return Reference_Type
    is
    begin
-      if Position.Container = null then
-         raise Constraint_Error with "Position cursor has no element";
-      end if;
+      if Checks then
+         if Position.Container = null then
+            raise Constraint_Error with "Position cursor has no element";
+         end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor denotes wrong container";
-      end if;
+         if Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Position cursor denotes wrong container";
+         end if;
 
-      if Position.Index > Position.Container.Last then
-         raise Constraint_Error with "Position cursor is out of range";
+         if Position.Index > Position.Container.Last then
+            raise Constraint_Error with "Position cursor is out of range";
+         end if;
       end if;
 
-      declare
-         C : Vector renames Position.Container.all;
-         B : Natural renames C.Busy;
-         L : Natural renames C.Lock;
-      begin
+      if T_Check then
+         declare
+            TC : constant Tamper_Counts_Access :=
+              Container.TC'Unrestricted_Access;
+         begin
+            return R : constant Reference_Type :=
+              (Element => Container.Elements.EA (Position.Index)'Access,
+               Control => (Controlled with TC))
+            do
+               Lock (TC.all);
+            end return;
+         end;
+      else
          return R : constant Reference_Type :=
            (Element => Container.Elements.EA (Position.Index)'Access,
-            Control => (Controlled with Position.Container))
-         do
-            B := B + 1;
-            L := L + 1;
-         end return;
-      end;
+            Control => (Controlled with null));
+      end if;
    end Reference;
 
    function Reference
@@ -2884,23 +2423,26 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type) return Reference_Type
    is
    begin
-      if Index > Container.Last then
+      if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
+      end if;
 
-      else
+      if T_Check then
          declare
-            C : Vector renames Container'Unrestricted_Access.all;
-            B : Natural renames C.Busy;
-            L : Natural renames C.Lock;
+            TC : constant Tamper_Counts_Access :=
+              Container.TC'Unrestricted_Access;
          begin
             return R : constant Reference_Type :=
               (Element => Container.Elements.EA (Index)'Access,
-               Control => (Controlled with Container'Unrestricted_Access))
+               Control => (Controlled with TC))
             do
-               B := B + 1;
-               L := L + 1;
+               Lock (TC.all);
             end return;
          end;
+      else
+         return R : constant Reference_Type :=
+           (Element => Container.Elements.EA (Index)'Access,
+            Control => (Controlled with null));
       end if;
    end Reference;
 
@@ -2914,14 +2456,12 @@ package body Ada.Containers.Vectors is
       New_Item  : Element_Type)
    is
    begin
-      if Index > Container.Last then
+      if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
-      elsif Container.Lock > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (vector is locked)";
-      else
-         Container.Elements.EA (Index) := New_Item;
       end if;
+
+      TE_Check (Container.TC);
+      Container.Elements.EA (Index) := New_Item;
    end Replace_Element;
 
    procedure Replace_Element
@@ -2930,23 +2470,20 @@ package body Ada.Containers.Vectors is
       New_Item  : Element_Type)
    is
    begin
-      if Position.Container = null then
-         raise Constraint_Error with "Position cursor has no element";
+      if Checks then
+         if Position.Container = null then
+            raise Constraint_Error with "Position cursor has no element";
 
-      elsif Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor denotes wrong container";
-
-      elsif Position.Index > Container.Last then
-         raise Constraint_Error with "Position cursor is out of range";
+         elsif Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Position cursor denotes wrong container";
 
-      else
-         if Container.Lock > 0 then
-            raise Program_Error with
-              "attempt to tamper with elements (vector is locked)";
+         elsif Position.Index > Container.Last then
+            raise Constraint_Error with "Position cursor is out of range";
          end if;
-
-         Container.Elements.EA (Position.Index) := New_Item;
       end if;
+
+      TE_Check (Container.TC);
+      Container.Elements.EA (Position.Index) := New_Item;
    end Replace_Element;
 
    ----------------------
@@ -3008,10 +2545,7 @@ package body Ada.Containers.Vectors is
             --  so this is the best we can do with respect to minimizing
             --  storage).
 
-            if Container.Busy > 0 then
-               raise Program_Error with
-                 "attempt to tamper with cursors (vector is busy)";
-            end if;
+            TC_Check (Container.TC);
 
             declare
                subtype Src_Index_Subtype is Index_Type'Base range
@@ -3068,7 +2602,9 @@ package body Ada.Containers.Vectors is
          --  Which can rewrite as:
          --    No_Index <= Last - Length
 
-         if Index_Type'Base'Last - Index_Type'Base (Capacity) < No_Index then
+         if Checks and then
+           Index_Type'Base'Last - Index_Type'Base (Capacity) < No_Index
+         then
             raise Constraint_Error with "Capacity is out of range";
          end if;
 
@@ -3080,7 +2616,7 @@ package body Ada.Containers.Vectors is
          --  Finally we test whether the value is within the range of the
          --  generic actual index subtype:
 
-         if Last > Index_Type'Last then
+         if Checks and then Last > Index_Type'Last then
             raise Constraint_Error with "Capacity is out of range";
          end if;
 
@@ -3092,7 +2628,7 @@ package body Ada.Containers.Vectors is
 
          Index := Count_Type'Base (No_Index) + Capacity;  -- Last
 
-         if Index > Count_Type'Base (Index_Type'Last) then
+         if Checks and then Index > Count_Type'Base (Index_Type'Last) then
             raise Constraint_Error with "Capacity is out of range";
          end if;
 
@@ -3109,7 +2645,7 @@ package body Ada.Containers.Vectors is
 
          Index := Count_Type'Base (Index_Type'Last) - Capacity;  -- No_Index
 
-         if Index < Count_Type'Base (No_Index) then
+         if Checks and then Index < Count_Type'Base (No_Index) then
             raise Constraint_Error with "Capacity is out of range";
          end if;
 
@@ -3148,10 +2684,7 @@ package body Ada.Containers.Vectors is
             --  new internal array having a length that exactly matches the
             --  number of items in the container.
 
-            if Container.Busy > 0 then
-               raise Program_Error with
-                 "attempt to tamper with cursors (vector is busy)";
-            end if;
+            TC_Check (Container.TC);
 
             declare
                subtype Src_Index_Subtype is Index_Type'Base range
@@ -3208,10 +2741,7 @@ package body Ada.Containers.Vectors is
       --  number of active elements in the container.) We must check whether
       --  the container is busy before doing anything else.
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
 
       --  We now allocate a new internal array, having a length different from
       --  its current value.
@@ -3283,10 +2813,7 @@ package body Ada.Containers.Vectors is
       --  implementation. Logically Reverse_Elements requires a check for
       --  cursor tampering.
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (vector is busy)";
-      end if;
+      TC_Check (Container.TC);
 
       declare
          K : Index_Type;
@@ -3322,7 +2849,7 @@ package body Ada.Containers.Vectors is
       Last : Index_Type'Base;
 
    begin
-      if Position.Container /= null
+      if Checks and then Position.Container /= null
         and then Position.Container /= Container'Unrestricted_Access
       then
          raise Program_Error with "Position cursor denotes wrong container";
@@ -3337,38 +2864,15 @@ package body Ada.Containers.Vectors is
       --  element tampering by a generic actual subprogram.
 
       declare
-         B : Natural renames Container'Unrestricted_Access.Busy;
-         L : Natural renames Container'Unrestricted_Access.Lock;
-
-         Result : Index_Type'Base;
-
+         Lock : With_Lock (Container.TC'Unrestricted_Access);
       begin
-         B := B + 1;
-         L := L + 1;
-
-         Result := No_Index;
          for Indx in reverse Index_Type'First .. Last loop
             if Container.Elements.EA (Indx) = Item then
-               Result := Indx;
-               exit;
+               return Cursor'(Container'Unrestricted_Access, Indx);
             end if;
          end loop;
 
-         B := B - 1;
-         L := L - 1;
-
-         if Result = No_Index then
-            return No_Element;
-         else
-            return Cursor'(Container'Unrestricted_Access, Result);
-         end if;
-
-      exception
-         when others =>
-            B := B - 1;
-            L := L - 1;
-
-            raise;
+         return No_Element;
       end;
    end Reverse_Find;
 
@@ -3381,67 +2885,36 @@ package body Ada.Containers.Vectors is
       Item      : Element_Type;
       Index     : Index_Type := Index_Type'Last) return Extended_Index
    is
-      B : Natural renames Container'Unrestricted_Access.Busy;
-      L : Natural renames Container'Unrestricted_Access.Lock;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      Lock : With_Lock (Container.TC'Unrestricted_Access);
 
       Last : constant Index_Type'Base :=
         Index_Type'Min (Container.Last, Index);
 
-      Result : Index_Type'Base;
-
    begin
-      --  Per AI05-0022, the container implementation is required to detect
-      --  element tampering by a generic actual subprogram.
-
-      B := B + 1;
-      L := L + 1;
-
-      Result := No_Index;
       for Indx in reverse Index_Type'First .. Last loop
          if Container.Elements.EA (Indx) = Item then
-            Result := Indx;
-            exit;
+            return Indx;
          end if;
       end loop;
 
-      B := B - 1;
-      L := L - 1;
-
-      return Result;
-
-   exception
-      when others =>
-         B := B - 1;
-         L := L - 1;
-
-         raise;
+      return No_Index;
    end Reverse_Find_Index;
 
    ---------------------
    -- Reverse_Iterate --
    ---------------------
-
    procedure Reverse_Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor))
    is
-      V : Vector renames Container'Unrestricted_Access.all;
-      B : Natural renames V.Busy;
-
+      Busy : With_Busy (Container.TC'Unrestricted_Access);
    begin
-      B := B + 1;
-
-      begin
-         for Indx in reverse Index_Type'First .. Container.Last loop
-            Process (Cursor'(Container'Unrestricted_Access, Indx));
-         end loop;
-      exception
-         when others =>
-            B := B - 1;
-            raise;
-      end;
-
-      B := B - 1;
+      for Indx in reverse Index_Type'First .. Container.Last loop
+         Process (Cursor'(Container'Unrestricted_Access, Indx));
+      end loop;
    end Reverse_Iterate;
 
    ----------------
@@ -3462,7 +2935,7 @@ package body Ada.Containers.Vectors is
       if Count >= 0 then
          Container.Delete_Last (Count);
 
-      elsif Container.Last >= Index_Type'Last then
+      elsif Checks and then Container.Last >= Index_Type'Last then
          raise Constraint_Error with "vector is already at its maximum length";
 
       else
@@ -3476,22 +2949,21 @@ package body Ada.Containers.Vectors is
 
    procedure Swap (Container : in out Vector; I, J : Index_Type) is
    begin
-      if I > Container.Last then
-         raise Constraint_Error with "I index is out of range";
-      end if;
+      if Checks then
+         if I > Container.Last then
+            raise Constraint_Error with "I index is out of range";
+         end if;
 
-      if J > Container.Last then
-         raise Constraint_Error with "J index is out of range";
+         if J > Container.Last then
+            raise Constraint_Error with "J index is out of range";
+         end if;
       end if;
 
       if I = J then
          return;
       end if;
 
-      if Container.Lock > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (vector is locked)";
-      end if;
+      TE_Check (Container.TC);
 
       declare
          EI_Copy : constant Element_Type := Container.Elements.EA (I);
@@ -3503,21 +2975,22 @@ package body Ada.Containers.Vectors is
 
    procedure Swap (Container : in out Vector; I, J : Cursor) is
    begin
-      if I.Container = null then
-         raise Constraint_Error with "I cursor has no element";
+      if Checks then
+         if I.Container = null then
+            raise Constraint_Error with "I cursor has no element";
 
-      elsif J.Container = null then
-         raise Constraint_Error with "J cursor has no element";
+         elsif J.Container = null then
+            raise Constraint_Error with "J cursor has no element";
 
-      elsif I.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "I cursor denotes wrong container";
+         elsif I.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "I cursor denotes wrong container";
 
-      elsif J.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "J cursor denotes wrong container";
-
-      else
-         Swap (Container, I.Index, J.Index);
+         elsif J.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "J cursor denotes wrong container";
+         end if;
       end if;
+
+      Swap (Container, I.Index, J.Index);
    end Swap;
 
    ---------------
@@ -3585,7 +3058,9 @@ package body Ada.Containers.Vectors is
          --  Which can rewrite as:
          --    No_Index <= Last - Length
 
-         if Index_Type'Base'Last - Index_Type'Base (Length) < No_Index then
+         if Checks and then
+           Index_Type'Base'Last - Index_Type'Base (Length) < No_Index
+         then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3597,7 +3072,7 @@ package body Ada.Containers.Vectors is
          --  Finally we test whether the value is within the range of the
          --  generic actual index subtype:
 
-         if Last > Index_Type'Last then
+         if Checks and then Last > Index_Type'Last then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3609,7 +3084,7 @@ package body Ada.Containers.Vectors is
 
          Index := Count_Type'Base (No_Index) + Length;  -- Last
 
-         if Index > Count_Type'Base (Index_Type'Last) then
+         if Checks and then Index > Count_Type'Base (Index_Type'Last) then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3626,7 +3101,7 @@ package body Ada.Containers.Vectors is
 
          Index := Count_Type'Base (Index_Type'Last) - Length;  -- No_Index
 
-         if Index < Count_Type'Base (No_Index) then
+         if Checks and then Index < Count_Type'Base (No_Index) then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3675,7 +3150,9 @@ package body Ada.Containers.Vectors is
          --  Which can rewrite as:
          --    No_Index <= Last - Length
 
-         if Index_Type'Base'Last - Index_Type'Base (Length) < No_Index then
+         if Checks and then
+           Index_Type'Base'Last - Index_Type'Base (Length) < No_Index
+         then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3687,7 +3164,7 @@ package body Ada.Containers.Vectors is
          --  Finally we test whether the value is within the range of the
          --  generic actual index subtype:
 
-         if Last > Index_Type'Last then
+         if Checks and then Last > Index_Type'Last then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3699,7 +3176,7 @@ package body Ada.Containers.Vectors is
 
          Index := Count_Type'Base (No_Index) + Length;  -- same value as V.Last
 
-         if Index > Count_Type'Base (Index_Type'Last) then
+         if Checks and then Index > Count_Type'Base (Index_Type'Last) then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3716,7 +3193,7 @@ package body Ada.Containers.Vectors is
 
          Index := Count_Type'Base (Index_Type'Last) - Length;  -- No_Index
 
-         if Index < Count_Type'Base (No_Index) then
+         if Checks and then Index < Count_Type'Base (No_Index) then
             raise Constraint_Error with "Length is out of range";
          end if;
 
@@ -3741,28 +3218,13 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type;
       Process   : not null access procedure (Element : in out Element_Type))
    is
-      B : Natural renames Container.Busy;
-      L : Natural renames Container.Lock;
-
+      Lock : With_Lock (Container.TC'Unchecked_Access);
    begin
-      if Index > Container.Last then
+      if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       end if;
 
-      B := B + 1;
-      L := L + 1;
-
-      begin
-         Process (Container.Elements.EA (Index));
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
-
-      L := L - 1;
-      B := B - 1;
+      Process (Container.Elements.EA (Index));
    end Update_Element;
 
    procedure Update_Element
@@ -3771,13 +3233,15 @@ package body Ada.Containers.Vectors is
       Process   : not null access procedure (Element : in out Element_Type))
    is
    begin
-      if Position.Container = null then
-         raise Constraint_Error with "Position cursor has no element";
-      elsif Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor denotes wrong container";
-      else
-         Update_Element (Container, Position.Index, Process);
+      if Checks then
+         if Position.Container = null then
+            raise Constraint_Error with "Position cursor has no element";
+         elsif Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Position cursor denotes wrong container";
+         end if;
       end if;
+
+      Update_Element (Container, Position.Index, Process);
    end Update_Element;
 
    -----------
diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads
index fb801b8aaae..e494386504d 100644
--- a/gcc/ada/a-convec.ads
+++ b/gcc/ada/a-convec.ads
@@ -366,8 +366,10 @@ private
    pragma Inline (Next);
    pragma Inline (Previous);
 
+   package Implementation is new Generic_Implementation;
+   use Implementation;
+
    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 : Extended_Index) is limited record
       EA : Elements_Array (Index_Type'First .. Last);
@@ -375,14 +377,13 @@ private
 
    type Elements_Access is access all Elements_Type;
 
-   use Ada.Finalization;
-   use Ada.Streams;
+   use Finalization;
+   use Streams;
 
    type Vector is new Controlled with record
       Elements : Elements_Access := null;
       Last     : Extended_Index := No_Index;
-      Busy     : Natural := 0;
-      Lock     : Natural := 0;
+      TC       : aliased Tamper_Counts;
    end record;
 
    overriding procedure Adjust (Container : in out Vector);
@@ -420,16 +421,8 @@ private
 
    for Cursor'Write use Write;
 
-   type Reference_Control_Type is
-      new Controlled with record
-         Container : Vector_Access;
-      end record;
-
-   overriding procedure Adjust (Control : in out Reference_Control_Type);
-   pragma Inline (Adjust);
-
-   overriding procedure Finalize (Control : in out Reference_Control_Type);
-   pragma Inline (Finalize);
+   subtype Reference_Control_Type is Implementation.Reference_Control_Type;
+   --  It is necessary to rename this here, so that the compiler can find it
 
    type Constant_Reference_Type
      (Element : not null access constant Element_Type) is
@@ -477,7 +470,7 @@ private
 
    --  Three operations are used to optimize in the expansion of "for ... of"
    --  loops: the Next(Cursor) procedure in the visible part, and the following
-   --  Pseudo_Reference and Get_Element_Access functions. See Sem_Ch5 for
+   --  Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
    --  details.
 
    function Pseudo_Reference
@@ -501,4 +494,25 @@ private
    --  Count_Type'Last as a universal_integer, so we can compare Index_Type
    --  values against this without type conversions that might overflow.
 
+   type Iterator is new Limited_Controlled and
+     Vector_Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : Vector_Access;
+      Index     : Index_Type'Base;
+   end record
+     with Disable_Controlled => not T_Check;
+
+   overriding procedure Finalize (Object : in out Iterator);
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
 end Ada.Containers.Vectors;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 68b201b3d25..2354b988a42 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9840,9 +9840,15 @@ package body Sem_Ch13 is
                          (Parent_Last_Bit,
                           Component_Bit_Offset (Pcomp) + Esize (Pcomp) - 1);
                   end if;
+               else
+
+                  --  Skip anonymous types generated for constrained array
+                  --  or record components.
 
-                  Next_Entity (Pcomp);
+                  null;
                end if;
+
+               Next_Entity (Pcomp);
             end loop;
          end if;
       end;