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

2 files changed, 145 insertions, 163 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;
diff --git a/gcc/ada/a-cgcaso.adb b/gcc/ada/a-cgcaso.adb
index bef6fb0793a..43ddb645b04 100644
--- a/gcc/ada/a-cgcaso.adb
+++ b/gcc/ada/a-cgcaso.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,130 +34,102 @@
 -- This unit has originally being developed by Matthew J Heaney.            --
 ------------------------------------------------------------------------------
 
+--  This algorithm was adapted from GNAT.Heap_Sort_G (see g-hesorg.ad[sb]).
+
+with System;
+
 procedure Ada.Containers.Generic_Constrained_Array_Sort
   (Container : in out Array_Type)
 is
-   function Is_Less (I, J : Index_Type) return Boolean;
-   pragma Inline (Is_Less);
+   type T is range System.Min_Int .. System.Max_Int;
 
-   procedure Swap (I, J : Index_Type);
-   pragma Inline (Swap);
+   function To_Index (J : T) return Index_Type;
+   pragma Inline (To_Index);
 
-   procedure Sort (First, Last : Index_Type'Base);
+   procedure Sift (S : T);
 
-   -------------
-   -- Is_Less --
-   -------------
+   A : Array_Type renames Container;
 
-   function Is_Less (I, J : Index_Type) return Boolean is
+   --------------
+   -- To_Index --
+   --------------
+
+   function To_Index (J : T) return Index_Type is
+      K : constant T'Base := Index_Type'Pos (A'First) + J - T'(1);
    begin
-      return Container (I) < Container (J);
-   end Is_Less;
+      return Index_Type'Val (K);
+   end To_Index;
+
+   Max  : T := A'Length;
+   Temp : Element_Type;
 
    ----------
-   -- Sort --
+   -- Sift --
    ----------
 
-   procedure Sort (First, Last : Index_Type'Base) is
-      Pivot, Lo, Mid, Hi : Index_Type;
+   procedure Sift (S : T) is
+      C   : T := S;
+      Son : T;
 
    begin
-      if Last <= First then
-         return;
-      end if;
-
-      Lo := First;
-      Hi := Last;
-
-      if Last = Index_Type'Succ (First) then
-         if not Is_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 Is_Less (Lo, Mid) then
-         if Is_Less (Lo, Hi) then
-            if Is_Less (Mid, Hi) then
-               Swap (Lo, Mid);
-            else
-               Swap (Lo, Hi);
-            end if;
+      loop
+         Son := 2 * C;
 
-         else
-            null;  --  lo is median
-         end if;
+         exit when Son > Max;
 
-      elsif Is_Less (Lo, Hi) then
-         null; --  lo is median
+         declare
+            Son_Index : Index_Type := To_Index (Son);
 
-      elsif Is_Less (Mid, Hi) then
-         Swap (Lo, Hi);
-
-      else
-         Swap (Lo, Mid);
-      end if;
+         begin
+            if Son < Max then
+               if A (Son_Index) < A (Index_Type'Succ (Son_Index)) then
+                  Son := Son + 1;
+                  Son_Index := Index_Type'Succ (Son_Index);
+               end if;
+            end if;
 
-      Pivot := Lo;
+            A (To_Index (C)) := A (Son_Index);  -- Move (Son, C);
+         end;
 
-      Outer : loop
-         loop
-            exit Outer when not (Pivot < Hi);
+         C := Son;
+      end loop;
 
-            if Is_Less (Hi, Pivot) then
-               Swap (Hi, Pivot);
-               Pivot := Hi;
-               Lo := Index_Type'Succ (Lo);
-               exit;
-            else
-               Hi := Index_Type'Pred (Hi);
-            end if;
-         end loop;
+      while C /= S loop
+         declare
+            Father      : constant T := C / 2;
+            Father_Elem : Element_Type renames A (To_Index (Father));
 
-         loop
-            exit Outer when not (Lo < Pivot);
+         begin
+            if Father_Elem < Temp then           -- Lt (Father, 0)
+               A (To_Index (C)) := Father_Elem;  -- Move (Father, C)
+               C := Father;
 
-            if Is_Less (Lo, Pivot) then
-               Lo := Index_Type'Succ (Lo);
             else
-               Swap (Lo, Pivot);
-               Pivot := Lo;
-               Hi := Index_Type'Pred (Hi);
                exit;
             end if;
-         end loop;
-      end loop Outer;
-
-      Sort (First, Index_Type'Pred (Pivot));
-      Sort (Index_Type'Succ (Pivot), Last);
-   end Sort;
+         end;
+      end loop;
 
-   ----------
-   -- Swap --
-   ----------
-
-   procedure Swap (I, J : Index_Type) is
-      EI : constant Element_Type := Container (I);
-   begin
-      Container (I) := Container (J);
-      Container (J) := EI;
-   end Swap;
+      A (To_Index (C)) := Temp; -- Move (0, C);
+   end Sift;
 
 --  Start of processing for Generic_Constrained_Array_Sort
 
 begin
-   Sort (Container'First, Container'Last);
+   for J in reverse 1 .. Max / 2 loop
+      Temp := Container (To_Index (J)); --  Move (J, 0);
+      Sift (J);
+   end loop;
+
+   while Max > 1 loop
+      declare
+         Max_Elem : Element_Type renames A (To_Index (Max));
+      begin
+         Temp := Max_Elem;         --  Move (Max, 0);
+         Max_Elem := A (A'First);  --  Move (1, Max);
+      end;
+
+      Max := Max - 1;
+      Sift (1);
+   end loop;
 end Ada.Containers.Generic_Constrained_Array_Sort;