From d4731b80de2a377fdbfa24dec34b15b5b680691c Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 15 Oct 2007 15:55:27 +0200 Subject: [PATCH] sem_case.adb, [...]: Replace use of Heap_Sort_A (passing'Unrestricted_Access of nested subprograms... 2007-10-15 Bob Duff * 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 --- gcc/ada/lib-sort.adb | 7 ++++--- gcc/ada/sem_case.adb | 9 ++++----- gcc/ada/sem_ch13.adb | 29 ++++++++++++++++------------- 3 files changed, 24 insertions(+), 21 deletions(-) diff --git a/gcc/ada/lib-sort.adb b/gcc/ada/lib-sort.adb index c20885eb573..24c11f02716 100644 --- a/gcc/ada/lib-sort.adb +++ b/gcc/ada/lib-sort.adb @@ -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 diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 5433bb1de9a..3a3e09f0199 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a632d0dfc87..df61a8e7cc0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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