2006-02-13 Matthew Heaney <heaney@adacore.com>

	* a-cgcaso.adb, a-cgaaso.adb: Implemented using heapsort instead of
	quicksort.



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

1 files changed, 76 insertions, 66 deletions

diff --git a/gcc/ada/a-cgaaso.adb b/gcc/ada/a-cgaaso.adb
index cd4cfaba076..b91de5fc55a 100644
--- a/gcc/ada/a-cgaaso.adb
+++ b/gcc/ada/a-cgaaso.adb
@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -34,93 +34,103 @@
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
 
+--  This algorithm was adapted from GNAT.Heap_Sort (see g-heasor.ad[sb]).
+
+with System;
+
 procedure Ada.Containers.Generic_Anonymous_Array_Sort
   (First, Last : Index_Type'Base)
 is
-   Pivot, Lo, Mid, Hi : Index_Type;
+   type T is range System.Min_Int .. System.Max_Int;
 
-begin
-   if Last <= First then
-      return;
-   end if;
-
-   Lo := First;
-   Hi := Last;
-
-   if Last = Index_Type'Succ (First) then
-      if not Less (Lo, Hi) then
-         Swap (Lo, Hi);
-      end if;
-
-      return;
-   end if;
-
-   Mid := Index_Type'Val
-     (Index_Type'Pos (Lo) +
-      (Index_Type'Pos (Hi) - Index_Type'Pos (Lo)) / 2);
-
-   --  We need to figure out which case we have:
-   --  x < y < z
-   --  x < z < y
-   --  z < x < y
-   --  y < x < z
-   --  y < z < x
-   --  z < y < x
-
-   if Less (Lo, Mid) then
-      if Less (Lo, Hi) then
-         if Less (Mid, Hi) then
-            Swap (Lo, Mid);
+   function To_Index (J : T) return Index_Type;
+   pragma Inline (To_Index);
 
-         else
-            Swap (Lo, Hi);
+   function Lt (J, K : T) return Boolean;
+   pragma Inline (Lt);
 
-         end if;
+   procedure Xchg (J, K : T);
+   pragma Inline (Xchg);
+
+   procedure Sift (S : T);
+
+   --------------
+   -- To_Index --
+   --------------
+
+   function To_Index (J : T) return Index_Type is
+      K : constant T'Base := Index_Type'Pos (First) + J - T'(1);
+   begin
+      return Index_Type'Val (K);
+   end To_Index;
 
-      else
-         null;  --  lo is median
-      end if;
+   --------
+   -- Lt --
+   --------
 
-   elsif Less (Lo, Hi) then
-      null; --  lo is median
+   function Lt (J, K : T) return Boolean is
+   begin
+      return Less (To_Index (J), To_Index (K));
+   end Lt;
 
-   elsif Less (Mid, Hi) then
-      Swap (Lo, Hi);
+   ----------
+   -- Xchg --
+   ----------
 
-   else
-      Swap (Lo, Mid);
-   end if;
+   procedure Xchg (J, K : T) is
+   begin
+      Swap (To_Index (J), To_Index (K));
+   end Xchg;
 
-   Pivot := Lo;
-   Outer : loop
+   Max : T := Index_Type'Pos (Last) - Index_Type'Pos (First) + T'(1);
+
+   ----------
+   -- Sift --
+   ----------
+
+   procedure Sift (S : T) is
+      C      : T := S;
+      Son    : T;
+      Father : T;
+
+   begin
       loop
-         exit Outer when not (Pivot < Hi);
+         Son := C + C;
 
-         if Less (Hi, Pivot) then
-            Swap (Hi, Pivot);
-            Pivot := Hi;
-            Lo := Index_Type'Succ (Lo);
+         if Son < Max then
+            if Lt (Son, Son + 1) then
+               Son := Son + 1;
+            end if;
+         elsif Son > Max then
             exit;
-         else
-            Hi := Index_Type'Pred (Hi);
          end if;
+
+         Xchg (Son, C);
+         C := Son;
       end loop;
 
-      loop
-         exit Outer when not (Lo < Pivot);
+      while C /= S loop
+         Father := C / 2;
 
-         if Less (Lo, Pivot) then
-            Lo := Index_Type'Succ (Lo);
+         if Lt (Father, C) then
+            Xchg (Father, C);
+            C := Father;
          else
-            Swap (Lo, Pivot);
-            Pivot := Lo;
-            Hi := Index_Type'Pred (Hi);
             exit;
          end if;
       end loop;
-   end loop Outer;
+   end Sift;
 
-   Generic_Anonymous_Array_Sort (First, Index_Type'Pred (Pivot));
-   Generic_Anonymous_Array_Sort (Index_Type'Succ (Pivot), Last);
+--  Start of processing for Generic_Anonymous_Array_Sort
 
+begin
+   for J in reverse 1 .. Max / 2 loop
+      Sift (J);
+   end loop;
+
+   while Max > 1 loop
+      Xchg (1, Max);
+      Max := Max - 1;
+      Sift (1);
+   end loop;
 end Ada.Containers.Generic_Anonymous_Array_Sort;