[Ada] remove trampolines from front end
Arnaud Charlet
charlet@adacore.com
Fri Oct 19 11:24:00 GMT 2007
Tested on i686-linux, committed on trunk.
Remove all code from the front end that causes trampolines to be
generated. This is so we can run on systems with DEP (data execution
protection) enabled. This required replacing all uses of Heap_Sort_A (passing
'Unrestricted_Access of nested subprograms to Sort) with uses of the generic
Heap_Sort_G. In addition, it required moving Sem_Res.Is_Definite_Access_Type to
the outermost level, so 'Access of it doesn't generate a trampoline.
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.
-------------- next part --------------
Index: sem_case.adb
===================================================================
--- sem_case.adb (revision 129312)
+++ sem_case.adb (working copy)
@@ -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);
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 129312)
+++ sem_ch13.adb (working copy)
@@ -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
Index: lib-sort.adb
===================================================================
--- lib-sort.adb (revision 129312)
+++ lib-sort.adb (working copy)
@@ -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_Ta
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
More information about the Gcc-patches
mailing list