diff mbox series

[Ada] Use non-internal representation for access subprograms if UC to Address

Message ID 20220107162658.GA948113@adacore.com
State Committed
Commit a3c3de386bfce7910745386f727fe6b5f83d2906
Headers
Series [Ada] Use non-internal representation for access subprograms if UC to Address |

Commit Message

Pierre-Marie de Rodat Jan. 7, 2022, 4:26 p.m. UTC 
  If we have an Unchecked_Conversion between an access to subprogram and
System.Address, we want to try to use a thin subprogram pointer. Try to
do this automatically as much as possible and add one to the RTS.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/g-spipat.ads (Boolean_Func, Natural_Func,
	VString_Func): Mark as Favor_Top_Level.
	* sem_ch13.adb (Validate_Unchecked_Conversion): Avoid using
	internal representation if Unchecked_Conversion between
	an access to subprogram and System.Address within the same unit.
diff mbox series

Patch

diff --git a/gcc/ada/libgnat/g-spipat.ads b/gcc/ada/libgnat/g-spipat.ads
--- a/gcc/ada/libgnat/g-spipat.ads
+++ b/gcc/ada/libgnat/g-spipat.ads
@@ -654,19 +654,19 @@  package GNAT.Spitbol.Patterns is
    --  operations for constructing patterns that can be used in the pattern
    --  matching operations provided.
 
-   type Boolean_Func is access function return Boolean;
+   type Boolean_Func is access function return Boolean with Favor_Top_Level;
    --  General Boolean function type. When this type is used as a formal
    --  parameter type in this package, it indicates a deferred predicate
    --  pattern. The function will be called when the pattern element is
    --  matched and failure signalled if False is returned.
 
-   type Natural_Func is access function return Natural;
+   type Natural_Func is access function return Natural with Favor_Top_Level;
    --  General Natural function type. When this type is used as a formal
    --  parameter type in this package, it indicates a deferred pattern.
    --  The function will be called when the pattern element is matched
    --  to obtain the currently referenced Natural value.
 
-   type VString_Func is access function return VString;
+   type VString_Func is access function return VString with Favor_Top_Level;
    --  General VString function type. When this type is used as a formal
    --  parameter type in this package, it indicates a deferred pattern.
    --  The function will be called when the pattern element is matched


diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -17546,6 +17546,22 @@  package body Sem_Ch13 is
          Set_No_Strict_Aliasing (Implementation_Base_Type (Target));
       end if;
 
+      --  If the unchecked conversion is between Address and an access
+      --  subprogram type, show that we shouldn't use an internal
+      --  representation for the access subprogram type.
+
+      if Is_Access_Subprogram_Type (Target)
+        and then Is_Descendant_Of_Address (Source)
+        and then In_Same_Source_Unit (Target, N)
+      then
+         Set_Can_Use_Internal_Rep (Target, False);
+      elsif Is_Access_Subprogram_Type (Source)
+        and then Is_Descendant_Of_Address (Target)
+        and then In_Same_Source_Unit (Source, N)
+      then
+         Set_Can_Use_Internal_Rep (Source, False);
+      end if;
+
       --  Generate N_Validate_Unchecked_Conversion node for back end in case
       --  the back end needs to perform special validation checks.