mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-30 23:35:00 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

[Ada] Improve performance of Ada.Containers.Doubly_Linked_Lists.Generic_Sorting.Sort

Browse Source 
gcc/ada/

	* libgnat/a-cdlili.adb: Reimplement
	Ada.Containers.Doubly_Linked_Lists.Generic_Sorting.Sort using
	Mergesort instead of the previous Quicksort variant.
This commit is contained in:
Steve Baird 2021-06-09 07:29:11 -07:00 committed by Pierre-Marie de Rodat
parent 66d43665bc
commit d206399a97
1 changed files with 161 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

219
gcc/ada/libgnat/a-cdlili.adb
View File

@ -675,68 +675,152 @@ is
procedure Sort (Container : in out List) is
procedure Partition (Pivot : Node_Access; Back : Node_Access);
type List_Descriptor is
record
First, Last : Node_Access;
Length : Count_Type;
end record;
procedure Sort (Front, Back : Node_Access);
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.
---------------
-- Partition --
---------------
----------------
-- Merge_Sort --
----------------
procedure Partition (Pivot : Node_Access; Back : Node_Access) is
Node : Node_Access;
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
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;
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);
if Arg.Length < 2 then
-- already sorted
return Arg;
end if;
end Sort;
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
@ -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);