* [Ada] Fix portability issues in access to subprograms
@ 2019-09-18 8:40 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2019-09-18 8:40 UTC (permalink / raw)
To: gcc-patches; +Cc: Javier Miranda
[-- Attachment #1: Type: text/plain, Size: 1467 bytes --]
This patch improves the portability of the code generated by the
compiler for access to subprograms. Written by Richard Kenner.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-09-18 Javier Miranda <miranda@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_N_Op_Eq): The frontend assumes that we can
do a bit-for-bit comparison of two access to protected
subprogram pointers. However, there are two reasons why we may
not be able to do that: (1) there may be padding bits for
alignment before the access to subprogram, and (2) the access to
subprogram itself may not be compared bit-for- bit because the
activation record part is undefined: two pointers are equal iff
the subprogram addresses are equal. This patch fixes it by
forcing a field-by-field comparison.
* bindgen.adb (Gen_Adainit): The type No_Param_Proc is defined
in the library as having Favor_Top_Level, but when we create an
object of that type in the binder file we don't have that
pragma, so the types are different. This patch fixes this issue.
* libgnarl/s-interr.adb, libgnarl/s-interr__hwint.adb,
libgnarl/s-interr__sigaction.adb, libgnarl/s-interr__vxworks.adb
(Is_Registered): This routine erroneously assumes that the
access to protected subprogram is two addresses. We need to
create the same record that the compiler makes to ensure that
any padding is the same. Then we have to look at just the first
word of the access to subprogram. This patch fixes this issue.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 6089 bytes --]
--- gcc/ada/bindgen.adb
+++ gcc/ada/bindgen.adb
@@ -524,6 +524,7 @@ package body Bindgen is
and then not Configurable_Run_Time_On_Target
then
WBI (" type No_Param_Proc is access procedure;");
+ WBI (" pragma Favor_Top_Level (No_Param_Proc);");
WBI ("");
end if;
--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -8221,6 +8221,32 @@ package body Exp_Ch4 is
Insert_Actions (N, Bodies, Suppress => All_Checks);
Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
end if;
+
+ -- If unnesting, handle elementary types whose Equivalent_Types are
+ -- records because there may be padding or undefined fields.
+
+ elsif Unnest_Subprogram_Mode
+ and then Ekind_In (Typl, E_Class_Wide_Type,
+ E_Class_Wide_Subtype,
+ E_Access_Subprogram_Type,
+ E_Access_Protected_Subprogram_Type,
+ E_Anonymous_Access_Protected_Subprogram_Type,
+ E_Access_Subprogram_Type,
+ E_Exception_Type)
+ and then Present (Equivalent_Type (Typl))
+ and then Is_Record_Type (Equivalent_Type (Typl))
+ then
+ Typl := Equivalent_Type (Typl);
+ Remove_Side_Effects (Lhs);
+ Remove_Side_Effects (Rhs);
+ Rewrite (N,
+ Expand_Record_Equality (N, Typl,
+ Unchecked_Convert_To (Typl, Lhs),
+ Unchecked_Convert_To (Typl, Rhs),
+ Bodies));
+
+ Insert_Actions (N, Bodies, Suppress => All_Checks);
+ Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
end if;
-- Test if result is known at compile time
@@ -9497,10 +9523,21 @@ package body Exp_Ch4 is
Typ : constant Entity_Id := Etype (Left_Opnd (N));
begin
- -- Case of elementary type with standard operator
+ -- Case of elementary type with standard operator. But if
+ -- unnesting, handle elementary types whose Equivalent_Types are
+ -- records because there may be padding or undefined fields.
if Is_Elementary_Type (Typ)
and then Sloc (Entity (N)) = Standard_Location
+ and then not (Ekind_In (Typ, E_Class_Wide_Type,
+ E_Class_Wide_Subtype,
+ E_Access_Subprogram_Type,
+ E_Access_Protected_Subprogram_Type,
+ E_Anonymous_Access_Protected_Subprogram_Type,
+ E_Access_Subprogram_Type,
+ E_Exception_Type)
+ and then Present (Equivalent_Type (Typ))
+ and then Is_Record_Type (Equivalent_Type (Typ)))
then
Binary_Op_Validity_Checks (N);
--- gcc/ada/libgnarl/s-interr.adb
+++ gcc/ada/libgnarl/s-interr.adb
@@ -545,9 +545,11 @@ package body System.Interrupts is
function Is_Registered (Handler : Parameterless_Handler) return Boolean is
+ type Acc_Proc is access procedure;
+
type Fat_Ptr is record
Object_Addr : System.Address;
- Handler_Addr : System.Address;
+ Handler_Addr : Acc_Proc;
end record;
function To_Fat_Ptr is new Ada.Unchecked_Conversion
@@ -565,7 +567,7 @@ package body System.Interrupts is
Ptr := Registered_Handler_Head;
while Ptr /= null loop
- if Ptr.H = Fat.Handler_Addr then
+ if Ptr.H = Fat.Handler_Addr.all'Address then
return True;
end if;
--- gcc/ada/libgnarl/s-interr__hwint.adb
+++ gcc/ada/libgnarl/s-interr__hwint.adb
@@ -561,9 +561,12 @@ package body System.Interrupts is
-------------------
function Is_Registered (Handler : Parameterless_Handler) return Boolean is
+
+ type Acc_Proc is access procedure;
+
type Fat_Ptr is record
Object_Addr : System.Address;
- Handler_Addr : System.Address;
+ Handler_Addr : Acc_Proc;
end record;
function To_Fat_Ptr is new Ada.Unchecked_Conversion
@@ -581,7 +584,7 @@ package body System.Interrupts is
Ptr := Registered_Handler_Head;
while Ptr /= null loop
- if Ptr.H = Fat.Handler_Addr then
+ if Ptr.H = Fat.Handler_Addr.all'Address then
return True;
end if;
--- gcc/ada/libgnarl/s-interr__sigaction.adb
+++ gcc/ada/libgnarl/s-interr__sigaction.adb
@@ -487,9 +487,11 @@ package body System.Interrupts is
function Is_Registered (Handler : Parameterless_Handler) return Boolean is
Ptr : R_Link := Registered_Handlers;
+ type Acc_Proc is access procedure;
+
type Fat_Ptr is record
Object_Addr : System.Address;
- Handler_Addr : System.Address;
+ Handler_Addr : Acc_Proc;
end record;
function To_Fat_Ptr is new Ada.Unchecked_Conversion
@@ -505,7 +507,7 @@ package body System.Interrupts is
Fat := To_Fat_Ptr (Handler);
while Ptr /= null loop
- if Ptr.H = Fat.Handler_Addr then
+ if Ptr.H = Fat.Handler_Addr.all'Address then
return True;
end if;
--- gcc/ada/libgnarl/s-interr__vxworks.adb
+++ gcc/ada/libgnarl/s-interr__vxworks.adb
@@ -578,9 +578,12 @@ package body System.Interrupts is
-------------------
function Is_Registered (Handler : Parameterless_Handler) return Boolean is
+
+ type Acc_Proc is access procedure;
+
type Fat_Ptr is record
Object_Addr : System.Address;
- Handler_Addr : System.Address;
+ Handler_Addr : Acc_Proc;
end record;
function To_Fat_Ptr is new Ada.Unchecked_Conversion
@@ -598,7 +601,7 @@ package body System.Interrupts is
Ptr := Registered_Handler_Head;
while Ptr /= null loop
- if Ptr.H = Fat.Handler_Addr then
+ if Ptr.H = Fat.Handler_Addr.all'Address then
return True;
end if;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2019-09-18 8:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-09-18 8:40 [Ada] Fix portability issues in access to subprograms Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).