2011-08-05 Thomas Quinot <quinot@adacore.com>

	* sem_ch11.adb: Add comment.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor comment fix.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* scng.adb (Error_Unterminated_String): Improve flag position when
	comma present.

2011-08-05  Matthew Heaney  <heaney@adacore.com>

	* Makefile.rtl, impunit.adb: Added a-cbmutr.ad[sb] (bounded multiway
	tree containers).
	* a-cbmutr.ads, a-cbmutr.adb: This is the new Ada 2012 unit for bounded
	multiway tree containers.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* styleg.adb (Check_Comment): Implement comment spacing of 1 or 2
	* stylesw.adb: Implement -gnatyC to control comment spacing
	* stylesw.ads (Style_Check_Comments_Spacing): New switch (set by
	-gnatyc/C).
	* usage.adb: Add line for -gnatyC.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Document -gnatyC for J505-006
	* vms_data.ads: Implement COMMENTS1/COMMENTS2 (retaining COMMENTS as a
	synonym for COMMENTS2).



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

14 files changed, 3488 insertions, 28 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c686c29da1b..3ca2a71c1df 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2011-08-05  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch11.adb: Add comment.
+
+2011-08-05  Robert Dewar  <dewar@adacore.com>
+
+	* exp_util.adb: Minor comment fix.
+
+2011-08-05  Robert Dewar  <dewar@adacore.com>
+
+	* scng.adb (Error_Unterminated_String): Improve flag position when
+	comma present.
+
+2011-08-05  Matthew Heaney  <heaney@adacore.com>
+
+	* Makefile.rtl, impunit.adb: Added a-cbmutr.ad[sb] (bounded multiway
+	tree containers).
+	* a-cbmutr.ads, a-cbmutr.adb: This is the new Ada 2012 unit for bounded
+	multiway tree containers.
+
+2011-08-05  Robert Dewar  <dewar@adacore.com>
+
+	* styleg.adb (Check_Comment): Implement comment spacing of 1 or 2
+	* stylesw.adb: Implement -gnatyC to control comment spacing
+	* stylesw.ads (Style_Check_Comments_Spacing): New switch (set by
+	-gnatyc/C).
+	* usage.adb: Add line for -gnatyC.
+
+2011-08-05  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_ugn.texi: Document -gnatyC for J505-006
+	* vms_data.ads: Implement COMMENTS1/COMMENTS2 (retaining COMMENTS as a
+	synonym for COMMENTS2).
+
 2011-08-05  Robert Dewar  <dewar@adacore.com>
 
 	* par_sco.adb, sem_ch3.adb, scos.ads, a-iteint.ads, sem_ch12.adb,
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index cc94f4fd44d..22eb02f18ef 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -90,6 +90,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-cbhase$(objext) \
   a-cborse$(objext) \
   a-cbdlli$(objext) \
+  a-cbmutr$(objext) \
   a-cborma$(objext) \
   a-cdlili$(objext) \
   a-cfdlli$(objext) \
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
new file mode 100644
index 00000000000..6e22e0e8756
--- /dev/null
+++ b/gcc/ada/a-cbmutr.adb
@@ -0,0 +1,3042 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                   ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2004-2011, 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+with System;  use type System.Address;
+
+package body Ada.Containers.Bounded_Multiway_Trees is
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Initialize_Node (Container : in out Tree; Index : Count_Type);
+   procedure Initialize_Root (Container : in out Tree);
+
+   procedure Allocate_Node
+     (Container : in out Tree;
+      New_Item  : Element_Type;
+      New_Node  : out Count_Type);
+
+   procedure Allocate_Node
+     (Container : in out Tree;
+      New_Node  : out Count_Type);
+
+   procedure Allocate_Node
+     (Container : in out Tree;
+      Stream    : not null access Root_Stream_Type'Class;
+      New_Node  : out Count_Type);
+
+   procedure Deallocate_Node
+     (Container : in out Tree;
+      X         : Count_Type);
+
+   procedure Deallocate_Children
+     (Container : in out Tree;
+      Subtree   : Count_Type;
+      Count     : in out Count_Type);
+
+   procedure Deallocate_Subtree
+     (Container : in out Tree;
+      Subtree   : Count_Type;
+      Count     : in out Count_Type);
+
+   function Equal_Children
+     (Left_Tree     : Tree;
+      Left_Subtree  : Count_Type;
+      Right_Tree    : Tree;
+      Right_Subtree : Count_Type) return Boolean;
+
+   function Equal_Subtree
+     (Left_Tree     : Tree;
+      Left_Subtree  : Count_Type;
+      Right_Tree    : Tree;
+      Right_Subtree : Count_Type) return Boolean;
+
+   procedure Iterate_Children
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Process   : not null access procedure (Position : Cursor));
+
+   procedure Iterate_Subtree
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Process   : not null access procedure (Position : Cursor));
+
+   procedure Copy_Children
+     (Source        : Tree;
+      Source_Parent : Count_Type;
+      Target        : in out Tree;
+      Target_Parent : Count_Type;
+      Count         : in out Count_Type);
+
+   procedure Copy_Subtree
+     (Source         : Tree;
+      Source_Subtree : Count_Type;
+      Target         : in out Tree;
+      Target_Parent  : Count_Type;
+      Target_Subtree : out Count_Type;
+      Count          : in out Count_Type);
+
+   function Find_In_Children
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Item      : Element_Type) return Count_Type;
+
+   function Find_In_Subtree
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Item      : Element_Type) return Count_Type;
+
+   function Child_Count
+     (Container : Tree;
+      Parent    : Count_Type) return Count_Type;
+
+   function Subtree_Node_Count
+     (Container : Tree;
+      Subtree   : Count_Type) return Count_Type;
+
+   function Is_Reachable
+     (Container : Tree;
+      From, To  : Count_Type) return Boolean;
+
+   function Root_Node (Container : Tree) return Count_Type;
+
+   procedure Remove_Subtree
+     (Container : in out Tree;
+      Subtree   : Count_Type);
+
+   procedure Insert_Subtree_Node
+     (Container : in out Tree;
+      Subtree   : Count_Type'Base;
+      Parent    : Count_Type;
+      Before    : Count_Type'Base);
+
+   procedure Insert_Subtree_List
+     (Container : in out Tree;
+      First     : Count_Type'Base;
+      Last      : Count_Type'Base;
+      Parent    : Count_Type;
+      Before    : Count_Type'Base);
+
+   procedure Splice_Children
+     (Container     : in out Tree;
+      Target_Parent : Count_Type;
+      Before        : Count_Type'Base;
+      Source_Parent : Count_Type);
+
+   procedure Splice_Children
+     (Target        : in out Tree;
+      Target_Parent : Count_Type;
+      Before        : Count_Type'Base;
+      Source        : in out Tree;
+      Source_Parent : Count_Type);
+
+   procedure Splice_Subtree
+     (Target   : in out Tree;
+      Parent   : Count_Type;
+      Before   : Count_Type'Base;
+      Source   : in out Tree;
+      Position : in out Count_Type);  -- source on input, target on output
+
+   ---------
+   -- "=" --
+   ---------
+
+   function "=" (Left, Right : Tree) return Boolean is
+   begin
+      if Left'Address = Right'Address then
+         return True;
+      end if;
+
+      if Left.Count /= Right.Count then
+         return False;
+      end if;
+
+      if Left.Count = 0 then
+         return True;
+      end if;
+
+      return Equal_Children
+               (Left_Tree     => Left,
+                Left_Subtree  => Root_Node (Left),
+                Right_Tree    => Right,
+                Right_Subtree => Root_Node (Right));
+   end "=";
+
+   -------------------
+   -- Allocate_Node --
+   -------------------
+
+   procedure Allocate_Node
+     (Container : in out Tree;
+      New_Item  : Element_Type;
+      New_Node  : out Count_Type)
+   is
+   begin
+      if Container.Free >= 0 then
+         New_Node := Container.Free;
+
+         --  We always perform the assignment first, before we change container
+         --  state, in order to defend against exceptions duration assignment.
+
+         Container.Elements (New_Node) := New_Item;
+         Container.Free := Container.Nodes (New_Node).Next;
+
+      else
+         --  A negative free store value means that the links of the nodes in
+         --  the free store have not been initialized. In this case, the nodes
+         --  are physically contiguous in the array, starting at the index that
+         --  is the absolute value of the Container.Free, and continuing until
+         --  the end of the array (Nodes'Last).
+
+         New_Node := abs Container.Free;
+
+         --  As above, we perform this assignment first, before modifying any
+         --  container state.
+
+         Container.Elements (New_Node) := New_Item;
+         Container.Free := Container.Free - 1;
+      end if;
+
+      Initialize_Node (Container, New_Node);
+   end Allocate_Node;
+
+   procedure Allocate_Node
+     (Container : in out Tree;
+      Stream    : not null access Root_Stream_Type'Class;
+      New_Node  : out Count_Type)
+   is
+   begin
+      if Container.Free >= 0 then
+         New_Node := Container.Free;
+
+         --  We always perform the assignment first, before we change container
+         --  state, in order to defend against exceptions duration assignment.
+
+         Element_Type'Read (Stream, Container.Elements (New_Node));
+         Container.Free := Container.Nodes (New_Node).Next;
+
+      else
+         --  A negative free store value means that the links of the nodes in
+         --  the free store have not been initialized. In this case, the nodes
+         --  are physically contiguous in the array, starting at the index that
+         --  is the absolute value of the Container.Free, and continuing until
+         --  the end of the array (Nodes'Last).
+
+         New_Node := abs Container.Free;
+
+         --  As above, we perform this assignment first, before modifying any
+         --  container state.
+
+         Element_Type'Read (Stream, Container.Elements (New_Node));
+         Container.Free := Container.Free - 1;
+      end if;
+
+      Initialize_Node (Container, New_Node);
+   end Allocate_Node;
+
+   procedure Allocate_Node
+     (Container : in out Tree;
+      New_Node  : out Count_Type)
+   is
+   begin
+      if Container.Free >= 0 then
+         New_Node := Container.Free;
+         Container.Free := Container.Nodes (New_Node).Next;
+
+      else
+         --  A negative free store value means that the links of the nodes in
+         --  the free store have not been initialized. In this case, the nodes
+         --  are physically contiguous in the array, starting at the index that
+         --  is the absolute value of the Container.Free, and continuing until
+         --  the end of the array (Nodes'Last).
+
+         New_Node := abs Container.Free;
+         Container.Free := Container.Free - 1;
+      end if;
+
+      Initialize_Node (Container, New_Node);
+   end Allocate_Node;
+
+   -------------------
+   -- Ancestor_Find --
+   -------------------
+
+   function Ancestor_Find
+     (Container : Tree;
+      Item      : Element_Type;
+      Position  : Cursor) return Cursor
+   is
+      R : constant Count_Type := Root_Node (Container);
+      N : Count_Type;
+
+   begin
+      if Position = No_Element 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 not in container";
+      end if;
+
+      --  AI-0136 says to raise PE if Position equals the root node. This does
+      --  not seem correct, as this value is just the limiting condition of the
+      --  search. For now we omit this check, pending a ruling from the ARG.
+      --  ???
+      --
+      --  if Is_Root (Position) then
+      --     raise Program_Error with "Position cursor designates root";
+      --  end if;
+
+      N := Position.Node;
+      while N /= R loop
+         if Container.Elements (N) = Item then
+            return Cursor'(Container'Unrestricted_Access, N);
+         end if;
+
+         N := Container.Nodes (N).Parent;
+      end loop;
+
+      return No_Element;
+   end Ancestor_Find;
+
+   ------------------
+   -- Append_Child --
+   ------------------
+
+   procedure Append_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      New_Item  : Element_Type;
+      Count     : Count_Type := 1)
+   is
+      Nodes       : Tree_Node_Array renames Container.Nodes;
+      First, Last : Count_Type;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Count = 0 then
+         return;
+      end if;
+
+      if Container.Count > Container.Capacity - Count then
+         raise Constraint_Error
+           with "requested count exceeds available storage";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Container.Count = 0 then
+         Initialize_Root (Container);
+      end if;
+
+      Allocate_Node (Container, New_Item, First);
+      Nodes (First).Parent := Parent.Node;
+
+      Last := First;
+      for J in Count_Type'(2) .. Count loop
+         Allocate_Node (Container, New_Item, Nodes (Last).Next);
+         Nodes (Nodes (Last).Next).Parent := Parent.Node;
+         Nodes (Nodes (Last).Next).Prev := Last;
+
+         Last := Nodes (Last).Next;
+      end loop;
+
+      Insert_Subtree_List
+        (Container => Container,
+         First     => First,
+         Last      => Last,
+         Parent    => Parent.Node,
+         Before    => -1);  -- means "insert at end of list"
+
+      Container.Count := Container.Count + Count;
+   end Append_Child;
+
+   ------------
+   -- Assign --
+   ------------
+
+   procedure Assign (Target : in out Tree; Source : Tree) is
+      Target_Count : Count_Type;
+
+   begin
+      if Target'Address = Source'Address then
+         return;
+      end if;
+
+      if Target.Capacity < Source.Count then
+         raise Capacity_Error  -- ???
+           with "Target capacity is less than Source count";
+      end if;
+
+      Target.Clear;  -- checks busy bit
+
+      if Source.Count = 0 then
+         return;
+      end if;
+
+      Initialize_Root (Target);
+
+      --  Copy_Children returns the number of nodes that it allocates, but it
+      --  does this by incrementing the count value passed in, so we must
+      --  initialize the count before calling Copy_Children.
+
+      Target_Count := 0;
+
+      Copy_Children
+        (Source        => Source,
+         Source_Parent => Root_Node (Source),
+         Target        => Target,
+         Target_Parent => Root_Node (Target),
+         Count         => Target_Count);
+
+      pragma Assert (Target_Count = Source.Count);
+      Target.Count := Source.Count;
+   end Assign;
+
+   -----------
+   -- Clear --
+   -----------
+
+   procedure Clear (Container : in out Tree) is
+      Container_Count : constant Count_Type := Container.Count;
+      Count           : Count_Type;
+
+   begin
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Container_Count = 0 then
+         return;
+      end if;
+
+      Container.Count := 0;
+
+      --  Deallocate_Children returns the number of nodes that it deallocates,
+      --  but it does this by incrementing the count value that is passed in,
+      --  so we must first initialize the count return value before calling it.
+
+      Count := 0;
+
+      Deallocate_Children
+        (Container => Container,
+         Subtree   => Root_Node (Container),
+         Count     => Count);
+
+      pragma Assert (Count = Container_Count);
+   end Clear;
+
+   --------------
+   -- Contains --
+   --------------
+
+   function Contains
+     (Container : Tree;
+      Item      : Element_Type) return Boolean
+   is
+   begin
+      return Find (Container, Item) /= No_Element;
+   end Contains;
+
+   ----------
+   -- Copy --
+   ----------
+
+   function Copy
+     (Source   : Tree;
+      Capacity : Count_Type := 0) return Tree
+   is
+      C : Count_Type;
+
+   begin
+      if Capacity = 0 then
+         C := Source.Count;
+
+      elsif Capacity >= Source.Count then
+         C := Capacity;
+
+      else
+         raise Capacity_Error with "Capacity value too small";
+      end if;
+
+      return Target : Tree (Capacity => C) do
+         Initialize_Root (Target);
+
+         if Source.Count = 0 then
+            return;
+         end if;
+
+         Copy_Children
+           (Source        => Source,
+            Source_Parent => Root_Node (Source),
+            Target        => Target,
+            Target_Parent => Root_Node (Target),
+            Count         => Target.Count);
+
+         pragma Assert (Target.Count = Source.Count);
+      end return;
+   end Copy;
+
+   -------------------
+   -- Copy_Children --
+   -------------------
+
+   procedure Copy_Children
+     (Source        : Tree;
+      Source_Parent : Count_Type;
+      Target        : in out Tree;
+      Target_Parent : Count_Type;
+      Count         : in out Count_Type)
+   is
+      S_Nodes : Tree_Node_Array renames Source.Nodes;
+      S_Node  : Tree_Node_Type renames S_Nodes (Source_Parent);
+
+      T_Nodes : Tree_Node_Array renames Target.Nodes;
+      T_Node  : Tree_Node_Type renames T_Nodes (Target_Parent);
+
+      pragma Assert (T_Node.Children.First <= 0);
+      pragma Assert (T_Node.Children.Last <= 0);
+
+      T_CC : Children_Type;
+      C    : Count_Type'Base;
+
+   begin
+      --  We special-case the first allocation, in order to establish the
+      --  representation invariants for type Children_Type.
+
+      C := S_Node.Children.First;
+
+      if C <= 0 then  -- source parent has no children
+         return;
+      end if;
+
+      Copy_Subtree
+        (Source         => Source,
+         Source_Subtree => C,
+         Target         => Target,
+         Target_Parent  => Target_Parent,
+         Target_Subtree => T_CC.First,
+         Count          => Count);
+
+      T_CC.Last := T_CC.First;
+
+      --  The representation invariants for the Children_Type list have been
+      --  established, so we can now copy the remaining children of Source.
+
+      C := S_Nodes (C).Next;
+      while C > 0 loop
+         Copy_Subtree
+           (Source         => Source,
+            Source_Subtree => C,
+            Target         => Target,
+            Target_Parent  => Target_Parent,
+            Target_Subtree => T_Nodes (T_CC.Last).Next,
+            Count          => Count);
+
+         T_Nodes (T_Nodes (T_CC.Last).Next).Prev := T_CC.Last;
+         T_CC.Last := T_Nodes (T_CC.Last).Next;
+
+         C := S_Nodes (C).Next;
+      end loop;
+
+      --  We add the newly-allocated children to their parent list only after
+      --  the allocation has succeeded, in order to preserve invariants of the
+      --  parent.
+
+      T_Node.Children := T_CC;
+   end Copy_Children;
+
+   -----------------
+   -- Child_Count --
+   -----------------
+
+   function Child_Count (Parent : Cursor) return Count_Type is
+   begin
+      if Parent = No_Element then
+         return 0;
+      end if;
+
+      if Parent.Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         return 0;
+      end if;
+
+      return Child_Count (Parent.Container.all, Parent.Node);
+   end Child_Count;
+
+   function Child_Count
+     (Container : Tree;
+      Parent    : Count_Type) return Count_Type
+   is
+      NN : Tree_Node_Array renames Container.Nodes;
+      CC : Children_Type renames NN (Parent).Children;
+
+      Result : Count_Type;
+      Node   : Count_Type'Base;
+
+   begin
+      Result := 0;
+      Node := CC.First;
+      while Node > 0 loop
+         Result := Result + 1;
+         Node := NN (Node).Next;
+      end loop;
+
+      return Result;
+   end Child_Count;
+
+   -----------------
+   -- Child_Depth --
+   -----------------
+
+   function Child_Depth (Parent, Child : Cursor) return Count_Type is
+      Result : Count_Type;
+      N      : Count_Type'Base;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Child = No_Element then
+         raise Constraint_Error with "Child cursor has no element";
+      end if;
+
+      if Parent.Container /= Child.Container then
+         raise Program_Error with "Parent and Child in different containers";
+      end if;
+
+      if Parent.Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         pragma Assert (Child = Parent);
+
+         return 0;
+      end if;
+
+      Result := 0;
+      N := Child.Node;
+      while N /= Parent.Node loop
+         Result := Result + 1;
+         N := Parent.Container.Nodes (N).Parent;
+
+         if N < 0 then
+            raise Program_Error with "Parent is not ancestor of Child";
+         end if;
+      end loop;
+
+      return Result;
+   end Child_Depth;
+
+   ------------------
+   -- Copy_Subtree --
+   ------------------
+
+   procedure Copy_Subtree
+     (Target   : in out Tree;
+      Parent   : Cursor;
+      Before   : Cursor;
+      Source   : Cursor)
+   is
+      Target_Subtree : Count_Type;
+      Target_Count   : Count_Type;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Target'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error with "Before cursor not in container";
+         end if;
+
+         if Before.Container.Nodes (Before.Node).Parent /= Parent.Node then
+            raise Constraint_Error with "Before cursor not child of Parent";
+         end if;
+      end if;
+
+      if Source = No_Element then
+         return;
+      end if;
+
+      if Is_Root (Source) then
+         raise Constraint_Error with "Source cursor designates root";
+      end if;
+
+      if Target.Count = 0 then
+         Initialize_Root (Target);
+      end if;
+
+      --  Copy_Subtree returns a count of the number of nodes that it
+      --  allocates, but it works by incrementing the value that is passed
+      --  in. We must therefore initialize the count value before calling
+      --  Copy_Subtree.
+
+      Target_Count := 0;
+
+      Copy_Subtree
+        (Source         => Source.Container.all,
+         Source_Subtree => Source.Node,
+         Target         => Target,
+         Target_Parent  => Parent.Node,
+         Target_Subtree => Target_Subtree,
+         Count          => Target_Count);
+
+      Insert_Subtree_Node
+        (Container => Target,
+         Subtree   => Target_Subtree,
+         Parent    => Parent.Node,
+         Before    => Before.Node);
+
+      Target.Count := Target.Count + Target_Count;
+   end Copy_Subtree;
+
+   procedure Copy_Subtree
+     (Source         : Tree;
+      Source_Subtree : Count_Type;
+      Target         : in out Tree;
+      Target_Parent  : Count_Type;
+      Target_Subtree : out Count_Type;
+      Count          : in out Count_Type)
+   is
+      T_Nodes : Tree_Node_Array renames Target.Nodes;
+
+   begin
+      --  First we allocate the root of the target subtree.
+
+      Allocate_Node
+        (Container => Target,
+         New_Item  => Source.Elements (Source_Subtree),
+         New_Node  => Target_Subtree);
+
+      T_Nodes (Target_Subtree).Parent := Target_Parent;
+      Count := Count + 1;
+
+      --  We now have a new subtree (for the Target tree), containing only a
+      --  copy of the corresponding element in the Source subtree. Next we copy
+      --  the children of the Source subtree as children of the new Target
+      --  subtree.
+
+      Copy_Children
+        (Source        => Source,
+         Source_Parent => Source_Subtree,
+         Target        => Target,
+         Target_Parent => Target_Subtree,
+         Count         => Count);
+   end Copy_Subtree;
+
+   -------------------------
+   -- Deallocate_Children --
+   -------------------------
+
+   procedure Deallocate_Children
+     (Container : in out Tree;
+      Subtree   : Count_Type;
+      Count     : in out Count_Type)
+   is
+      Nodes : Tree_Node_Array renames Container.Nodes;
+      Node  : Tree_Node_Type renames Nodes (Subtree);  -- parent
+      CC    : Children_Type renames Node.Children;
+      C     : Count_Type'Base;
+
+   begin
+      while CC.First > 0 loop
+         C := CC.First;
+         CC.First := Nodes (C).Next;
+
+         Deallocate_Subtree (Container, C, Count);
+      end loop;
+
+      CC.Last := 0;
+   end Deallocate_Children;
+
+   ---------------------
+   -- Deallocate_Node --
+   ---------------------
+
+   procedure Deallocate_Node
+     (Container : in out Tree;
+      X         : Count_Type)
+   is
+      NN : Tree_Node_Array renames Container.Nodes;
+      pragma Assert (X > 0);
+      pragma Assert (X <= NN'Last);
+
+      N : Tree_Node_Type renames NN (X);
+      pragma Assert (N.Parent /= X);  -- node is active
+
+   begin
+      --  The tree container actually contains two lists: one for the "active"
+      --  nodes that contain elements that have been inserted onto the tree,
+      --  and another for the "inactive" nodes of the free store, from which
+      --  nodes are allocated when a new child is inserted in the tree.
+      --
+      --  We desire that merely declaring a tree object should have only
+      --  minimal cost; specially, we want to avoid having to initialize the
+      --  free store (to fill in the links), especially if the capacity of the
+      --  tree object is large.
+      --
+      --  The head of the free list is indicated by Container.Free. If its
+      --  value is non-negative, then the free store has been initialized in
+      --  the "normal" way: Container.Free points to the head of the list of
+      --  free (inactive) nodes, and the value 0 means the free list is
+      --  empty. Each node on the free list has been initialized to point to
+      --  the next free node (via its Next component), and the value -1 means
+      --  that this is the last free node.
+      --
+      --  If Container.Free is negative, then the links on the free store have
+      --  not been initialized. In this case the link values are implied: the
+      --  free store comprises the components of the node array started with
+      --  the absolute value of Container.Free, and continuing until the end of
+      --  the array (Nodes'Last).
+      --
+      --  We prefer to lazy-init the free store (in fact, we would prefer to
+      --  not initialize it at all). The time when we need to actually
+      --  initialize the nodes in the free store is if the node that becomes
+      --  inactive is not at the end of the active list. The free store would
+      --  then be discontigous and so its nodes would need to be linked in the
+      --  traditional way.
+      --
+      --  It might be possible to perform an optimization here. Suppose that
+      --  the free store can be represented as having two parts: one comprising
+      --  the non-contiguous inactive nodes linked together in the normal way,
+      --  and the other comprising the contiguous inactive nodes (that are not
+      --  linked together, at the end of the nodes array). This would allow us
+      --  to never have to initialize the free store, except in a lazy way as
+      --  nodes become inactive. ???
+
+      --  When an element is deleted from the list container, its node becomes
+      --  inactive, and so we set its Prev component to a negative value, to
+      --  indicate that it is now inactive. This provides a useful way to
+      --  detect a dangling cursor reference.
+
+      N.Parent := X;  -- Node is deallocated (not on active list)
+      N.Prev := X;
+
+      if Container.Free >= 0 then
+         --  The free store has previously been initialized. All we need to
+         --  do here is link the newly-free'd node onto the free list.
+
+         N.Next := Container.Free;
+         Container.Free := X;
+
+      elsif X + 1 = abs Container.Free then
+         --  The free store has not been initialized, and the node becoming
+         --  inactive immediately precedes the start of the free store. All
+         --  we need to do is move the start of the free store back by one.
+
+         N.Next := -1;  -- Not strictly necessary, but marginally safer
+         Container.Free := Container.Free + 1;
+
+      else
+         --  The free store has not been initialized, and the node becoming
+         --  inactive does not immediately precede the free store. Here we
+         --  first initialize the free store (meaning the links are given
+         --  values in the traditional way), and then link the newly-free'd
+         --  node onto the head of the free store.
+
+         --  See the comments above for an optimization opportunity. If the
+         --  next link for a node on the free store is negative, then this
+         --  means the remaining nodes on the free store are physically
+         --  contiguous, starting as the absolute value of that index
+         --  value. ???
+
+         Container.Free := abs Container.Free;
+
+         if Container.Free > Container.Capacity then
+            Container.Free := 0;
+
+         else
+            for J in Container.Free .. Container.Capacity - 1 loop
+               NN (J).Next := J + 1;
+            end loop;
+
+            NN (Container.Capacity).Next := -1;
+         end if;
+
+         NN (X).Next := Container.Free;
+         Container.Free := X;
+      end if;
+   end Deallocate_Node;
+
+   ------------------------
+   -- Deallocate_Subtree --
+   ------------------------
+
+   procedure Deallocate_Subtree
+     (Container : in out Tree;
+      Subtree   : Count_Type;
+      Count     : in out Count_Type)
+   is
+   begin
+      Deallocate_Children (Container, Subtree, Count);
+      Deallocate_Node (Container, Subtree);
+      Count := Count + 1;
+   end Deallocate_Subtree;
+
+   ---------------------
+   -- Delete_Children --
+   ---------------------
+
+   procedure Delete_Children
+     (Container : in out Tree;
+      Parent    : Cursor)
+   is
+      Count : Count_Type;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         return;
+      end if;
+
+      --  Deallocate_Children returns a count of the number of nodes that it
+      --  deallocates, but it works by incrementing the value that is passed
+      --  in. We must therefore initialize the count value before calling
+      --  Deallocate_Children.
+
+      Count := 0;
+
+      Deallocate_Children (Container, Parent.Node, Count);
+      pragma Assert (Count <= Container.Count);
+
+      Container.Count := Container.Count - Count;
+   end Delete_Children;
+
+   -----------------
+   -- Delete_Leaf --
+   -----------------
+
+   procedure Delete_Leaf
+     (Container : in out Tree;
+      Position  : in out Cursor)
+   is
+      X : Count_Type;
+
+   begin
+      if Position = No_Element 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 not in container";
+      end if;
+
+      if Is_Root (Position) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      if not Is_Leaf (Position) then
+         raise Constraint_Error with "Position cursor does not designate leaf";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      X := Position.Node;
+      Position := No_Element;
+
+      Remove_Subtree (Container, X);
+      Container.Count := Container.Count - 1;
+
+      Deallocate_Node (Container, X);
+   end Delete_Leaf;
+
+   --------------------
+   -- Delete_Subtree --
+   --------------------
+
+   procedure Delete_Subtree
+     (Container : in out Tree;
+      Position  : in out Cursor)
+   is
+      X     : Count_Type;
+      Count : Count_Type;
+
+   begin
+      if Position = No_Element 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 not in container";
+      end if;
+
+      if Is_Root (Position) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      X := Position.Node;
+      Position := No_Element;
+
+      Remove_Subtree (Container, X);
+
+      --  Deallocate_Subtree returns a count of the number of nodes that it
+      --  deallocates, but it works by incrementing the value that is passed
+      --  in. We must therefore initialize the count value before calling
+      --  Deallocate_Subtree.
+
+      Count := 0;
+
+      Deallocate_Subtree (Container, X, Count);
+      pragma Assert (Count <= Container.Count);
+
+      Container.Count := Container.Count - Count;
+   end Delete_Subtree;
+
+   -----------
+   -- Depth --
+   -----------
+
+   function Depth (Position : Cursor) return Count_Type is
+      Result : Count_Type;
+      N      : Count_Type'Base;
+
+   begin
+      if Position = No_Element then
+         return 0;
+      end if;
+
+      if Is_Root (Position) then
+         return 1;
+      end if;
+
+      Result := 0;
+      N := Position.Node;
+      while N >= 0 loop
+         N := Position.Container.Nodes (N).Parent;
+         Result := Result + 1;
+      end loop;
+
+      return Result;
+   end Depth;
+
+   -------------
+   -- Element --
+   -------------
+
+   function Element (Position : Cursor) return Element_Type is
+   begin
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Node = Root_Node (Position.Container.all) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      return Position.Container.Elements (Position.Node);
+   end Element;
+
+   --------------------
+   -- Equal_Children --
+   --------------------
+
+   function Equal_Children
+     (Left_Tree     : Tree;
+      Left_Subtree  : Count_Type;
+      Right_Tree    : Tree;
+      Right_Subtree : Count_Type) return Boolean
+   is
+      L_NN : Tree_Node_Array renames Left_Tree.Nodes;
+      R_NN : Tree_Node_Array renames Right_Tree.Nodes;
+
+      Left_Children  : Children_Type renames L_NN (Left_Subtree).Children;
+      Right_Children : Children_Type renames R_NN (Right_Subtree).Children;
+
+      L, R : Count_Type'Base;
+
+   begin
+      if Child_Count (Left_Tree, Left_Subtree)
+        /= Child_Count (Right_Tree, Right_Subtree)
+      then
+         return False;
+      end if;
+
+      L := Left_Children.First;
+      R := Right_Children.First;
+      while L > 0 loop
+         if not Equal_Subtree (Left_Tree, L, Right_Tree, R) then
+            return False;
+         end if;
+
+         L := L_NN (L).Next;
+         R := R_NN (R).Next;
+      end loop;
+
+      return True;
+   end Equal_Children;
+
+   -------------------
+   -- Equal_Subtree --
+   -------------------
+
+   function Equal_Subtree
+     (Left_Position  : Cursor;
+      Right_Position : Cursor) return Boolean
+   is
+   begin
+      if Left_Position = No_Element then
+         raise Constraint_Error with "Left cursor has no element";
+      end if;
+
+      if Right_Position = No_Element then
+         raise Constraint_Error with "Right cursor has no element";
+      end if;
+
+      if Left_Position = Right_Position then
+         return True;
+      end if;
+
+      if Is_Root (Left_Position) then
+         if not Is_Root (Right_Position) then
+            return False;
+         end if;
+
+         if Left_Position.Container.Count = 0 then
+            return Right_Position.Container.Count = 0;
+         end if;
+
+         if Right_Position.Container.Count = 0 then
+            return False;
+         end if;
+
+         return Equal_Children
+                  (Left_Tree     => Left_Position.Container.all,
+                   Left_Subtree  => Left_Position.Node,
+                   Right_Tree    => Right_Position.Container.all,
+                   Right_Subtree => Right_Position.Node);
+      end if;
+
+      if Is_Root (Right_Position) then
+         return False;
+      end if;
+
+      return Equal_Subtree
+               (Left_Tree     => Left_Position.Container.all,
+                Left_Subtree  => Left_Position.Node,
+                Right_Tree    => Right_Position.Container.all,
+                Right_Subtree => Right_Position.Node);
+   end Equal_Subtree;
+
+   function Equal_Subtree
+     (Left_Tree     : Tree;
+      Left_Subtree  : Count_Type;
+      Right_Tree    : Tree;
+      Right_Subtree : Count_Type) return Boolean
+   is
+   begin
+      if Left_Tree.Elements (Left_Subtree)
+        /= Right_Tree.Elements (Right_Subtree)
+      then
+         return False;
+      end if;
+
+      return Equal_Children
+               (Left_Tree     => Left_Tree,
+                Left_Subtree  => Left_Subtree,
+                Right_Tree    => Right_Tree,
+                Right_Subtree => Right_Subtree);
+   end Equal_Subtree;
+
+   ----------
+   -- Find --
+   ----------
+
+   function Find
+     (Container : Tree;
+      Item      : Element_Type) return Cursor
+   is
+      Node : Count_Type;
+
+   begin
+      if Container.Count = 0 then
+         return No_Element;
+      end if;
+
+      Node := Find_In_Children (Container, Root_Node (Container), Item);
+
+      if Node = 0 then
+         return No_Element;
+      end if;
+
+      return Cursor'(Container'Unrestricted_Access, Node);
+   end Find;
+
+   -----------------
+   -- First_Child --
+   -----------------
+
+   function First_Child (Parent : Cursor) return Cursor is
+      Node : Count_Type'Base;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         return No_Element;
+      end if;
+
+      Node := Parent.Container.Nodes (Parent.Node).Children.First;
+
+      if Node <= 0 then
+         return No_Element;
+      end if;
+
+      return Cursor'(Parent.Container, Node);
+   end First_Child;
+
+   -------------------------
+   -- First_Child_Element --
+   -------------------------
+
+   function First_Child_Element (Parent : Cursor) return Element_Type is
+   begin
+      return Element (First_Child (Parent));
+   end First_Child_Element;
+
+   ----------------------
+   -- Find_In_Children --
+   ----------------------
+
+   function Find_In_Children
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Item      : Element_Type) return Count_Type
+   is
+      N      : Count_Type'Base;
+      Result : Count_Type;
+
+   begin
+      N := Container.Nodes (Subtree).Children.First;
+      while N > 0 loop
+         Result := Find_In_Subtree (Container, N, Item);
+
+         if Result > 0 then
+            return Result;
+         end if;
+
+         N := Container.Nodes (N).Next;
+      end loop;
+
+      return 0;
+   end Find_In_Children;
+
+   ---------------------
+   -- Find_In_Subtree --
+   ---------------------
+
+   function Find_In_Subtree
+     (Container : Tree;
+      Item      : Element_Type;
+      Position  : Cursor) return Cursor
+   is
+      Result : Count_Type;
+
+   begin
+      if Position = No_Element 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 not in container";
+      end if;
+
+      if Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return No_Element;
+      end if;
+
+      if Is_Root (Position) then
+         Result := Find_In_Children (Container, Position.Node, Item);
+
+      else
+         Result := Find_In_Subtree (Container, Position.Node, Item);
+      end if;
+
+      if Result = 0 then
+         return No_Element;
+      end if;
+
+      return Cursor'(Container'Unrestricted_Access, Result);
+   end Find_In_Subtree;
+
+   function Find_In_Subtree
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Item      : Element_Type) return Count_Type
+   is
+   begin
+      if Container.Elements (Subtree) = Item then
+         return Subtree;
+      end if;
+
+      return Find_In_Children (Container, Subtree, Item);
+   end Find_In_Subtree;
+
+   -----------------
+   -- Has_Element --
+   -----------------
+
+   function Has_Element (Position : Cursor) return Boolean is
+   begin
+      if Position = No_Element then
+         return False;
+      end if;
+
+      return Position.Node /= Root_Node (Position.Container.all);
+   end Has_Element;
+
+   ---------------------
+   -- Initialize_Node --
+   ---------------------
+
+   procedure Initialize_Node
+     (Container : in out Tree;
+      Index     : Count_Type)
+   is
+   begin
+      Container.Nodes (Index) :=
+        (Parent   => -1,
+         Prev     => 0,
+         Next     => 0,
+         Children => (others => 0));
+   end Initialize_Node;
+
+   ---------------------
+   -- Initialize_Root --
+   ---------------------
+
+   procedure Initialize_Root (Container : in out Tree) is
+   begin
+      Initialize_Node (Container, Root_Node (Container));
+   end Initialize_Root;
+
+   ------------------
+   -- Insert_Child --
+   ------------------
+
+   procedure Insert_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      New_Item  : Element_Type;
+      Count     : Count_Type := 1)
+   is
+      Position : Cursor;
+      pragma Unreferenced (Position);
+
+   begin
+      Insert_Child (Container, Parent, Before, New_Item, Position, Count);
+   end Insert_Child;
+
+   procedure Insert_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      New_Item  : Element_Type;
+      Position  : out Cursor;
+      Count     : Count_Type := 1)
+   is
+      Nodes : Tree_Node_Array renames Container.Nodes;
+      Last  : Count_Type;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Before cursor not in container";
+         end if;
+
+         if Before.Container.Nodes (Before.Node).Parent /= Parent.Node then
+            raise Constraint_Error with "Parent cursor not parent of Before";
+         end if;
+      end if;
+
+      if Count = 0 then
+         Position := No_Element;  -- Need ruling from ARG ???
+         return;
+      end if;
+
+      if Container.Count > Container.Capacity - Count then
+         raise Constraint_Error
+           with "requested count exceeds available storage";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Container.Count = 0 then
+         Initialize_Root (Container);
+      end if;
+
+      Allocate_Node (Container, New_Item, Position.Node);
+      Nodes (Position.Node).Parent := Parent.Node;
+
+      Last := Position.Node;
+      for J in Count_Type'(2) .. Count loop
+         Allocate_Node (Container, New_Item, Nodes (Last).Next);
+         Nodes (Nodes (Last).Next).Parent := Parent.Node;
+         Nodes (Nodes (Last).Next).Prev := Last;
+
+         Last := Nodes (Last).Next;
+      end loop;
+
+      Insert_Subtree_List
+        (Container => Container,
+         First     => Position.Node,
+         Last      => Last,
+         Parent    => Parent.Node,
+         Before    => Before.Node);
+
+      Container.Count := Container.Count + Count;
+
+      Position.Container := Parent.Container;
+   end Insert_Child;
+
+   procedure Insert_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      Position  : out Cursor;
+      Count     : Count_Type := 1)
+   is
+      Nodes : Tree_Node_Array renames Container.Nodes;
+      Last  : Count_Type;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Before cursor not in container";
+         end if;
+
+         if Before.Container.Nodes (Before.Node).Parent /= Parent.Node then
+            raise Constraint_Error with "Parent cursor not parent of Before";
+         end if;
+      end if;
+
+      if Count = 0 then
+         Position := No_Element;  -- Need ruling from ARG  ???
+         return;
+      end if;
+
+      if Container.Count > Container.Capacity - Count then
+         raise Constraint_Error
+           with "requested count exceeds available storage";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Container.Count = 0 then
+         Initialize_Root (Container);
+      end if;
+
+      Allocate_Node (Container, Position.Node);
+      Nodes (Position.Node).Parent := Parent.Node;
+
+      Last := Position.Node;
+      for J in Count_Type'(2) .. Count loop
+         Allocate_Node (Container, Nodes (Last).Next);
+         Nodes (Nodes (Last).Next).Parent := Parent.Node;
+         Nodes (Nodes (Last).Next).Prev := Last;
+
+         Last := Nodes (Last).Next;
+      end loop;
+
+      Insert_Subtree_List
+        (Container => Container,
+         First     => Position.Node,
+         Last      => Last,
+         Parent    => Parent.Node,
+         Before    => Before.Node);
+
+      Container.Count := Container.Count + Count;
+
+      Position.Container := Parent.Container;
+   end Insert_Child;
+
+   -------------------------
+   -- Insert_Subtree_List --
+   -------------------------
+
+   procedure Insert_Subtree_List
+     (Container : in out Tree;
+      First     : Count_Type'Base;
+      Last      : Count_Type'Base;
+      Parent    : Count_Type;
+      Before    : Count_Type'Base)
+   is
+      NN : Tree_Node_Array renames Container.Nodes;
+      N  : Tree_Node_Type renames NN (Parent);
+      CC : Children_Type renames N.Children;
+
+   begin
+      --  This is a simple utility operation to insert a list of nodes
+      --  (First..Last) as children of Parent. The Before node specifies where
+      --  the new children should be inserted relative to the existing
+      --  children.
+
+      if First <= 0 then
+         pragma Assert (Last <= 0);
+         return;
+      end if;
+
+      pragma Assert (Last > 0);
+      pragma Assert (Before <= 0 or else NN (Before).Parent = Parent);
+
+      if CC.First <= 0 then  -- no existing children
+         CC.First := First;
+         NN (CC.First).Prev := 0;
+         CC.Last := Last;
+         NN (CC.Last).Next := 0;
+
+      elsif Before <= 0 then  -- means "insert after existing nodes"
+         NN (CC.Last).Next := First;
+         NN (First).Prev := CC.Last;
+         CC.Last := Last;
+         NN (CC.Last).Next := 0;
+
+      elsif Before = CC.First then
+         NN (Last).Next := CC.First;
+         NN (CC.First).Prev := Last;
+         CC.First := First;
+         NN (CC.First).Prev := 0;
+
+      else
+         NN (NN (Before).Prev).Next := First;
+         NN (First).Prev := NN (Before).Prev;
+         NN (Last).Next := Before;
+         NN (Before).Prev := Last;
+      end if;
+   end Insert_Subtree_List;
+
+   -------------------------
+   -- Insert_Subtree_Node --
+   -------------------------
+
+   procedure Insert_Subtree_Node
+     (Container : in out Tree;
+      Subtree   : Count_Type'Base;
+      Parent    : Count_Type;
+      Before    : Count_Type'Base)
+   is
+   begin
+      --  This is a simple wrapper operation to insert a single child into the
+      --  Parent's children list.
+
+      Insert_Subtree_List
+        (Container => Container,
+         First     => Subtree,
+         Last      => Subtree,
+         Parent    => Parent,
+         Before    => Before);
+   end Insert_Subtree_Node;
+
+   --------------
+   -- Is_Empty --
+   --------------
+
+   function Is_Empty (Container : Tree) return Boolean is
+   begin
+      return Container.Count = 0;
+   end Is_Empty;
+
+   -------------
+   -- Is_Leaf --
+   -------------
+
+   function Is_Leaf (Position : Cursor) return Boolean is
+   begin
+      if Position = No_Element then
+         return False;
+      end if;
+
+      if Position.Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return True;
+      end if;
+
+      return Position.Container.Nodes (Position.Node).Children.First <= 0;
+   end Is_Leaf;
+
+   ------------------
+   -- Is_Reachable --
+   ------------------
+
+   function Is_Reachable
+     (Container : Tree;
+      From, To  : Count_Type) return Boolean
+   is
+      Idx : Count_Type;
+
+   begin
+      Idx := From;
+      while Idx >= 0 loop
+         if Idx = To then
+            return True;
+         end if;
+
+         Idx := Container.Nodes (Idx).Parent;
+      end loop;
+
+      return False;
+   end Is_Reachable;
+
+   -------------
+   -- Is_Root --
+   -------------
+
+   function Is_Root (Position : Cursor) return Boolean is
+   begin
+      if Position.Container = null then
+         return False;
+      end if;
+
+      return Position.Node = Root_Node (Position.Container.all);
+   end Is_Root;
+
+   -------------
+   -- Iterate --
+   -------------
+
+   procedure Iterate
+     (Container : Tree;
+      Process   : not null access procedure (Position : Cursor))
+   is
+      T : Tree renames Container'Unrestricted_Access.all;
+      B : Integer renames T.Busy;
+
+   begin
+      if Container.Count = 0 then
+         return;
+      end if;
+
+      B := B + 1;
+
+      Iterate_Children
+        (Container => Container,
+         Subtree   => Root_Node (Container),
+         Process   => Process);
+
+      B := B - 1;
+
+   exception
+      when others =>
+         B := B - 1;
+         raise;
+   end Iterate;
+
+   ----------------------
+   -- Iterate_Children --
+   ----------------------
+
+   procedure Iterate_Children
+     (Parent  : Cursor;
+      Process : not null access procedure (Position : Cursor))
+   is
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         return;
+      end if;
+
+      declare
+         NN : Tree_Node_Array renames Parent.Container.Nodes;
+         B  : Integer renames Parent.Container.Busy;
+         C  : Count_Type;
+
+      begin
+         B := B + 1;
+
+         C := NN (Parent.Node).Children.First;
+         while C > 0 loop
+            Process (Cursor'(Parent.Container, Node => C));
+            C := NN (C).Next;
+         end loop;
+
+         B := B - 1;
+
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+   end Iterate_Children;
+
+   procedure Iterate_Children
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Process   : not null access procedure (Position : Cursor))
+   is
+      NN : Tree_Node_Array renames Container.Nodes;
+      N  : Tree_Node_Type renames NN (Subtree);
+      C  : Count_Type;
+
+   begin
+      --  This is a helper function to recursively iterate over all the nodes
+      --  in a subtree, in depth-first fashion. This particular helper just
+      --  visits the children of this subtree, not the root of the subtree
+      --  itself. This is useful when starting from the ultimate root of the
+      --  entire tree (see Iterate), as that root does not have an element.
+
+      C := N.Children.First;
+      while C > 0 loop
+         Iterate_Subtree (Container, C, Process);
+         C := NN (C).Next;
+      end loop;
+   end Iterate_Children;
+
+   ---------------------
+   -- Iterate_Subtree --
+   ---------------------
+
+   procedure Iterate_Subtree
+     (Position  : Cursor;
+      Process   : not null access procedure (Position : Cursor))
+   is
+   begin
+      if Position = No_Element then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return;
+      end if;
+
+      declare
+         T : Tree renames Position.Container.all;
+         B : Integer renames T.Busy;
+
+      begin
+         B := B + 1;
+
+         if Is_Root (Position) then
+            Iterate_Children (T, Position.Node, Process);
+
+         else
+            Iterate_Subtree (T, Position.Node, Process);
+         end if;
+
+         B := B - 1;
+
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+   end Iterate_Subtree;
+
+   procedure Iterate_Subtree
+     (Container : Tree;
+      Subtree   : Count_Type;
+      Process   : not null access procedure (Position : Cursor))
+   is
+   begin
+      --  This is a helper function to recursively iterate over all the nodes
+      --  in a subtree, in depth-first fashion. It first visits the root of the
+      --  subtree, then visits its children.
+
+      Process (Cursor'(Container'Unrestricted_Access, Subtree));
+      Iterate_Children (Container, Subtree, Process);
+   end Iterate_Subtree;
+
+   ----------------
+   -- Last_Child --
+   ----------------
+
+   function Last_Child (Parent : Cursor) return Cursor is
+      Node : Count_Type'Base;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         return No_Element;
+      end if;
+
+      Node := Parent.Container.Nodes (Parent.Node).Children.Last;
+
+      if Node <= 0 then
+         return No_Element;
+      end if;
+
+      return Cursor'(Parent.Container, Node);
+   end Last_Child;
+
+   ------------------------
+   -- Last_Child_Element --
+   ------------------------
+
+   function Last_Child_Element (Parent : Cursor) return Element_Type is
+   begin
+      return Element (Last_Child (Parent));
+   end Last_Child_Element;
+
+   ----------
+   -- Move --
+   ----------
+
+   procedure Move (Target : in out Tree; Source : in out Tree) is
+   begin
+      if Target'Address = Source'Address then
+         return;
+      end if;
+
+      if Source.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors of Source (tree is busy)";
+      end if;
+
+      Target.Assign (Source);
+      Source.Clear;
+   end Move;
+
+   ------------------
+   -- Next_Sibling --
+   ------------------
+
+   function Next_Sibling (Position : Cursor) return Cursor is
+   begin
+      if Position = No_Element then
+         return No_Element;
+      end if;
+
+      if Position.Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return No_Element;
+      end if;
+
+      declare
+         T  : Tree renames Position.Container.all;
+         NN : Tree_Node_Array renames T.Nodes;
+         N  : Tree_Node_Type renames NN (Position.Node);
+
+      begin
+         if N.Next <= 0 then
+            return No_Element;
+         end if;
+
+         return Cursor'(Position.Container, N.Next);
+      end;
+   end Next_Sibling;
+
+   procedure Next_Sibling (Position : in out Cursor) is
+   begin
+      Position := Next_Sibling (Position);
+   end Next_Sibling;
+
+   ----------------
+   -- Node_Count --
+   ----------------
+
+   function Node_Count (Container : Tree) return Count_Type is
+   begin
+      --  Container.Count is the number of nodes we have actually allocated. We
+      --  cache the value specifically so this Node_Count operation can execute
+      --  in O(1) time, which makes it behave similarly to how the Length
+      --  selector function behaves for other containers.
+      --
+      --  The cached node count value only describes the nodes we have
+      --  allocated; the root node itself is not included in that count. The
+      --  Node_Count operation returns a value that includes the root node
+      --  (because the RM says so), so we must add 1 to our cached value.
+
+      return 1 + Container.Count;
+   end Node_Count;
+
+   ------------
+   -- Parent --
+   ------------
+
+   function Parent (Position : Cursor) return Cursor is
+   begin
+      if Position = No_Element then
+         return No_Element;
+      end if;
+
+      if Position.Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return No_Element;
+      end if;
+
+      declare
+         T  : Tree renames Position.Container.all;
+         NN : Tree_Node_Array renames T.Nodes;
+         N  : Tree_Node_Type renames NN (Position.Node);
+
+      begin
+         if N.Parent < 0 then
+            pragma Assert (Position.Node = Root_Node (T));
+            return No_Element;
+         end if;
+
+         return Cursor'(Position.Container, N.Parent);
+      end;
+   end Parent;
+
+   -------------------
+   -- Prepend_Child --
+   -------------------
+
+   procedure Prepend_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      New_Item  : Element_Type;
+      Count     : Count_Type := 1)
+   is
+      Nodes       : Tree_Node_Array renames Container.Nodes;
+      First, Last : Count_Type;
+
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Count = 0 then
+         return;
+      end if;
+
+      if Container.Count > Container.Capacity - Count then
+         raise Constraint_Error
+           with "requested count exceeds available storage";
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Container.Count = 0 then
+         Initialize_Root (Container);
+      end if;
+
+      Allocate_Node (Container, New_Item, First);
+      Nodes (First).Parent := Parent.Node;
+
+      Last := First;
+      for J in Count_Type'(2) .. Count loop
+         Allocate_Node (Container, New_Item, Nodes (Last).Next);
+         Nodes (Nodes (Last).Next).Parent := Parent.Node;
+         Nodes (Nodes (Last).Next).Prev := Last;
+
+         Last := Nodes (Last).Next;
+      end loop;
+
+      Insert_Subtree_List
+        (Container => Container,
+         First     => First,
+         Last      => Last,
+         Parent    => Parent.Node,
+         Before    => Nodes (Parent.Node).Children.First);
+
+      Container.Count := Container.Count + Count;
+   end Prepend_Child;
+
+   ----------------------
+   -- Previous_Sibling --
+   ----------------------
+
+   function Previous_Sibling (Position : Cursor) return Cursor is
+   begin
+      if Position = No_Element then
+         return No_Element;
+      end if;
+
+      if Position.Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return No_Element;
+      end if;
+
+      declare
+         T  : Tree renames Position.Container.all;
+         NN : Tree_Node_Array renames T.Nodes;
+         N  : Tree_Node_Type renames NN (Position.Node);
+
+      begin
+         if N.Prev <= 0 then
+            return No_Element;
+         end if;
+
+         return Cursor'(Position.Container, N.Prev);
+      end;
+   end Previous_Sibling;
+
+   procedure Previous_Sibling (Position : in out Cursor) is
+   begin
+      Position := Previous_Sibling (Position);
+   end Previous_Sibling;
+
+   -------------------
+   -- Query_Element --
+   -------------------
+
+   procedure Query_Element
+     (Position : Cursor;
+      Process  : not null access procedure (Element : Element_Type))
+   is
+   begin
+      if Position = No_Element then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Is_Root (Position) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      declare
+         T : Tree renames Position.Container.all'Unrestricted_Access.all;
+         B : Integer renames T.Busy;
+         L : Integer renames T.Lock;
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Process (Element => T.Elements (Position.Node));
+
+         L := L - 1;
+         B := B - 1;
+
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+   end Query_Element;
+
+   ----------
+   -- Read --
+   ----------
+
+   procedure Read
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : out Tree)
+   is
+      procedure Read_Children (Subtree : Count_Type);
+
+      function Read_Subtree
+        (Parent : Count_Type) return Count_Type;
+
+      NN : Tree_Node_Array renames Container.Nodes;
+
+      Total_Count, Read_Count : Count_Type;
+
+      -------------------
+      -- Read_Children --
+      -------------------
+
+      procedure Read_Children (Subtree : Count_Type) is
+         Count : Count_Type;  -- number of child subtrees
+         CC    : Children_Type;
+
+      begin
+         Count_Type'Read (Stream, Count);
+
+         if not Count'Valid then  -- Is this check necessary???
+            raise Program_Error with "attempt to read from corrupt stream";
+         end if;
+
+         if Count = 0 then
+            return;
+         end if;
+
+         CC.First := Read_Subtree (Parent => Subtree);
+         CC.Last := CC.First;
+
+         for J in Count_Type'(2) .. Count loop
+            NN (CC.Last).Next := Read_Subtree (Parent => Subtree);
+            NN (NN (CC.Last).Next).Prev := CC.Last;
+            CC.Last := NN (CC.Last).Next;
+         end loop;
+
+         --  Now that the allocation and reads have completed successfully, it
+         --  is safe to link the children to their parent.
+
+         NN (Subtree).Children := CC;
+      end Read_Children;
+
+      ------------------
+      -- Read_Subtree --
+      ------------------
+
+      function Read_Subtree
+        (Parent : Count_Type) return Count_Type
+      is
+         Subtree : Count_Type;
+
+      begin
+         Allocate_Node (Container, Stream, Subtree);
+         Container.Nodes (Subtree).Parent := Parent;
+
+         Read_Count := Read_Count + 1;
+
+         Read_Children (Subtree);
+
+         return Subtree;
+      end Read_Subtree;
+
+   --  Start of processing for Read
+
+   begin
+      Container.Clear;  -- checks busy bit
+
+      Count_Type'Read (Stream, Total_Count);
+
+      if not Total_Count'Valid then  -- Is this check necessary???
+         raise Program_Error with "attempt to read from corrupt stream";
+      end if;
+
+      if Total_Count = 0 then
+         return;
+      end if;
+
+      if Total_Count > Container.Capacity then
+         raise Capacity_Error  -- ???
+           with "node count in stream exceeds container capacity";
+      end if;
+
+      Initialize_Root (Container);
+
+      Read_Count := 0;
+
+      Read_Children (Root_Node (Container));
+
+      if Read_Count /= Total_Count then
+         raise Program_Error with "attempt to read from corrupt stream";
+      end if;
+
+      Container.Count := Total_Count;
+   end Read;
+
+   procedure Read
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : out Cursor)
+   is
+   begin
+      raise Program_Error with "attempt to read tree cursor from stream";
+   end Read;
+
+   --------------------
+   -- Remove_Subtree --
+   --------------------
+
+   procedure Remove_Subtree
+     (Container : in out Tree;
+      Subtree   : Count_Type)
+   is
+      NN : Tree_Node_Array renames Container.Nodes;
+      N  : Tree_Node_Type renames NN (Subtree);
+      CC : Children_Type renames NN (N.Parent).Children;
+
+   begin
+      --  This is a utility operation to remove a subtree
+      --  node from its parent's list of children.
+
+      if CC.First = Subtree then
+         pragma Assert (N.Prev <= 0);
+
+         if CC.Last = Subtree then
+            pragma Assert (N.Next <= 0);
+            CC.First := 0;
+            CC.Last := 0;
+
+         else
+            CC.First := N.Next;
+            NN (CC.First).Prev := 0;
+         end if;
+
+      elsif CC.Last = Subtree then
+         pragma Assert (N.Next <= 0);
+         CC.Last := N.Prev;
+         NN (CC.Last).Next := 0;
+
+      else
+         NN (N.Prev).Next := N.Next;
+         NN (N.Next).Prev := N.Prev;
+      end if;
+   end Remove_Subtree;
+
+   ----------------------
+   -- Replace_Element --
+   ----------------------
+
+   procedure Replace_Element
+     (Container : in out Tree;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
+   begin
+      if Position = No_Element 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 not in container";
+      end if;
+
+      if Is_Root (Position) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      if Container.Lock > 0 then
+         raise Program_Error
+           with "attempt to tamper with elements (tree is locked)";
+      end if;
+
+      Container.Elements (Position.Node) := New_Item;
+   end Replace_Element;
+
+   ------------------------------
+   -- Reverse_Iterate_Children --
+   ------------------------------
+
+   procedure Reverse_Iterate_Children
+     (Parent  : Cursor;
+      Process : not null access procedure (Position : Cursor))
+   is
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container.Count = 0 then
+         pragma Assert (Is_Root (Parent));
+         return;
+      end if;
+
+      declare
+         NN : Tree_Node_Array renames Parent.Container.Nodes;
+         B  : Integer renames Parent.Container.Busy;
+         C  : Count_Type;
+
+      begin
+         B := B + 1;
+
+         C := NN (Parent.Node).Children.Last;
+         while C > 0 loop
+            Process (Cursor'(Parent.Container, Node => C));
+            C := NN (C).Prev;
+         end loop;
+
+         B := B - 1;
+
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+   end Reverse_Iterate_Children;
+
+   ----------
+   -- Root --
+   ----------
+
+   function Root (Container : Tree) return Cursor is
+   begin
+      return (Container'Unrestricted_Access, Root_Node (Container));
+   end Root;
+
+   ---------------
+   -- Root_Node --
+   ---------------
+
+   function Root_Node (Container : Tree) return Count_Type is
+      pragma Unreferenced (Container);
+
+   begin
+      return 0;
+   end Root_Node;
+
+   ---------------------
+   -- Splice_Children --
+   ---------------------
+
+   procedure Splice_Children
+     (Target          : in out Tree;
+      Target_Parent   : Cursor;
+      Before          : Cursor;
+      Source          : in out Tree;
+      Source_Parent   : Cursor)
+   is
+   begin
+      if Target_Parent = No_Element then
+         raise Constraint_Error with "Target_Parent cursor has no element";
+      end if;
+
+      if Target_Parent.Container /= Target'Unrestricted_Access then
+         raise Program_Error
+           with "Target_Parent cursor not in Target container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error
+              with "Before cursor not in Target container";
+         end if;
+
+         if Target.Nodes (Before.Node).Parent /= Target_Parent.Node then
+            raise Constraint_Error
+              with "Before cursor not child of Target_Parent";
+         end if;
+      end if;
+
+      if Source_Parent = No_Element then
+         raise Constraint_Error with "Source_Parent cursor has no element";
+      end if;
+
+      if Source_Parent.Container /= Source'Unrestricted_Access then
+         raise Program_Error
+           with "Source_Parent cursor not in Source container";
+      end if;
+
+      if Source.Count = 0 then
+         pragma Assert (Is_Root (Source_Parent));
+         return;
+      end if;
+
+      if Target'Address = Source'Address then
+         if Target_Parent = Source_Parent then
+            return;
+         end if;
+
+         if Target.Busy > 0 then
+            raise Program_Error
+              with "attempt to tamper with cursors (Target tree is busy)";
+         end if;
+
+         if Is_Reachable (Container => Target,
+                          From      => Target_Parent.Node,
+                          To        => Source_Parent.Node)
+         then
+            raise Constraint_Error
+              with "Source_Parent is ancestor of Target_Parent";
+         end if;
+
+         Splice_Children
+           (Container     => Target,
+            Target_Parent => Target_Parent.Node,
+            Before        => Before.Node,
+            Source_Parent => Source_Parent.Node);
+
+         return;
+      end if;
+
+      if Target.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (Target tree is busy)";
+      end if;
+
+      if Source.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (Source tree is busy)";
+      end if;
+
+      if Target.Count = 0 then
+         Initialize_Root (Target);
+      end if;
+
+      Splice_Children
+        (Target        => Target,
+         Target_Parent => Target_Parent.Node,
+         Before        => Before.Node,
+         Source        => Source,
+         Source_Parent => Source_Parent.Node);
+   end Splice_Children;
+
+   procedure Splice_Children
+     (Container       : in out Tree;
+      Target_Parent   : Cursor;
+      Before          : Cursor;
+      Source_Parent   : Cursor)
+   is
+   begin
+      if Target_Parent = No_Element then
+         raise Constraint_Error with "Target_Parent cursor has no element";
+      end if;
+
+      if Target_Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error
+           with "Target_Parent cursor not in container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error
+              with "Before cursor not in container";
+         end if;
+
+         if Container.Nodes (Before.Node).Parent /= Target_Parent.Node then
+            raise Constraint_Error
+              with "Before cursor not child of Target_Parent";
+         end if;
+      end if;
+
+      if Source_Parent = No_Element then
+         raise Constraint_Error with "Source_Parent cursor has no element";
+      end if;
+
+      if Source_Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error
+           with "Source_Parent cursor not in container";
+      end if;
+
+      if Target_Parent = Source_Parent then
+         return;
+      end if;
+
+      pragma Assert (Container.Count > 0);
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Is_Reachable (Container => Container,
+                       From      => Target_Parent.Node,
+                       To        => Source_Parent.Node)
+      then
+         raise Constraint_Error
+           with "Source_Parent is ancestor of Target_Parent";
+      end if;
+
+      Splice_Children
+        (Container     => Container,
+         Target_Parent => Target_Parent.Node,
+         Before        => Before.Node,
+         Source_Parent => Source_Parent.Node);
+   end Splice_Children;
+
+   procedure Splice_Children
+     (Container     : in out Tree;
+      Target_Parent : Count_Type;
+      Before        : Count_Type'Base;
+      Source_Parent : Count_Type)
+   is
+      NN : Tree_Node_Array renames Container.Nodes;
+      CC : constant Children_Type := NN (Source_Parent).Children;
+      C  : Count_Type'Base;
+
+   begin
+      --  This is a utility operation to remove the children from Source parent
+      --  and insert them into Target parent.
+
+      NN (Source_Parent).Children := Children_Type'(others => 0);
+
+      --  Fix up the Parent pointers of each child to designate its new Target
+      --  parent.
+
+      C := CC.First;
+      while C > 0 loop
+         NN (C).Parent := Target_Parent;
+         C := NN (C).Next;
+      end loop;
+
+      Insert_Subtree_List
+        (Container => Container,
+         First     => CC.First,
+         Last      => CC.Last,
+         Parent    => Target_Parent,
+         Before    => Before);
+   end Splice_Children;
+
+   procedure Splice_Children
+     (Target        : in out Tree;
+      Target_Parent : Count_Type;
+      Before        : Count_Type'Base;
+      Source        : in out Tree;
+      Source_Parent : Count_Type)
+   is
+      S_NN : Tree_Node_Array renames Source.Nodes;
+      S_CC : Children_Type renames S_NN (Source_Parent).Children;
+
+      Target_Count, Source_Count : Count_Type;
+      T, S                       : Count_Type'Base;
+
+   begin
+      --  This is a utility operation to copy the children from the Source
+      --  parent and insert them as children of the Target parent, and then
+      --  delete them from the Source. (This is not a true splice operation,
+      --  but it is the best we can do in a bounded form.) The Before position
+      --  specifies where among the Target parent's exising children the new
+      --  children are inserted.
+
+      --  Before we attempt the insertion, we must count the sources nodes in
+      --  order to determine whether the target have enough storage
+      --  available. Note that calculating this value is an O(n) operation.
+      --
+      --  Here is an optimization opportunity: iterate of each children the
+      --  source explicitly, and keep a running count of the total number of
+      --  nodes. Compare the running total to the capacity of the target each
+      --  pass through the loop. This is more efficient than summing the counts
+      --  of child subtree (which is what Subtree_Node_Count does) and then
+      --  comparing that total sum to the target's capacity.  ???
+      --
+      --  Here is another possibility. We currently treat the splice as an
+      --  all-or-nothing proposition: either we can insert all of children of
+      --  the source, or we raise exception with modifying the target. The
+      --  price for not causing side-effect is an O(n) determination of the
+      --  source count. If we are willing to tolerate side-effect, then we
+      --  could loop over the children of the source, counting that subtree and
+      --  then immediately inserting it in the target. The issue here is that
+      --  the test for available storage could fail during some later pass,
+      --  after children have already been inserted into target. ???
+
+      Source_Count := Subtree_Node_Count (Source, Source_Parent) - 1;
+
+      if Source_Count = 0 then
+         return;
+      end if;
+
+      if Target.Count > Target.Capacity - Source_Count then
+         raise Capacity_Error  -- ???
+           with "Source count exceeds available storage on Target";
+      end if;
+
+      --  Copy_Subtree returns a count of the number of nodes it inserts, but
+      --  it does this by incrementing the value passed in. Therefore we must
+      --  initialize the count before calling Copy_Subtree.
+
+      Target_Count := 0;
+
+      S := S_CC.First;
+      while S > 0 loop
+         Copy_Subtree
+           (Source         => Source,
+            Source_Subtree => S,
+            Target         => Target,
+            Target_Parent  => Target_Parent,
+            Target_Subtree => T,
+            Count          => Target_Count);
+
+         Insert_Subtree_Node
+           (Container => Target,
+            Subtree   => T,
+            Parent    => Target_Parent,
+            Before    => Before);
+
+         S := S_NN (S).Next;
+      end loop;
+
+      pragma Assert (Target_Count = Source_Count);
+      Target.Count := Target.Count + Target_Count;
+
+      --  As with Copy_Subtree, operation Deallocate_Children returns a count
+      --  of the number of nodes it deallocates, but it works by incrementing
+      --  the value passed in. We must therefore initialize the count before
+      --  calling it.
+
+      Source_Count := 0;
+
+      Deallocate_Children (Source, Source_Parent, Source_Count);
+      pragma Assert (Source_Count = Target_Count);
+
+      Source.Count := Source.Count - Source_Count;
+   end Splice_Children;
+
+   --------------------
+   -- Splice_Subtree --
+   --------------------
+
+   procedure Splice_Subtree
+     (Target   : in out Tree;
+      Parent   : Cursor;
+      Before   : Cursor;
+      Source   : in out Tree;
+      Position : in out Cursor)
+   is
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Target'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in Target container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error with "Before cursor not in Target container";
+         end if;
+
+         if Target.Nodes (Before.Node).Parent /= Parent.Node then
+            raise Constraint_Error with "Before cursor not child of Parent";
+         end if;
+      end if;
+
+      if Position = No_Element then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Container /= Source'Unrestricted_Access then
+         raise Program_Error with "Position cursor not in Source container";
+      end if;
+
+      if Is_Root (Position) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      if Target'Address = Source'Address then
+         if Before = No_Element then
+            if Target.Nodes (Position.Node).Next <= 0 then  -- last child
+               return;
+            end if;
+
+         elsif Position.Node = Before.Node then
+            return;
+         end if;
+
+         if Target.Busy > 0 then
+            raise Program_Error
+              with "attempt to tamper with cursors (Target tree is busy)";
+         end if;
+
+         if Is_Reachable (Container => Target,
+                          From      => Parent.Node,
+                          To        => Position.Node)
+         then
+            raise Constraint_Error with "Position is ancestor of Parent";
+         end if;
+
+         Remove_Subtree (Target, Position.Node);
+
+         Target.Nodes (Position.Node).Parent := Parent.Node;
+         Insert_Subtree_Node (Target, Position.Node, Parent.Node, Before.Node);
+
+         return;
+      end if;
+
+      if Target.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (Target tree is busy)";
+      end if;
+
+      if Source.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (Source tree is busy)";
+      end if;
+
+      if Target.Count = 0 then
+         Initialize_Root (Target);
+      end if;
+
+      Splice_Subtree
+        (Target   => Target,
+         Parent   => Parent.Node,
+         Before   => Before.Node,
+         Source   => Source,
+         Position => Position.Node);  -- modified during call
+
+      Position.Container := Target'Unrestricted_Access;
+   end Splice_Subtree;
+
+   procedure Splice_Subtree
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      Position  : Cursor)
+   is
+   begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
+      if Before /= No_Element then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error with "Before cursor not in container";
+         end if;
+
+         if Container.Nodes (Before.Node).Parent /= Parent.Node then
+            raise Constraint_Error with "Before cursor not child of Parent";
+         end if;
+      end if;
+
+      if Position = No_Element 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 not in container";
+      end if;
+
+      if Is_Root (Position) then
+         --  Should this be PE instead?  Need ARG confirmation.  ???
+         raise Constraint_Error with "Position cursor designates root";
+      end if;
+
+      if Before = No_Element then
+         if Container.Nodes (Position.Node).Next <= 0 then  -- last child
+            return;
+         end if;
+
+      elsif Position.Node = Before.Node then
+         return;
+      end if;
+
+      if Container.Busy > 0 then
+         raise Program_Error
+           with "attempt to tamper with cursors (tree is busy)";
+      end if;
+
+      if Is_Reachable (Container => Container,
+                       From      => Parent.Node,
+                       To        => Position.Node)
+      then
+         raise Constraint_Error with "Position is ancestor of Parent";
+      end if;
+
+      Remove_Subtree (Container, Position.Node);
+      Container.Nodes (Position.Node).Parent := Parent.Node;
+      Insert_Subtree_Node (Container, Position.Node, Parent.Node, Before.Node);
+   end Splice_Subtree;
+
+   procedure Splice_Subtree
+     (Target   : in out Tree;
+      Parent   : Count_Type;
+      Before   : Count_Type'Base;
+      Source   : in out Tree;
+      Position : in out Count_Type)  -- Source on input, Target on output
+   is
+      Source_Count : Count_Type := Subtree_Node_Count (Source, Position);
+      pragma Assert (Source_Count >= 1);
+
+      Target_Subtree : Count_Type;
+      Target_Count   : Count_Type;
+
+   begin
+      if Target.Count > Target.Capacity - Source_Count then
+         raise Capacity_Error  -- ???
+           with "Source count exceeds available storage on Target";
+      end if;
+
+      --  Copy_Subtree returns a count of the number of nodes it inserts, but
+      --  it does this by incrementing the value passed in. Therefore we must
+      --  initialize the count before calling Copy_Subtree.
+
+      Target_Count := 0;
+
+      Copy_Subtree
+        (Source         => Source,
+         Source_Subtree => Position,
+         Target         => Target,
+         Target_Parent  => Parent,
+         Target_Subtree => Target_Subtree,
+         Count          => Target_Count);
+
+      pragma Assert (Target_Count = Source_Count);
+
+      Insert_Subtree_Node
+        (Container => Target,
+         Subtree   => Target_Subtree,
+         Parent    => Parent,
+         Before    => Before);
+
+      Target.Count := Target.Count + Target_Count;
+
+      --  As with Copy_Subtree, operation Deallocate_Subtree returns a count of
+      --  the number of nodes it deallocates, but it works by incrementing the
+      --  value passed in. We must therefore initialize the count before
+      --  calling it.
+
+      Source_Count := 0;
+
+      Deallocate_Children (Source, Position, Source_Count);
+      pragma Assert (Source_Count = Target_Count);
+
+      Source.Count := Source.Count - Source_Count;
+
+      Position := Target_Subtree;
+   end Splice_Subtree;
+
+   ------------------------
+   -- Subtree_Node_Count --
+   ------------------------
+
+   function Subtree_Node_Count (Position : Cursor) return Count_Type is
+   begin
+      if Position = No_Element then
+         return 0;
+      end if;
+
+      if Position.Container.Count = 0 then
+         pragma Assert (Is_Root (Position));
+         return 1;
+      end if;
+
+      return Subtree_Node_Count (Position.Container.all, Position.Node);
+   end Subtree_Node_Count;
+
+   function Subtree_Node_Count
+     (Container : Tree;
+      Subtree   : Count_Type) return Count_Type
+   is
+      Result : Count_Type;
+      Node   : Count_Type'Base;
+
+   begin
+      Result := 1;
+      Node := Container.Nodes (Subtree).Children.First;
+      while Node > 0 loop
+         Result := Result + Subtree_Node_Count (Container, Node);
+         Node := Container.Nodes (Node).Next;
+      end loop;
+      return Result;
+   end Subtree_Node_Count;
+
+   ----------
+   -- Swap --
+   ----------
+
+   procedure Swap
+     (Container : in out Tree;
+      I, J      : Cursor)
+   is
+   begin
+      if I = No_Element then
+         raise Constraint_Error with "I cursor has no element";
+      end if;
+
+      if I.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "I cursor not in container";
+      end if;
+
+      if Is_Root (I) then
+         raise Program_Error with "I cursor designates root";
+      end if;
+
+      if I = J then -- make this test sooner???
+         return;
+      end if;
+
+      if J = No_Element then
+         raise Constraint_Error with "J cursor has no element";
+      end if;
+
+      if J.Container /= Container'Unrestricted_Access then
+         raise Program_Error with "J cursor not in container";
+      end if;
+
+      if Is_Root (J) then
+         raise Program_Error with "J cursor designates root";
+      end if;
+
+      if Container.Lock > 0 then
+         raise Program_Error
+           with "attempt to tamper with elements (tree is locked)";
+      end if;
+
+      declare
+         EE : Element_Array renames Container.Elements;
+         EI : constant Element_Type := EE (I.Node);
+
+      begin
+         EE (I.Node) := EE (J.Node);
+         EE (J.Node) := EI;
+      end;
+   end Swap;
+
+   --------------------
+   -- Update_Element --
+   --------------------
+
+   procedure Update_Element
+     (Container : in out Tree;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type))
+   is
+   begin
+      if Position = No_Element 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 not in container";
+      end if;
+
+      if Is_Root (Position) then
+         raise Program_Error with "Position cursor designates root";
+      end if;
+
+      declare
+         T : Tree renames Position.Container.all'Unrestricted_Access.all;
+         B : Integer renames T.Busy;
+         L : Integer renames T.Lock;
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Process (Element => T.Elements (Position.Node));
+
+         L := L - 1;
+         B := B - 1;
+
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+   end Update_Element;
+
+   -----------
+   -- Write --
+   -----------
+
+   procedure Write
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : Tree)
+   is
+      procedure Write_Children (Subtree : Count_Type);
+      procedure Write_Subtree (Subtree : Count_Type);
+
+      --------------------
+      -- Write_Children --
+      --------------------
+
+      procedure Write_Children (Subtree : Count_Type) is
+         CC : Children_Type renames Container.Nodes (Subtree).Children;
+         C  : Count_Type'Base;
+
+      begin
+         Count_Type'Write (Stream, Child_Count (Container, Subtree));
+
+         C := CC.First;
+         while C > 0 loop
+            Write_Subtree (C);
+            C := Container.Nodes (C).Next;
+         end loop;
+      end Write_Children;
+
+      -------------------
+      -- Write_Subtree --
+      -------------------
+
+      procedure Write_Subtree (Subtree : Count_Type) is
+      begin
+         Element_Type'Write (Stream, Container.Elements (Subtree));
+         Write_Children (Subtree);
+      end Write_Subtree;
+
+   --  Start of processing for Write
+
+   begin
+      Count_Type'Write (Stream, Container.Count);
+
+      if Container.Count = 0 then
+         return;
+      end if;
+
+      Write_Children (Root_Node (Container));
+   end Write;
+
+   procedure Write
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : Cursor)
+   is
+   begin
+      raise Program_Error with "attempt to write tree cursor to stream";
+   end Write;
+
+end Ada.Containers.Bounded_Multiway_Trees;
diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads
new file mode 100644
index 00000000000..bc6de38b0ae
--- /dev/null
+++ b/gcc/ada/a-cbmutr.ads
@@ -0,0 +1,321 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                   ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES                  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+private with Ada.Streams;
+
+generic
+   type Element_Type is private;
+
+   with function "=" (Left, Right : Element_Type) return Boolean is <>;
+
+package Ada.Containers.Bounded_Multiway_Trees is
+   pragma Pure;
+   pragma Remote_Types;
+
+   type Tree (Capacity : Count_Type) is tagged private;
+   pragma Preelaborable_Initialization (Tree);
+
+   type Cursor is private;
+   pragma Preelaborable_Initialization (Cursor);
+
+   Empty_Tree : constant Tree;
+
+   No_Element : constant Cursor;
+
+   function Equal_Subtree
+     (Left_Position  : Cursor;
+      Right_Position : Cursor) return Boolean;
+
+   function "=" (Left, Right : Tree) return Boolean;
+
+   function Is_Empty (Container : Tree) return Boolean;
+
+   function Node_Count (Container : Tree) return Count_Type;
+
+   function Subtree_Node_Count (Position : Cursor) return Count_Type;
+
+   function Depth (Position : Cursor) return Count_Type;
+
+   function Is_Root (Position : Cursor) return Boolean;
+
+   function Is_Leaf (Position : Cursor) return Boolean;
+
+   function Root (Container : Tree) return Cursor;
+
+   procedure Clear (Container : in out Tree);
+
+   function Element (Position : Cursor) return Element_Type;
+
+   procedure Replace_Element
+     (Container : in out Tree;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
+   procedure Query_Element
+     (Position : Cursor;
+      Process  : not null access procedure (Element : Element_Type));
+
+   procedure Update_Element
+     (Container : in out Tree;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type));
+
+   procedure Assign (Target : in out Tree; Source : Tree);
+
+   function Copy (Source : Tree; Capacity : Count_Type := 0) return Tree;
+
+   procedure Move (Target : in out Tree; Source : in out Tree);
+
+   procedure Delete_Leaf
+     (Container : in out Tree;
+      Position  : in out Cursor);
+
+   procedure Delete_Subtree
+     (Container : in out Tree;
+      Position  : in out Cursor);
+
+   procedure Swap
+     (Container : in out Tree;
+      I, J      : Cursor);
+
+   function Find
+     (Container : Tree;
+      Item      : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree with a Container parameter,
+   --  but this seems incorrect. We need a ruling from the
+   --  ARG about whether this really was intended.  ???
+
+   function Find_In_Subtree
+     (Container : Tree;
+      Item      : Element_Type;
+      Position  : Cursor) return Cursor;
+
+   function Ancestor_Find
+     (Container : Tree;
+      Item      : Element_Type;
+      Position  : Cursor) return Cursor;
+
+   function Contains
+     (Container : Tree;
+      Item      : Element_Type) return Boolean;
+
+   function Has_Element (Position : Cursor) return Boolean;
+
+   procedure Iterate
+     (Container : Tree;
+      Process   : not null access procedure (Position : Cursor));
+
+   procedure Iterate_Subtree
+     (Position  : Cursor;
+      Process   : not null access procedure (Position : Cursor));
+
+   function Child_Count (Parent : Cursor) return Count_Type;
+
+   function Child_Depth (Parent, Child : Cursor) return Count_Type;
+
+   procedure Insert_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      New_Item  : Element_Type;
+      Count     : Count_Type := 1);
+
+   procedure Insert_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      New_Item  : Element_Type;
+      Position  : out Cursor;
+      Count     : Count_Type := 1);
+
+   procedure Insert_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      Position  : out Cursor;
+      Count     : Count_Type := 1);
+
+   procedure Prepend_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      New_Item  : Element_Type;
+      Count     : Count_Type := 1);
+
+   procedure Append_Child
+     (Container : in out Tree;
+      Parent    : Cursor;
+      New_Item  : Element_Type;
+      Count     : Count_Type := 1);
+
+   procedure Delete_Children
+     (Container : in out Tree;
+      Parent    : Cursor);
+
+   procedure Copy_Subtree
+     (Target   : in out Tree;
+      Parent   : Cursor;
+      Before   : Cursor;
+      Source   : Cursor);
+
+   procedure Splice_Subtree
+     (Target   : in out Tree;
+      Parent   : Cursor;
+      Before   : Cursor;
+      Source   : in out Tree;
+      Position : in out Cursor);
+
+   procedure Splice_Subtree
+     (Container : in out Tree;
+      Parent    : Cursor;
+      Before    : Cursor;
+      Position  : Cursor);
+
+   procedure Splice_Children
+     (Target          : in out Tree;
+      Target_Parent   : Cursor;
+      Before          : Cursor;
+      Source          : in out Tree;
+      Source_Parent   : Cursor);
+
+   procedure Splice_Children
+     (Container       : in out Tree;
+      Target_Parent   : Cursor;
+      Before          : Cursor;
+      Source_Parent   : Cursor);
+
+   function Parent (Position : Cursor) return Cursor;
+
+   function First_Child (Parent : Cursor) return Cursor;
+
+   function First_Child_Element (Parent : Cursor) return Element_Type;
+
+   function Last_Child (Parent : Cursor) return Cursor;
+
+   function Last_Child_Element (Parent : Cursor) return Element_Type;
+
+   function Next_Sibling (Position : Cursor) return Cursor;
+
+   function Previous_Sibling (Position : Cursor) return Cursor;
+
+   procedure Next_Sibling (Position : in out Cursor);
+
+   procedure Previous_Sibling (Position : in out Cursor);
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Iterate_Children this way:
+   --
+   --  procedure Iterate_Children
+   --    (Container : Tree;
+   --     Parent    : Cursor;
+   --     Process   : not null access procedure (Position : Cursor));
+   --
+   --  It seems that the Container parameter is there by mistake, but
+   --  we need an official ruling from the ARG.  ???
+
+   procedure Iterate_Children
+     (Parent  : Cursor;
+      Process : not null access procedure (Position : Cursor));
+
+   procedure Reverse_Iterate_Children
+     (Parent  : Cursor;
+      Process : not null access procedure (Position : Cursor));
+
+private
+
+   type Children_Type is record
+      First : Count_Type'Base;
+      Last  : Count_Type'Base;
+   end record;
+
+   type Tree_Node_Type is record
+      Parent   : Count_Type'Base;
+      Prev     : Count_Type'Base;
+      Next     : Count_Type'Base;
+      Children : Children_Type;
+   end record;
+
+   type Tree_Node_Array is array (Count_Type range <>) of Tree_Node_Type;
+   type Element_Array is array (Count_Type range <>) of Element_Type;
+
+   type Tree (Capacity : Count_Type) is tagged record
+      Nodes    : Tree_Node_Array (0 .. Capacity) := (others => <>);
+      Elements : Element_Array (1 .. Capacity) := (others => <>);
+      Free     : Count_Type'Base := -1;
+      Busy     : Integer := 0;
+      Lock     : Integer := 0;
+      Count    : Count_Type := 0;
+   end record;
+
+   use Ada.Streams;
+
+   procedure Write
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : Tree);
+
+   for Tree'Write use Write;
+
+   procedure Read
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : out Tree);
+
+   for Tree'Read use Read;
+
+   type Tree_Access is access all Tree;
+   for Tree_Access'Storage_Size use 0;
+
+   type Cursor is record
+      Container : Tree_Access;
+      Node      : Count_Type'Base := -1;
+   end record;
+
+   procedure Write
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : out Cursor);
+
+   for Cursor'Read use Read;
+
+   Empty_Tree : constant Tree := Tree'(Capacity => 0, others => <>);
+
+   No_Element : constant Cursor := Cursor'(others => <>);
+
+end Ada.Containers.Bounded_Multiway_Trees;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 07cc44c8d48..55090e72de3 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -176,14 +176,8 @@ package body Exp_Util is
          Ti  : Entity_Id;
 
       begin
-         --  For now, we simply ignore a call where the argument has no type
-         --  (probably case of unanalyzed condition), or has a type that is not
-         --  Boolean. This is because this is a pretty marginal piece of
-         --  functionality, and violations of these rules are likely to be
-         --  truly marginal (how much code uses Fortran Logical as the barrier
-         --  to a protected entry?) and we do not want to blow up existing
-         --  programs. We can change this to an assertion after 3.12a is
-         --  released ???
+         --  Defend against a call where the argument has no type, or has a
+         --  type that is not Boolean. This can occur because of prior errors.
 
          if No (T) or else not Is_Boolean_Type (T) then
             return;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 26f3085653b..48725cff908 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -6258,8 +6258,8 @@ The use of AND/OR operators is not permitted except in the cases of modular
 operands, array operands, and simple stand-alone boolean variables or
 boolean constants. In all other cases AND THEN/OR ELSE are required.
 
-@item ^c^COMMENTS^
-@emph{Check comments.}
+@item ^c^COMMENTS^ (double space)
+@emph{Check comments, double space.}
 Comments must meet the following set of rules:
 
 @itemize @bullet
@@ -6310,6 +6310,11 @@ example:
 @end smallexample
 @end itemize
 
+@item ^C^COMMENTS1^ (single space)
+@emph{Check comments, single space.}
+This is identical to @code{^c^COMMENTS} except that only one space
+is required following the @code{--} of a comment instead of two.
+
 @item ^d^DOS_LINE_ENDINGS^
 @emph{Check no DOS line terminators present.}
 All lines must be terminated by a single ASCII.LF
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index e0b738b831f..1fdf36adff9 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -517,6 +517,7 @@ package body Impunit is
      "a-coinho",    -- Ada.Containers.Indefinite_Holders
      "a-comutr",    -- Ada.Containers.Multiway_Trees
      "a-cimutr",    -- Ada.Containers.Indefinite_Multiway_Trees
+     "a-cbmutr",    -- Ada.Containers.Bounded_Multiway_Trees
      "a-extiin",    -- Ada.Execution_Time.Interrupts
      "a-iteint",    -- Ada.Iterator_Interfaces
 
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index f0bc9de8b27..2935bdbe6fb 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -919,6 +919,9 @@ package body Scng is
          Err : Boolean;
          --  Error flag for Scan_Wide call
 
+         String_Start : Source_Ptr;
+         --  Point to first character of string
+
          procedure Error_Bad_String_Char;
          --  Signal bad character in string/character literal. On entry
          --  Scan_Ptr points to the improper character encountered during the
@@ -966,6 +969,8 @@ package body Scng is
          -------------------------------
 
          procedure Error_Unterminated_String is
+            S : Source_Ptr;
+
          begin
             --  An interesting little refinement. Consider the following
             --  examples:
@@ -973,6 +978,7 @@ package body Scng is
             --     A := "this is an unterminated string;
             --     A := "this is an unterminated string &
             --     P(A, "this is a parameter that didn't get terminated);
+            --     P("this is a parameter that didn't get terminated, A);
 
             --  We fiddle a little to do slightly better placement in these
             --  cases also if there is white space at the end of the line we
@@ -1012,6 +1018,8 @@ package body Scng is
                return;
             end if;
 
+            --  Backup over semicolon or right-paren/semicolon sequence
+
             if Source (Scan_Ptr - 1) = ';' then
                Scan_Ptr := Scan_Ptr - 1;
                Unstore_String_Char;
@@ -1022,6 +1030,25 @@ package body Scng is
                end if;
             end if;
 
+            --  See if there is a comma in the string, if so, guess that
+            --  the first comma terminates the string.
+
+            S := String_Start;
+            while S < Scan_Ptr loop
+               if Source (S) = ',' then
+                  while Scan_Ptr > S loop
+                     Scan_Ptr := Scan_Ptr - 1;
+                     Unstore_String_Char;
+                  end loop;
+
+                  exit;
+               end if;
+
+               S := S + 1;
+            end loop;
+
+            --  Now we have adjusted the scan pointer, give message
+
             Error_Msg_S -- CODEFIX
               ("missing string quote");
          end Error_Unterminated_String;
@@ -1161,6 +1188,8 @@ package body Scng is
          --  quote). The latter case is an error detected by the character
          --  literal circuit.
 
+         String_Start := Scan_Ptr;
+
          Delimiter := Source (Scan_Ptr);
          Accumulate_Checksum (Delimiter);
 
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index a393680094e..d3d8528c872 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -481,7 +481,10 @@ package body Sem_Ch11 is
                   --  handler, since this may result in false positives, since
                   --  the handler may handle the exception and return normally.
 
-                  --  First find enclosing sequence of statements
+                  --  First find the enclosing handled sequence of statements
+                  --  (note, we could also look for a handler in an outer block
+                  --  but currently we don't, and in that case we'll emit the
+                  --  warning).
 
                   Par := N;
                   loop
diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb
index fd6cbae7ead..7cb4d823a75 100644
--- a/gcc/ada/styleg.adb
+++ b/gcc/ada/styleg.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -507,7 +507,9 @@ package body Styleg is
             S := Scan_Ptr + 2;
             while Source (S) >= ' ' loop
                if Source (S) /= '-' then
-                  if Is_Box_Comment then
+                  if Is_Box_Comment
+                    or else Style_Check_Comments_Spacing = 1
+                  then
                      Error_Space_Required (Scan_Ptr + 2);
                   else
                      Error_Msg -- CODEFIX
@@ -522,14 +524,17 @@ package body Styleg is
 
          --  If we are followed by a blank, then the comment is OK if the
          --  character following this blank is another blank or a format
-         --  effector.
+         --  effector, or if the required comment spacing is 1.
 
-         elsif Source (Scan_Ptr + 3) <= ' ' then
+         elsif Source (Scan_Ptr + 3) <= ' '
+           or else Style_Check_Comments_Spacing = 1
+         then
             return;
 
-         --  Here is the case where we only have one blank after the two
-         --  minus signs, which is an error unless the line ends with two
-         --  minus signs, the case of a box comment.
+         --  Here is the case where we only have one blank after the two minus
+         --  signs, with Style_Check_Comments_Spacing set to 2, which is an
+         --  error unless the line ends with two minus signs, the case of a
+         --  box comment.
 
          elsif not Is_Box_Comment then
             Error_Space_Required (Scan_Ptr + 3);
diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb
index 7c9d462cc23..cce2b8ff745 100644
--- a/gcc/ada/stylesw.adb
+++ b/gcc/ada/stylesw.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -160,7 +160,13 @@ package body Stylesw is
       Add ('A', Style_Check_Array_Attribute_Index);
       Add ('b', Style_Check_Blanks_At_End);
       Add ('B', Style_Check_Boolean_And_Or);
-      Add ('c', Style_Check_Comments);
+
+      if Style_Check_Comments_Spacing = 2 then
+         Add ('c', Style_Check_Comments);
+      elsif Style_Check_Comments_Spacing = 1 then
+         Add ('C', Style_Check_Comments);
+      end if;
+
       Add ('d', Style_Check_DOS_Line_Terminator);
       Add ('e', Style_Check_End_Labels);
       Add ('f', Style_Check_Form_Feeds);
@@ -322,6 +328,11 @@ package body Stylesw is
 
             when 'c' =>
                Style_Check_Comments              := True;
+               Style_Check_Comments_Spacing      := 2;
+
+            when 'C' =>
+               Style_Check_Comments              := True;
+               Style_Check_Comments_Spacing      := 1;
 
             when 'd' =>
                Style_Check_DOS_Line_Terminator   := True;
@@ -484,7 +495,7 @@ package body Stylesw is
             when 'B' =>
                Style_Check_Boolean_And_Or        := False;
 
-            when 'c' =>
+            when 'c' | 'C' =>
                Style_Check_Comments              := False;
 
             when 'd' =>
diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads
index 22270491492..fc6f5ef13ba 100644
--- a/gcc/ada/stylesw.ads
+++ b/gcc/ada/stylesw.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -94,7 +94,8 @@ package Stylesw is
    --      The comment characters are followed by an exclamation point (the
    --      sequence --! is used by gnatprep for marking deleted lines).
    --
-   --      The comment characters are followed by two space characters
+   --      The comment characters are followed by two space characters if
+   --      Comment_Spacing = 2, else by one character if Comment_Spacing = 1.
    --
    --      The line consists entirely of minus signs
    --
@@ -104,6 +105,9 @@ package Stylesw is
    --  Note: the reason for the last two conditions is to allow "boxed"
    --  comments where only a single space separates the comment characters.
 
+   Style_Check_Comments_Spacing : Nat range 1 .. 2;
+   --  Spacing required for comments, valid only if Style_Check_Comments true.
+
    Style_Check_DOS_Line_Terminator : Boolean := False;
    --  This can be set true by using the -gnatyd switch. If it is True, then
    --  the line terminator must be a single LF, without an associated CR (e.g.
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 5b0f6056a43..6c9839ddd14 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -548,7 +548,8 @@ begin
    Write_Line ("        A    check array attribute indexes");
    Write_Line ("        b    check no blanks at end of lines");
    Write_Line ("        B    check no use of AND/OR for boolean expressions");
-   Write_Line ("        c    check comment format");
+   Write_Line ("        c    check comment format (two spaces)");
+   Write_Line ("        C    check comment format (one space)");
    Write_Line ("        d    check no DOS line terminators");
    Write_Line ("        e    check end/exit labels present");
    Write_Line ("        f    check no form feeds/vertical tabs in source");
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 573cc515155..b742c69265b 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -2319,6 +2319,10 @@ package VMS_Data is
                                                "-gnaty-B "                 &
                                             "COMMENTS "                    &
                                                "-gnatyc "                  &
+                                            "COMMENTS1 "                   &
+                                               "-gnatyC "                  &
+                                            "COMMENTS2 "                   &
+                                               "-gnatyc "                  &
                                             "NOCOMMENTS "                  &
                                                "-gnaty-c "                 &
                                             "DOS_LINE_ENDINGS "            &
@@ -2409,7 +2413,7 @@ package VMS_Data is
    --   input source code.  The following keywords are supported:
    --
    --      ALL_BUILTIN (D)      Equivalent to the following list of options:
-   --                           3, ATTRIBUTE, BLANKS, COMMENTS, END, VTABS,
+   --                           3, ATTRIBUTE, BLANKS, COMMENTS2, END, VTABS,
    --                           HTABS, IF_THEN, KEYWORD, LAYOUT, LINE_LENGTH,
    --                           PRAGMA, REFERENCES, SPECS, TOKEN.
    --
@@ -2441,8 +2445,8 @@ package VMS_Data is
    --                           enforce a canonical format for the use of
    --                           blanks to separate source tokens.
    --
-   --      COMMENTS             Check comments.
-   --                           Comments must meet the following set of rules:
+   --      COMMENTS2            Check comments.
+   --      COMMENTS             Comments must meet the following set of rules:
    --
    --                             * The "--" that starts the column must either
    --                               start in column one, or else at least one
@@ -2488,6 +2492,11 @@ package VMS_Data is
    --                               -- This is a box comment --
    --                               ---------------------------
    --
+   --      COMMENTS1            Check comments (single space).
+   --                           Like COMMENTS2, but the -- of a comment only
+   --                           requires one or more spaces following, instead
+   --                           of two or more spaces.
+   --
    --      DOS_LINE_ENDINGS     Check that no DOS line terminators are present
    --                           All lines must be terminated by a single
    --                           ASCII.LF character. In particular the DOS line