Skip to content

R
riscv-gcc-1
Commit 392f673a by Matthew Heaney Committed by Arnaud Charlet
Options

a-cgcaso.adb, [...]: Implemented using heapsort instead of quicksort. 

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

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

From-SVN: r111036
parent ffabcde5
Showing with 145 additions and 163 deletions
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;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment