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:
parent
28eba57cf2
commit
d4731b80de
@ -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
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user