[Ada] handle 'Code_Address on targets with function descriptors

[Ada] handle 'Code_Address on targets with function descriptors

[Olivier Hainque]

[-- Attachment #1: Type: text/plain, Size: 1718 bytes --]

For P a subprogram, P'Code_Address is expected to return
the address at which the machine code for P starts.

It differs from 'Address on targets where function
symbol names denote the address of a function descriptor,
a record from which the code address can be fetched
(e.g. on ppc-aix).

On such targets, P'Address is expected to return
the descriptor address, and it does.

P'Code_Address should fetch the code address from the,
descriptor but we have nothing in place to achieve that
today. It just returns the same as 'Address.

The attached patch is the gigi part of a change to
fix this, relying on a tm definition that we'll be
submitting later on.

With everything in place, the testcase below is expected
to display "OK".

Bootstrapped and regtested on x86_64-pc-linux-gnu

Olivier

2015-03-12  Olivier Hainque  <hainque@adacore.com>

	* gcc-interface/trans.c (Attribute_to_gnu) <Code_Address case>:
	On targets where a function symbol designates a function descriptor,
	fetch the function code address from the descriptor.

--

with System, Ada.Unchecked_Conversion;
with Ada.Text_IO; use Ada.Text_IO;

procedure Code_Addr_P is
   Addr, Code_Addr : System.Address;
   
   type Fn_Descriptor is record
      Fn_Address : System.Address;
   end record;

   type Descriptor_Access is access all Fn_Descriptor;
   function To_Descriptor_Access is
      new Ada.Unchecked_Conversion (System.Address, Descriptor_Access);
   
   Da : Descriptor_Access;
   
   use type System.Address;
begin
   Addr := Code_Addr_P'Address;
   Code_Addr := Code_Addr_P'Code_Address;
   
   Da := To_Descriptor_Access (Addr);
   if Da.Fn_Address /= Code_Addr then
      raise Program_Error;
   end if;
   
   Put_Line ("OK");
end;


[-- Attachment #2: fndesc.diff --]
[-- Type: application/octet-stream, Size: 2008 bytes --]

Index: trans.c
===================================================================
--- gcc/ada/gcc-interface/trans.c	(revision 313335)
+++ gcc/ada/gcc-interface/trans.c	(working copy)
@@ -155,6 +155,14 @@
 #define f_gnat_ret \
   DECL_STRUCT_FUNCTION (current_function_decl)->language->gnat_ret
 
+/* Expected to be defined from the tm headers, though not always available.
+   0 indicates that function symbols designate function descriptors on the
+   target so we don't need to use runtime descriptors of our own.  */
+
+#ifndef USE_RUNTIME_DESCRIPTORS
+#define USE_RUNTIME_DESCRIPTORS (-1)
+#endif
+
 /* A structure used to gather together information about a statement group.
    We use this to gather related statements, for example the "then" part
    of a IF.  In the case where it represents a lexical scope, we may also
@@ -1778,13 +1778,32 @@
 			  gnu_result_type, gnu_prefix);
 
       /* For 'Code_Address, find an inner ADDR_EXPR and mark it so that we
-	 don't try to build a trampoline.  */
+	 don't try to build a trampoline.  Then if the function address
+	 denotes a function descriptor on this target, fetch the code address
+	 from the descriptor.  */
       if (attribute == Attr_Code_Address)
 	{
 	  gnu_expr = remove_conversions (gnu_result, false);
 
 	  if (TREE_CODE (gnu_expr) == ADDR_EXPR)
 	    TREE_NO_TRAMPOLINE (gnu_expr) = TREE_CONSTANT (gnu_expr) = 1;
+
+	  /* On targets on which function symbols denote a function
+	     descriptor, the code address is always stored within the
+	     first slot of the descriptor.  */
+
+	  if (USE_RUNTIME_DESCRIPTORS == 0)
+	    {
+	      /* result = * ((result_type *) result),
+		 where we expect result to be of some pointer type already.  */
+
+	      const tree result_ptr_type
+		= build_pointer_type (gnu_result_type);
+
+	      gnu_result = build_unary_op
+		(INDIRECT_REF, gnu_result_type,
+		 convert (result_ptr_type, gnu_result));
+	    }
 	}
 
       /* For 'Access, issue an error message if the prefix is a C++ method