From d206399a97bc0111cff30c66c535ce0884228b77 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Wed, 9 Jun 2021 07:29:11 -0700 Subject: [PATCH] [Ada] Improve performance of Ada.Containers.Doubly_Linked_Lists.Generic_Sorting.Sort gcc/ada/ * libgnat/a-cdlili.adb: Reimplement Ada.Containers.Doubly_Linked_Lists.Generic_Sorting.Sort using Mergesort instead of the previous Quicksort variant. --- gcc/ada/libgnat/a-cdlili.adb | 219 +++++++++++++++++++++++++++++++------------ 1 file changed, 161 insertions(+), 58 deletions(-) diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb index 75961a2..d989751 100644 --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -675,68 +675,152 @@ is procedure Sort (Container : in out List) is - procedure Partition (Pivot : Node_Access; Back : Node_Access); - - procedure Sort (Front, Back : Node_Access); - - --------------- - -- Partition -- - --------------- + 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 - procedure Partition (Pivot : Node_Access; Back : Node_Access) is - Node : Node_Access; + 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 - Node := Pivot.Next; - while Node /= Back loop - if Node.Element < Pivot.Element 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; + if Arg.Length < 2 then + -- already sorted + return Arg; + end if; - else - Node := Node.Next; - end if; - end loop; - end Partition; + declare + Part1, Part2 : List_Descriptor; + begin + Split_List (Unsplit => Arg, Part1 => Part1, Part2 => Part2); - ---------- - -- Sort -- - ---------- + Part1 := Merge_Sort (Part1); + Part2 := Merge_Sort (Part2); - 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; + return Merge_Parts (Part1, Part2); + end; + end Merge_Sort; -- Start of processing for Sort @@ -754,9 +838,28 @@ is -- element tampering by a generic actual subprogram. declare - Lock : With_Lock (Container.TC'Unchecked_Access); + Lock : With_Lock (Container.TC'Unchecked_Access); + + Unsorted : constant List_Descriptor := + (First => Container.First, + Last => Container.Last, + Length => Container.Length); + + Sorted : List_Descriptor; begin - Sort (Front => null, Back => null); + -- 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; end; pragma Assert (Container.First.Prev = null); -- 2.7.4