sem_case.adb, [...]: Replace use of Heap_Sort_A (passing'Unrestricted_Access of nested subprograms...

2007-10-15  Bob Duff  <duff@adacore.com>

	* sem_case.adb, sem_ch13.adb, lib-sort.adb: Replace use of Heap_Sort_A
	(passing'Unrestricted_Access of nested subprograms to Sort) with use of
	the generic Heap_Sort_G, in order to avoid trampolines.

From-SVN: r129327
This commit is contained in:
Bob Duff 2007-10-15 15:55:27 +02:00 committed by Arnaud Charlet
parent 28eba57cf2
commit d4731b80de
3 changed files with 24 additions and 21 deletions

View File

@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
with GNAT.Heap_Sort_G;
separate (Lib)
procedure Sort (Tbl : in out Unit_Ref_Table) is
@ -48,6 +48,8 @@ procedure Sort (Tbl : in out Unit_Ref_Table) is
procedure Move_Uname (From : Natural; To : Natural);
-- Move routine needed by the sorting routine below
package Sorting is new GNAT.Heap_Sort_G (Move_Uname, Lt_Uname);
--------------
-- Lt_Uname --
--------------
@ -88,8 +90,7 @@ begin
T (I) := Tbl (Int (I) - 1 + Tbl'First);
end loop;
Sort (T'Last,
Move_Uname'Unrestricted_Access, Lt_Uname'Unrestricted_Access);
Sorting.Sort (T'Last);
-- Sort is complete, copy result back into place

View File

@ -41,7 +41,7 @@ with Sinfo; use Sinfo;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
with GNAT.Heap_Sort_G;
package body Sem_Case is
@ -104,6 +104,8 @@ package body Sem_Case is
procedure Move_Choice (From : Natural; To : Natural);
-- Move routine for sorting the Choice_Table
package Sorting is new GNAT.Heap_Sort_G (Move_Choice, Lt_Choice);
procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
procedure Issue_Msg (Value1 : Uint; Value2 : Node_Id);
@ -215,10 +217,7 @@ package body Sem_Case is
return;
end if;
Sort
(Positive (Choice_Table'Last),
Move_Choice'Unrestricted_Access,
Lt_Choice'Unrestricted_Access);
Sorting.Sort (Positive (Choice_Table'Last));
Lo := Expr_Value (Choice_Table (1).Lo);
Hi := Expr_Value (Choice_Table (1).Hi);

View File

@ -54,7 +54,7 @@ with Ttypes; use Ttypes;
with Tbuild; use Tbuild;
with Urealp; use Urealp;
with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
with GNAT.Heap_Sort_G;
package body Sem_Ch13 is
@ -296,13 +296,15 @@ package body Sem_Ch13 is
declare
Comps : array (0 .. Num_CC) of Entity_Id;
-- Array to collect component and discrimninant entities. The data
-- starts at index 1, the 0'th entry is for GNAT.Heap_Sort_A.
-- starts at index 1, the 0'th entry is for the sort routine.
function CP_Lt (Op1, Op2 : Natural) return Boolean;
-- Compare routine for Sort (See GNAT.Heap_Sort_A)
-- Compare routine for Sort
procedure CP_Move (From : Natural; To : Natural);
-- Move routine for Sort (see GNAT.Heap_Sort_A)
-- Move routine for Sort
package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt);
Start : Natural;
Stop : Natural;
@ -353,7 +355,7 @@ package body Sem_Ch13 is
-- Sort by ascending position number
Sort (Num_CC, CP_Move'Unrestricted_Access, CP_Lt'Unrestricted_Access);
Sorting.Sort (Num_CC);
-- We now have all the components whose size does not exceed the max
-- machine scalar value, sorted by starting position. In this loop
@ -1107,7 +1109,7 @@ package body Sem_Ch13 is
if VM_Target = No_VM then
Set_Has_External_Tag_Rep_Clause (U_Ent);
else
elsif not Inspector_Mode then
Error_Msg_Name_1 := Attr;
Error_Msg_N
("% attribute unsupported in this configuration", Nam);
@ -1169,8 +1171,10 @@ package body Sem_Ch13 is
-- Object_Size attribute definition clause
when Attribute_Object_Size => Object_Size : declare
Size : constant Uint := Static_Integer (Expr);
Size : constant Uint := Static_Integer (Expr);
Biased : Boolean;
pragma Warnings (Off, Biased);
begin
if not Is_Type (U_Ent) then
@ -2438,10 +2442,12 @@ package body Sem_Ch13 is
-- Count of entries in OC_Fbit and OC_Lbit
function OC_Lt (Op1, Op2 : Natural) return Boolean;
-- Compare routine for Sort (See GNAT.Heap_Sort_A)
-- Compare routine for Sort
procedure OC_Move (From : Natural; To : Natural);
-- Move routine for Sort (see GNAT.Heap_Sort_A)
-- Move routine for Sort
package Sorting is new GNAT.Heap_Sort_G (OC_Move, OC_Lt);
function OC_Lt (Op1, Op2 : Natural) return Boolean is
begin
@ -2476,10 +2482,7 @@ package body Sem_Ch13 is
Next (CC);
end loop;
Sort
(OC_Count,
OC_Move'Unrestricted_Access,
OC_Lt'Unrestricted_Access);
Sorting.Sort (OC_Count);
Overlap_Check_Required := False;
for J in 1 .. OC_Count - 1 loop