[Ada] Refactor sort procedures of doubly linked list containers

gcc/ada/

	* libgnat/a-costso.ads, libgnat/a-costso.adb: A new library
	unit, Ada.Containers.Stable_Sorting, which exports a pair of
	generics (one within the other) which are instantiated by each
	of the 5 doubly-linked list container generics to implement
	their respective Sort procedures. We use a pair of generics,
	rather than a single generic, in order to further reduce code
	duplication. The outer generic takes a formal private Node_Ref
	type representing a reference to a linked list element. For some
	instances, the corresponding actual parameter will be an access
	type; for others, it will be the index type for an array.
	* Makefile.rtl: Include new Ada.Containers.Stable_Sorting unit.
	* libgnat/a-cbdlli.adb, libgnat/a-cdlili.adb,
	libgnat/a-cfdlli.adb, libgnat/a-cidlli.adb, libgnat/a-crdlli.adb
	(Sort): Replace existing Sort implementation with a call to an
	instance of
	Ada.Containers.Stable_Sorting.Doubly_Linked_List_Sort. Declare
	the (trivial) actual parameters needed to declare that instance.
	* libgnat/a-cfdlli.ads: Fix a bug encountered during testing in
	the postcondition for M_Elements_Sorted. With a partial
	ordering, it is possible for all three of (X < Y), (Y < X),
	and (X = Y) to be simultaneously false, so that case needs to
	handled correctly.

9 files changed, 455 insertions, 448 deletions

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index fb851a6..f32ed17 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -162,6 +162,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-coormu$(objext) \
   a-coorse$(objext) \
   a-coprnu$(objext) \
+  a-costso$(objext) \
   a-coteio$(objext) \
   a-crbltr$(objext) \
   a-crbtgk$(objext) \
diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb
index 143805e..3752ca9 100644
--- a/gcc/ada/libgnat/a-cbdlli.adb
+++ b/gcc/ada/libgnat/a-cbdlli.adb
@@ -27,6 +27,8 @@
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
 
+with Ada.Containers.Stable_Sorting; use Ada.Containers.Stable_Sorting;
+
 with System; use type System.Address;
 with System.Put_Images;
 
@@ -858,74 +860,6 @@ is
 
       procedure Sort (Container : in out List) is
          N : Node_Array renames Container.Nodes;
-
-         procedure Partition (Pivot, Back : Count_Type);
-         --  What does this do ???
-
-         procedure Sort (Front, Back : Count_Type);
-         --  Internal procedure, what does it do??? rename it???
-
-         ---------------
-         -- Partition --
-         ---------------
-
-         procedure Partition (Pivot, Back : Count_Type) is
-            Node : Count_Type;
-
-         begin
-            Node := N (Pivot).Next;
-            while Node /= Back loop
-               if N (Node).Element < N (Pivot).Element then
-                  declare
-                     Prev : constant Count_Type := N (Node).Prev;
-                     Next : constant Count_Type := N (Node).Next;
-
-                  begin
-                     N (Prev).Next := Next;
-
-                     if Next = 0 then
-                        Container.Last := Prev;
-                     else
-                        N (Next).Prev := Prev;
-                     end if;
-
-                     N (Node).Next := Pivot;
-                     N (Node).Prev := N (Pivot).Prev;
-
-                     N (Pivot).Prev := Node;
-
-                     if N (Node).Prev = 0 then
-                        Container.First := Node;
-                     else
-                        N (N (Node).Prev).Next := Node;
-                     end if;
-
-                     Node := Next;
-                  end;
-
-               else
-                  Node := N (Node).Next;
-               end if;
-            end loop;
-         end Partition;
-
-         ----------
-         -- Sort --
-         ----------
-
-         procedure Sort (Front, Back : Count_Type) is
-            Pivot : constant Count_Type :=
-              (if Front = 0 then Container.First else N (Front).Next);
-         begin
-            if Pivot /= Back then
-               Partition (Pivot, Back);
-               Sort (Front, Pivot);
-               Sort (Pivot, Back);
-            end if;
-         end Sort;
-
-      --  Start of processing for Sort
-
       begin
          if Container.Length <= 1 then
             return;
@@ -941,8 +875,43 @@ is
 
          declare
             Lock : With_Lock (Container.TC'Unchecked_Access);
+
+            package Descriptors is new List_Descriptors
+              (Node_Ref => Count_Type, Nil => 0);
+            use Descriptors;
+
+            function Next (Idx : Count_Type) return Count_Type is
+              (N (Idx).Next);
+            procedure Set_Next (Idx : Count_Type; Next : Count_Type)
+              with Inline;
+            procedure Set_Prev (Idx : Count_Type; Prev : Count_Type)
+              with Inline;
+            function "<" (L, R : Count_Type) return Boolean is
+              (N (L).Element < N (R).Element);
+            procedure Update_Container (List : List_Descriptor) with Inline;
+
+            procedure Set_Next (Idx : Count_Type; Next : Count_Type) is
+            begin
+               N (Idx).Next := Next;
+            end Set_Next;
+
+            procedure Set_Prev (Idx : Count_Type; Prev : Count_Type) is
+            begin
+               N (Idx).Prev := Prev;
+            end Set_Prev;
+
+            procedure Update_Container (List : List_Descriptor) is
+            begin
+               Container.First  := List.First;
+               Container.Last   := List.Last;
+               Container.Length := List.Length;
+            end Update_Container;
+
+            procedure Sort_List is new Doubly_Linked_List_Sort;
          begin
-            Sort (Front => 0, Back => 0);
+            Sort_List (List_Descriptor'(First  => Container.First,
+                                        Last   => Container.Last,
+                                        Length => Container.Length));
          end;
 
          pragma Assert (N (Container.First).Prev = 0);
diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb
index d989751..1d48ed9 100644
--- a/gcc/ada/libgnat/a-cdlili.adb
+++ b/gcc/ada/libgnat/a-cdlili.adb
@@ -29,6 +29,8 @@
 
 with Ada.Unchecked_Deallocation;
 
+with Ada.Containers.Stable_Sorting; use Ada.Containers.Stable_Sorting;
+
 with System; use type System.Address;
 with System.Put_Images;
 
@@ -674,156 +676,6 @@ is
       ----------
 
       procedure Sort (Container : in out List) is
-
-         type List_Descriptor is
-            record
-               First, Last : Node_Access;
-               Length      : Count_Type;
-            end record;
-
-         function Merge_Sort (Arg : List_Descriptor) return List_Descriptor;
-         --  Sort list of given length using MergeSort; length must be >= 2.
-         --  As required by RM, the sort is stable.
-
-         ----------------
-         -- Merge_Sort --
-         ----------------
-
-         function Merge_Sort (Arg : List_Descriptor) return List_Descriptor
-         is
-            procedure Split_List
-              (Unsplit : List_Descriptor; Part1, Part2 : out List_Descriptor);
-            --  Split list into two parts for divide-and-conquer.
-            --  Unsplit.Length must be >= 2.
-
-            function Merge_Parts
-              (Part1, Part2 : List_Descriptor) return List_Descriptor;
-            --  Merge two sorted lists, preserving sorted property.
-
-            ----------------
-            -- Split_List --
-            ----------------
-
-            procedure Split_List
-              (Unsplit : List_Descriptor; Part1, Part2 : out List_Descriptor)
-            is
-               Rover : Node_Access := Unsplit.First;
-               Bump_Count : constant Count_Type := (Unsplit.Length - 1) / 2;
-            begin
-               for Iter in 1 .. Bump_Count loop
-                  Rover := Rover.Next;
-               end loop;
-
-               Part1 := (First  => Unsplit.First,
-                         Last   => Rover,
-                         Length => Bump_Count + 1);
-
-               Part2 := (First => Rover.Next,
-                         Last  => Unsplit.Last,
-                         Length => Unsplit.Length - Part1.Length);
-
-               --  Detach
-               Part1.Last.Next := null;
-               Part2.First.Prev := null;
-            end Split_List;
-
-            -----------------
-            -- Merge_Parts --
-            -----------------
-
-            function Merge_Parts
-              (Part1, Part2 : List_Descriptor) return List_Descriptor
-            is
-               Empty  : constant List_Descriptor := (null, null, 0);
-
-               procedure Detach_First (Source   : in out List_Descriptor;
-                                       Detached : out Node_Access);
-               --  Detach the first element from a non-empty list and
-               --  return the detached node via the Detached parameter.
-
-               ------------------
-               -- Detach_First --
-               ------------------
-
-               procedure Detach_First (Source   : in out List_Descriptor;
-                                       Detached : out Node_Access) is
-               begin
-                  Detached := Source.First;
-
-                  if Source.Length = 1 then
-                     Source := Empty;
-                  else
-                     Source := (Source.First.Next,
-                                Source.Last,
-                                Source.Length - 1);
-
-                     Detached.Next.Prev := null;
-                     Detached.Next := null;
-                  end if;
-               end Detach_First;
-
-               P1     : List_Descriptor := Part1;
-               P2     : List_Descriptor := Part2;
-               Merged : List_Descriptor := Empty;
-
-               Take_From_P2 : Boolean;
-               Detached     : Node_Access;
-
-            --  Start of processing for Merge_Parts
-
-            begin
-               while (P1.Length /= 0) or (P2.Length /= 0) loop
-                  if P1.Length = 0 then
-                     Take_From_P2 := True;
-                  elsif P2.Length = 0 then
-                     Take_From_P2 := False;
-                  else
-                     --  If the compared elements are equal then Take_From_P2
-                     --  must be False in order to ensure stability.
-
-                     Take_From_P2 := P2.First.Element < P1.First.Element;
-                  end if;
-
-                  if Take_From_P2 then
-                     Detach_First (P2, Detached);
-                  else
-                     Detach_First (P1, Detached);
-                  end if;
-
-                  if Merged.Length = 0 then
-                     Merged := (First | Last => Detached, Length => 1);
-                  else
-                     Detached.Prev := Merged.Last;
-                     Merged.Last.Next := Detached;
-                     Merged.Last := Detached;
-                     Merged.Length := Merged.Length + 1;
-                  end if;
-               end loop;
-               return Merged;
-            end Merge_Parts;
-
-         --  Start of processing for Merge_Sort
-
-         begin
-            if Arg.Length < 2 then
-               --  already sorted
-               return Arg;
-            end if;
-
-            declare
-               Part1, Part2 : List_Descriptor;
-            begin
-               Split_List (Unsplit => Arg, Part1 => Part1, Part2 => Part2);
-
-               Part1 := Merge_Sort (Part1);
-               Part2 := Merge_Sort (Part2);
-
-               return Merge_Parts (Part1, Part2);
-            end;
-         end Merge_Sort;
-
-      --  Start of processing for Sort
-
       begin
          if Container.Length <= 1 then
             return;
@@ -838,28 +690,43 @@ is
          --  element tampering by a generic actual subprogram.
 
          declare
-            Lock     : With_Lock (Container.TC'Unchecked_Access);
+            Lock : With_Lock (Container.TC'Unchecked_Access);
+
+            package Descriptors is new List_Descriptors
+              (Node_Ref => Node_Access, Nil => null);
+            use Descriptors;
+
+            function Next (N : Node_Access) return Node_Access is (N.Next);
+            procedure Set_Next (N : Node_Access; Next : Node_Access)
+              with Inline;
+            procedure Set_Prev (N : Node_Access; Prev : Node_Access)
+              with Inline;
+            function "<" (L, R : Node_Access) return Boolean is
+              (L.Element < R.Element);
+            procedure Update_Container (List : List_Descriptor) with Inline;
+
+            procedure Set_Next (N : Node_Access; Next : Node_Access) is
+            begin
+               N.Next := Next;
+            end Set_Next;
 
-            Unsorted : constant List_Descriptor :=
-                                  (First  => Container.First,
-                                   Last   => Container.Last,
-                                   Length => Container.Length);
+            procedure Set_Prev (N : Node_Access; Prev : Node_Access) is
+            begin
+               N.Prev := Prev;
+            end Set_Prev;
+
+            procedure Update_Container (List : List_Descriptor) is
+            begin
+               Container.First  := List.First;
+               Container.Last   := List.Last;
+               Container.Length := List.Length;
+            end Update_Container;
 
-            Sorted   : List_Descriptor;
+            procedure Sort_List is new Doubly_Linked_List_Sort;
          begin
-            --  If a call to the formal < operator references the container
-            --  during sorting, seeing an empty container seems preferable
-            --  to seeing an internally inconsistent container.
-            --
-            Container.First  := null;
-            Container.Last   := null;
-            Container.Length := 0;
-
-            Sorted := Merge_Sort (Unsorted);
-
-            Container.First  := Sorted.First;
-            Container.Last   := Sorted.Last;
-            Container.Length := Sorted.Length;
+            Sort_List (List_Descriptor'(First  => Container.First,
+                                        Last   => Container.Last,
+                                        Length => Container.Length));
          end;
 
          pragma Assert (Container.First.Prev = null);
diff --git a/gcc/ada/libgnat/a-cfdlli.adb b/gcc/ada/libgnat/a-cfdlli.adb
index b289def..c9897c7 100644
--- a/gcc/ada/libgnat/a-cfdlli.adb
+++ b/gcc/ada/libgnat/a-cfdlli.adb
@@ -25,6 +25,8 @@
 -- <http://www.gnu.org/licenses/>.                                          --
 ------------------------------------------------------------------------------
 
+with Ada.Containers.Stable_Sorting; use Ada.Containers.Stable_Sorting;
+
 with System; use type System.Address;
 
 package body Ada.Containers.Formal_Doubly_Linked_Lists with
@@ -976,77 +978,6 @@ is
 
       procedure Sort (Container : in out List) is
          N : Node_Array renames Container.Nodes;
-
-         procedure Partition (Pivot : Count_Type; Back : Count_Type);
-         procedure Sort (Front : Count_Type; Back : Count_Type);
-
-         ---------------
-         -- Partition --
-         ---------------
-
-         procedure Partition (Pivot : Count_Type; Back : Count_Type) is
-            Node : Count_Type;
-
-         begin
-            Node := N (Pivot).Next;
-            while Node /= Back loop
-               if N (Node).Element < N (Pivot).Element then
-                  declare
-                     Prev : constant Count_Type := N (Node).Prev;
-                     Next : constant Count_Type := N (Node).Next;
-
-                  begin
-                     N (Prev).Next := Next;
-
-                     if Next = 0 then
-                        Container.Last := Prev;
-                     else
-                        N (Next).Prev := Prev;
-                     end if;
-
-                     N (Node).Next := Pivot;
-                     N (Node).Prev := N (Pivot).Prev;
-
-                     N (Pivot).Prev := Node;
-
-                     if N (Node).Prev = 0 then
-                        Container.First := Node;
-                     else
-                        N (N (Node).Prev).Next := Node;
-                     end if;
-
-                     Node := Next;
-                  end;
-
-               else
-                  Node := N (Node).Next;
-               end if;
-            end loop;
-         end Partition;
-
-         ----------
-         -- Sort --
-         ----------
-
-         procedure Sort (Front : Count_Type; Back : Count_Type) is
-            Pivot : Count_Type;
-
-         begin
-            if Front = 0 then
-               Pivot := Container.First;
-            else
-               Pivot := N (Front).Next;
-            end if;
-
-            if Pivot /= Back then
-               Partition (Pivot, Back);
-               Sort (Front, Pivot);
-               Sort (Pivot, Back);
-            end if;
-         end Sort;
-
-      --  Start of processing for Sort
-
       begin
          if Container.Length <= 1 then
             return;
@@ -1055,7 +986,44 @@ is
          pragma Assert (N (Container.First).Prev = 0);
          pragma Assert (N (Container.Last).Next = 0);
 
-         Sort (Front => 0, Back => 0);
+         declare
+            package Descriptors is new List_Descriptors
+              (Node_Ref => Count_Type, Nil => 0);
+            use Descriptors;
+
+            function Next (Idx : Count_Type) return Count_Type is
+              (N (Idx).Next);
+            procedure Set_Next (Idx : Count_Type; Next : Count_Type)
+              with Inline;
+            procedure Set_Prev (Idx : Count_Type; Prev : Count_Type)
+              with Inline;
+            function "<" (L, R : Count_Type) return Boolean is
+              (N (L).Element < N (R).Element);
+            procedure Update_Container (List : List_Descriptor) with Inline;
+
+            procedure Set_Next (Idx : Count_Type; Next : Count_Type) is
+            begin
+               N (Idx).Next := Next;
+            end Set_Next;
+
+            procedure Set_Prev (Idx : Count_Type; Prev : Count_Type) is
+            begin
+               N (Idx).Prev := Prev;
+            end Set_Prev;
+
+            procedure Update_Container (List : List_Descriptor) is
+            begin
+               Container.First  := List.First;
+               Container.Last   := List.Last;
+               Container.Length := List.Length;
+            end Update_Container;
+
+            procedure Sort_List is new Doubly_Linked_List_Sort;
+         begin
+            Sort_List (List_Descriptor'(First  => Container.First,
+                                        Last   => Container.Last,
+                                        Length => Container.Length));
+         end;
 
          pragma Assert (N (Container.First).Prev = 0);
          pragma Assert (N (Container.Last).Next = 0);
diff --git a/gcc/ada/libgnat/a-cfdlli.ads b/gcc/ada/libgnat/a-cfdlli.ads
index 8713d33..590643e 100644
--- a/gcc/ada/libgnat/a-cfdlli.ads
+++ b/gcc/ada/libgnat/a-cfdlli.ads
@@ -1596,8 +1596,7 @@ is
              M_Elements_Sorted'Result =
                (for all I in 1 .. M.Length (Container) =>
                  (for all J in I .. M.Length (Container) =>
-                   Element (Container, I) = Element (Container, J)
-                     or Element (Container, I) < Element (Container, J)));
+                   not (Element (Container, J) < Element (Container, I))));
          pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Sorted);
 
       end Formal_Model;
diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb
index 3fc57da..1cf9401 100644
--- a/gcc/ada/libgnat/a-cidlli.adb
+++ b/gcc/ada/libgnat/a-cidlli.adb
@@ -29,6 +29,8 @@
 
 with Ada.Unchecked_Deallocation;
 
+with Ada.Containers.Stable_Sorting; use Ada.Containers.Stable_Sorting;
+
 with System; use type System.Address;
 with System.Put_Images;
 
@@ -731,73 +733,6 @@ is
       ----------
 
       procedure Sort (Container : in out List) is
-         procedure Partition (Pivot : Node_Access; Back  : Node_Access);
-         --  Comment ???
-
-         procedure Sort (Front, Back : Node_Access);
-         --  Comment??? Confusing name??? change name???
-
-         ---------------
-         -- Partition --
-         ---------------
-
-         procedure Partition (Pivot : Node_Access; Back : Node_Access) is
-            Node : Node_Access;
-
-         begin
-            Node := Pivot.Next;
-            while Node /= Back loop
-               if Node.Element.all < Pivot.Element.all then
-                  declare
-                     Prev : constant Node_Access := Node.Prev;
-                     Next : constant Node_Access := Node.Next;
-
-                  begin
-                     Prev.Next := Next;
-
-                     if Next = null then
-                        Container.Last := Prev;
-                     else
-                        Next.Prev := Prev;
-                     end if;
-
-                     Node.Next := Pivot;
-                     Node.Prev := Pivot.Prev;
-
-                     Pivot.Prev := Node;
-
-                     if Node.Prev = null then
-                        Container.First := Node;
-                     else
-                        Node.Prev.Next := Node;
-                     end if;
-
-                     Node := Next;
-                  end;
-
-               else
-                  Node := Node.Next;
-               end if;
-            end loop;
-         end Partition;
-
-         ----------
-         -- Sort --
-         ----------
-
-         procedure Sort (Front, Back : Node_Access) is
-            Pivot : constant Node_Access :=
-              (if Front = null then Container.First else Front.Next);
-         begin
-            if Pivot /= Back then
-               Partition (Pivot, Back);
-               Sort (Front, Pivot);
-               Sort (Pivot, Back);
-            end if;
-         end Sort;
-
-      --  Start of processing for Sort
-
       begin
          if Container.Length <= 1 then
             return;
@@ -813,8 +748,42 @@ is
 
          declare
             Lock : With_Lock (Container.TC'Unchecked_Access);
+
+            package Descriptors is new List_Descriptors
+              (Node_Ref => Node_Access, Nil => null);
+            use Descriptors;
+
+            function Next (N : Node_Access) return Node_Access is (N.Next);
+            procedure Set_Next (N : Node_Access; Next : Node_Access)
+              with Inline;
+            procedure Set_Prev (N : Node_Access; Prev : Node_Access)
+              with Inline;
+            function "<" (L, R : Node_Access) return Boolean is
+              (L.Element.all < R.Element.all);
+            procedure Update_Container (List : List_Descriptor) with Inline;
+
+            procedure Set_Next (N : Node_Access; Next : Node_Access) is
+            begin
+               N.Next := Next;
+            end Set_Next;
+
+            procedure Set_Prev (N : Node_Access; Prev : Node_Access) is
+            begin
+               N.Prev := Prev;
+            end Set_Prev;
+
+            procedure Update_Container (List : List_Descriptor) is
+            begin
+               Container.First  := List.First;
+               Container.Last   := List.Last;
+               Container.Length := List.Length;
+            end Update_Container;
+
+            procedure Sort_List is new Doubly_Linked_List_Sort;
          begin
-            Sort (Front => null, Back => null);
+            Sort_List (List_Descriptor'(First  => Container.First,
+                                        Last   => Container.Last,
+                                        Length => Container.Length));
          end;
 
          pragma Assert (Container.First.Prev = null);
diff --git a/gcc/ada/libgnat/a-costso.adb b/gcc/ada/libgnat/a-costso.adb
new file mode 100644
index 0000000..e14ecbb
--- /dev/null
+++ b/gcc/ada/libgnat/a-costso.adb
@@ -0,0 +1,191 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                         --
+--                                                                          --
+--         A D A . C O N T A I N E R S . S T A B L E _ S O R T I N G        --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 1995-2021, AdaCore                     --
+--                                                                          --
+-- 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/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body Ada.Containers.Stable_Sorting is
+   package body List_Descriptors is
+      procedure Doubly_Linked_List_Sort (List : List_Descriptor) is
+
+         Empty  : constant List_Descriptor := (Nil, Nil, 0);
+
+         function Merge_Sort (Arg : List_Descriptor) return List_Descriptor;
+         --  Sort list of given length using MergeSort; length must be >= 2.
+         --  As required by RM, the sort is stable.
+
+         ----------------
+         -- Merge_Sort --
+         ----------------
+
+         function Merge_Sort (Arg : List_Descriptor) return List_Descriptor
+         is
+            procedure Split_List
+              (Unsplit : List_Descriptor; Part1, Part2 : out List_Descriptor);
+            --  Split list into two parts for divide-and-conquer.
+            --  Unsplit.Length must be >= 2.
+
+            function Merge_Parts
+              (Part1, Part2 : List_Descriptor) return List_Descriptor;
+            --  Merge two sorted lists, preserving sorted property.
+
+            ----------------
+            -- Split_List --
+            ----------------
+
+            procedure Split_List
+              (Unsplit : List_Descriptor; Part1, Part2 : out List_Descriptor)
+            is
+               Rover : Node_Ref := Unsplit.First;
+               Bump_Count : constant Count_Type := (Unsplit.Length - 1) / 2;
+            begin
+               for Iter in 1 .. Bump_Count loop
+                  Rover := Next (Rover);
+               end loop;
+
+               Part1 := (First  => Unsplit.First,
+                         Last   => Rover,
+                         Length => Bump_Count + 1);
+
+               Part2 := (First => Next (Rover),
+                         Last  => Unsplit.Last,
+                         Length => Unsplit.Length - Part1.Length);
+
+               --  Detach
+               Set_Next (Part1.Last, Nil);
+               Set_Prev (Part2.First, Nil);
+            end Split_List;
+
+            -----------------
+            -- Merge_Parts --
+            -----------------
+
+            function Merge_Parts
+              (Part1, Part2 : List_Descriptor) return List_Descriptor
+            is
+               procedure Detach_First (Source   : in out List_Descriptor;
+                                       Detached : out Node_Ref);
+               --  Detach the first element from a non-empty list and
+               --  return the detached node via the Detached parameter.
+
+               ------------------
+               -- Detach_First --
+               ------------------
+
+               procedure Detach_First (Source   : in out List_Descriptor;
+                                       Detached : out Node_Ref) is
+               begin
+                  Detached := Source.First;
+
+                  if Source.Length = 1 then
+                     Source := Empty;
+                  else
+                     Source := (Next (Source.First),
+                                Source.Last,
+                                Source.Length - 1);
+
+                     Set_Prev (Next (Detached), Nil);
+                     Set_Next (Detached, Nil);
+                  end if;
+               end Detach_First;
+
+               P1     : List_Descriptor := Part1;
+               P2     : List_Descriptor := Part2;
+               Merged : List_Descriptor := Empty;
+
+               Take_From_P2 : Boolean;
+               Detached     : Node_Ref;
+
+            --  Start of processing for Merge_Parts
+
+            begin
+               while (P1.Length /= 0) or (P2.Length /= 0) loop
+                  if P1.Length = 0 then
+                     Take_From_P2 := True;
+                  elsif P2.Length = 0 then
+                     Take_From_P2 := False;
+                  else
+                     --  If the compared elements are equal then Take_From_P2
+                     --  must be False in order to ensure stability.
+
+                     Take_From_P2 := P2.First < P1.First;
+                  end if;
+
+                  if Take_From_P2 then
+                     Detach_First (P2, Detached);
+                  else
+                     Detach_First (P1, Detached);
+                  end if;
+
+                  if Merged.Length = 0 then
+                     Merged := (First | Last => Detached, Length => 1);
+                  else
+                     Set_Prev (Detached, Merged.Last);
+                     Set_Next (Merged.Last, Detached);
+                     Merged.Last := Detached;
+                     Merged.Length := Merged.Length + 1;
+                  end if;
+               end loop;
+               return Merged;
+            end Merge_Parts;
+
+         --  Start of processing for Merge_Sort
+
+         begin
+            if Positive (Arg.Length) < 2 then
+               --  already sorted
+               return Arg;
+            end if;
+
+            declare
+               Part1, Part2 : List_Descriptor;
+            begin
+               Split_List (Unsplit => Arg, Part1 => Part1, Part2 => Part2);
+
+               Part1 := Merge_Sort (Part1);
+               Part2 := Merge_Sort (Part2);
+
+               return Merge_Parts (Part1, Part2);
+            end;
+         end Merge_Sort;
+
+      --  Start of processing for Sort
+
+      begin
+         if List.Length > 1 then
+            --  If a call to the formal "<" op references the container
+            --  during sorting, seeing an empty container seems preferable
+            --  to seeing an internally inconsistent container.
+            --
+            Update_Container (Empty);
+
+            Update_Container (Merge_Sort (List));
+         end if;
+      end Doubly_Linked_List_Sort;
+   end List_Descriptors;
+end Ada.Containers.Stable_Sorting;
diff --git a/gcc/ada/libgnat/a-costso.ads b/gcc/ada/libgnat/a-costso.ads
new file mode 100644
index 0000000..db0be24
--- /dev/null
+++ b/gcc/ada/libgnat/a-costso.ads
@@ -0,0 +1,71 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                         --
+--                                                                          --
+--         A D A . C O N T A I N E R S . S T A B L E _ S O R T I N G        --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 1995-2021, AdaCore                     --
+--                                                                          --
+-- 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/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Stable_Sorting package
+
+--  This package provides a generic stable sorting procedure that is
+--  intended for use by the various doubly linked list container generics.
+--  If a stable array sorting algorithm with better-than-quadratic worst
+--  case execution time is ever needed, then it could also reside here.
+
+private package Ada.Containers.Stable_Sorting is
+   pragma Annotate (CodePeer, Skip_Analysis);
+   pragma Pure;
+   pragma Remote_Types;
+
+   --  Stable sorting algorithms with N-log-N worst case execution time.
+
+   generic
+      type Node_Ref is private; -- access value or array index
+      Nil : Node_Ref;
+   package List_Descriptors is
+
+      type List_Descriptor is
+         record
+            First, Last : Node_Ref := Nil;
+            Length      : Count_Type := 0;
+         end record;
+
+      --  We use a nested generic here so that the inner generic can
+      --  refer to the List_Descriptor type.
+
+      generic
+         with function Next (N : Node_Ref) return Node_Ref is <>;
+         with procedure Set_Next (N : Node_Ref; Next : Node_Ref) is <>;
+         with procedure Set_Prev (N : Node_Ref; Prev : Node_Ref) is <>;
+         with function "<" (L, R : Node_Ref) return Boolean is <>;
+
+         with procedure Update_Container (List : List_Descriptor) is <>;
+      procedure Doubly_Linked_List_Sort (List : List_Descriptor);
+
+   end List_Descriptors;
+
+end Ada.Containers.Stable_Sorting;
diff --git a/gcc/ada/libgnat/a-crdlli.adb b/gcc/ada/libgnat/a-crdlli.adb
index 6538b26..48cdb0c 100644
--- a/gcc/ada/libgnat/a-crdlli.adb
+++ b/gcc/ada/libgnat/a-crdlli.adb
@@ -27,6 +27,8 @@
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
 
+with Ada.Containers.Stable_Sorting; use Ada.Containers.Stable_Sorting;
+
 with System; use type System.Address;
 
 package body Ada.Containers.Restricted_Doubly_Linked_Lists is
@@ -509,83 +511,53 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is
 
       procedure Sort (Container : in out List) is
          N : Node_Array renames Container.Nodes;
-
-         procedure Partition (Pivot, Back : Count_Type);
-         procedure Sort (Front, Back : Count_Type);
-
-         ---------------
-         -- Partition --
-         ---------------
-
-         procedure Partition (Pivot, Back : Count_Type) is
-            Node : Count_Type := N (Pivot).Next;
-
-         begin
-            while Node /= Back loop
-               if N (Node).Element < N (Pivot).Element then
-                  declare
-                     Prev : constant Count_Type := N (Node).Prev;
-                     Next : constant Count_Type := N (Node).Next;
-
-                  begin
-                     N (Prev).Next := Next;
-
-                     if Next = 0 then
-                        Container.Last := Prev;
-                     else
-                        N (Next).Prev := Prev;
-                     end if;
-
-                     N (Node).Next := Pivot;
-                     N (Node).Prev := N (Pivot).Prev;
-
-                     N (Pivot).Prev := Node;
-
-                     if N (Node).Prev = 0 then
-                        Container.First := Node;
-                     else
-                        N (N (Node).Prev).Next := Node;
-                     end if;
-
-                     Node := Next;
-                  end;
-
-               else
-                  Node := N (Node).Next;
-               end if;
-            end loop;
-         end Partition;
-
-         ----------
-         -- Sort --
-         ----------
-
-         procedure Sort (Front, Back : Count_Type) is
-            Pivot : constant Count_Type :=
-              (if Front = 0 then Container.First else N (Front).Next);
-         begin
-            if Pivot /= Back then
-               Partition (Pivot, Back);
-               Sort (Front, Pivot);
-               Sort (Pivot, Back);
-            end if;
-         end Sort;
-
-      --  Start of processing for Sort
-
       begin
          if Container.Length <= 1 then
             return;
          end if;
 
-         pragma Assert (N (Container.First).Prev = 0);
-         pragma Assert (N (Container.Last).Next = 0);
-
 --       if Container.Busy > 0 then
 --          raise Program_Error;
 --       end if;
 
-         Sort (Front => 0, Back => 0);
+         declare
+            package Descriptors is new List_Descriptors
+              (Node_Ref => Count_Type, Nil => 0);
+            use Descriptors;
+
+            function Next (Idx : Count_Type) return Count_Type is
+              (N (Idx).Next);
+            procedure Set_Next (Idx : Count_Type; Next : Count_Type)
+              with Inline;
+            procedure Set_Prev (Idx : Count_Type; Prev : Count_Type)
+              with Inline;
+            function "<" (L, R : Count_Type) return Boolean is
+              (N (L).Element < N (R).Element);
+            procedure Update_Container (List : List_Descriptor) with Inline;
+
+            procedure Set_Next (Idx : Count_Type; Next : Count_Type) is
+            begin
+               N (Idx).Next := Next;
+            end Set_Next;
+
+            procedure Set_Prev (Idx : Count_Type; Prev : Count_Type) is
+            begin
+               N (Idx).Prev := Prev;
+            end Set_Prev;
+
+            procedure Update_Container (List : List_Descriptor) is
+            begin
+               Container.First  := List.First;
+               Container.Last   := List.Last;
+               Container.Length := List.Length;
+            end Update_Container;
+
+            procedure Sort_List is new Doubly_Linked_List_Sort;
+         begin
+            Sort_List (List_Descriptor'(First  => Container.First,
+                                        Last   => Container.Last,
+                                        Length => Container.Length));
+         end;
 
          pragma Assert (N (Container.First).Prev = 0);
          pragma Assert (N (Container.Last).Next = 0);