gigi.h (standard_datatypes): Add ADT_fdesc_type and ADT_null_fdesc.
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 8 Apr 2008 18:12:53 +0000 (18:12 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Tue, 8 Apr 2008 18:12:53 +0000 (18:12 +0000)
* gigi.h (standard_datatypes): Add ADT_fdesc_type and ADT_null_fdesc.
(fdesc_type_node): Define.
(null_fdesc_node): Likewise.
* decl.c (gnat_to_gnu_entity) <E_Access_Subprogram_Type>: If the target
uses descriptors for vtables and the type comes from a dispatch table,
return the descriptor type.
* trans.c (Attribute_to_gnu) <Attr_Unrestricted_Access>: If the target
uses descriptors for vtables and the type comes from a dispatch table,
build a descriptor in the static case and copy the existing one in the
non-static case.
(gnat_to_gnu) <N_Null>: If the target uses descriptors for vtables and
the type is a pointer-to-subprogram coming from a dispatch table,
return the null descriptor.
<N_Unchecked_Type_Conversion>: If the target uses descriptors for
vtables, the source type is the descriptor type and the target type
is a pointer type, first build the pointer.
* utils.c (init_gigi_decls): If the target uses descriptors for vtables
build the descriptor type and the null descriptor.

From-SVN: r134101

gcc/ada/ChangeLog
gcc/ada/decl.c
gcc/ada/gigi.h
gcc/ada/trans.c
gcc/ada/utils.c

index 4121fe7..716f1bd 100644 (file)
@@ -1,5 +1,26 @@
 2008-04-08  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gigi.h (standard_datatypes): Add ADT_fdesc_type and ADT_null_fdesc.
+       (fdesc_type_node): Define.
+       (null_fdesc_node): Likewise.
+       * decl.c (gnat_to_gnu_entity) <E_Access_Subprogram_Type>: If the target
+       uses descriptors for vtables and the type comes from a dispatch table,
+       return the descriptor type.
+       * trans.c (Attribute_to_gnu) <Attr_Unrestricted_Access>: If the target
+       uses descriptors for vtables and the type comes from a dispatch table,
+       build a descriptor in the static case and copy the existing one in the
+       non-static case.
+       (gnat_to_gnu) <N_Null>: If the target uses descriptors for vtables and
+       the type is a pointer-to-subprogram coming from a dispatch table,
+       return the null descriptor.
+       <N_Unchecked_Type_Conversion>: If the target uses descriptors for
+       vtables, the source type is the descriptor type and the target type
+       is a pointer type, first build the pointer.
+       * utils.c (init_gigi_decls): If the target uses descriptors for vtables
+       build the descriptor type and the null descriptor.
+
+2008-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+
        * decl.c (prepend_attributes): Fix typo.
        * trans.c (Pragma_to_gnu): Likewise.
        * utils.c (gnat_genericize): Likewise.
index 545730b..aca69ff 100644 (file)
@@ -3089,6 +3089,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       break;
 
     case E_Access_Subprogram_Type:
+      /* Use the special descriptor type for dispatch tables if needed,
+        that is to say for the Prim_Ptr of a-tags.ads and its clones.
+        Note that we are only required to do so for static tables in
+        order to be compatible with the C++ ABI, but Ada 2005 allows
+        to extend library level tagged types at the local level so
+        we do it in the non-static case as well.  */
+      if (TARGET_VTABLE_USES_DESCRIPTORS
+         && Is_Dispatch_Table_Entity (gnat_entity))
+       {
+           gnu_type = fdesc_type_node;
+           gnu_size = TYPE_SIZE (gnu_type);
+           break;
+       }
+
+      /* ... fall through ... */
+
     case E_Anonymous_Access_Subprogram_Type:
       /* If we are not defining this entity, and we have incomplete
         entities being processed above us, make a dummy type and
index b356044..59a17ab 100644 (file)
@@ -373,8 +373,12 @@ enum standard_datatypes
   /* Type declaration node  <==> typedef void *T() */
   ADT_ptr_void_ftype,
 
-  /* A function declaration node for a run-time function for allocating memory.
-     Ada allocators cause calls to this function to be generated.   */
+  /* Type declaration node  <==> typedef virtual void *T() */
+  ADT_fdesc_type,
+
+  /* Null pointer for above type */
+  ADT_null_fdesc,
+
   ADT_malloc_decl,
 
   /* Likewise for freeing memory.  */
@@ -406,6 +410,8 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
 #define ptr_void_type_node gnat_std_decls[(int) ADT_ptr_void_type]
 #define void_ftype gnat_std_decls[(int) ADT_void_ftype]
 #define ptr_void_ftype gnat_std_decls[(int) ADT_ptr_void_ftype]
+#define fdesc_type_node gnat_std_decls[(int) ADT_fdesc_type]
+#define null_fdesc_node gnat_std_decls[(int) ADT_null_fdesc]
 #define malloc_decl gnat_std_decls[(int) ADT_malloc_decl]
 #define free_decl gnat_std_decls[(int) ADT_free_decl]
 #define jmpbuf_type gnat_std_decls[(int) ADT_jmpbuf_type]
index a6440d5..4dc5202 100644 (file)
@@ -852,6 +852,53 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
       if (attribute == Attr_Address)
        gnu_prefix = maybe_unconstrained_array (gnu_prefix);
 
+      /* If we are building a static dispatch table, we have to honor
+        TARGET_VTABLE_USES_DESCRIPTORS if we want to be compatible
+        with the C++ ABI.  We do it in the non-static case as well,
+        see gnat_to_gnu_entity, case E_Access_Subprogram_Type.  */
+      else if (TARGET_VTABLE_USES_DESCRIPTORS
+              && Is_Dispatch_Table_Entity (Etype (gnat_node)))
+       {
+         tree gnu_field, gnu_list = NULL_TREE, t;
+         /* Descriptors can only be built here for top-level functions.  */
+         bool build_descriptor = (global_bindings_p () != 0);
+         int i;
+
+         gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+         /* If we're not going to build the descriptor, we have to retrieve
+            the one which will be built by the linker (or by the compiler
+            later if a static chain is requested).  */
+         if (!build_descriptor)
+           {
+             gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_prefix);
+             gnu_result = fold_convert (build_pointer_type (gnu_result_type),
+                                        gnu_result);
+             gnu_result = build1 (INDIRECT_REF, gnu_result_type, gnu_result);
+           }
+
+         for (gnu_field = TYPE_FIELDS (gnu_result_type), i = 0;
+              i < TARGET_VTABLE_USES_DESCRIPTORS;
+              gnu_field = TREE_CHAIN (gnu_field), i++)
+           {
+             if (build_descriptor)
+               {
+                 t = build2 (FDESC_EXPR, TREE_TYPE (gnu_field), gnu_prefix,
+                             build_int_cst (NULL_TREE, i));
+                 TREE_CONSTANT (t) = 1;
+                 TREE_INVARIANT (t) = 1;
+               }
+             else
+               t = build3 (COMPONENT_REF, ptr_void_ftype, gnu_result,
+                           gnu_field, NULL_TREE);
+
+             gnu_list = tree_cons (gnu_field, t, gnu_list);
+           }
+
+         gnu_result = gnat_build_constructor (gnu_result_type, gnu_list);
+         break;
+       }
+
       /* ... fall through ... */
 
     case Attr_Access:
@@ -3649,7 +3696,12 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Null:
-      gnu_result = null_pointer_node;
+      if (TARGET_VTABLE_USES_DESCRIPTORS
+         && Ekind (Etype (gnat_node)) == E_Access_Subprogram_Type
+         && Is_Dispatch_Table_Entity (Etype (gnat_node)))
+       gnu_result = null_fdesc_node;
+      else
+       gnu_result = null_pointer_node;
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
       break;
 
@@ -3687,6 +3739,13 @@ gnat_to_gnu (Node_Id gnat_node)
               size_int (align / BITS_PER_UNIT), oalign / BITS_PER_UNIT);
        }
 
+      /* If we are converting a descriptor to a function pointer, first
+        build the pointer.  */
+      if (TARGET_VTABLE_USES_DESCRIPTORS
+         && TREE_TYPE (gnu_result) == fdesc_type_node
+         && POINTER_TYPE_P (gnu_result_type))
+       gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_result);
+
       gnu_result = unchecked_convert (gnu_result_type, gnu_result,
                                      No_Truncation (gnat_node));
       break;
index 1625484..76f4aab 100644 (file)
@@ -548,6 +548,27 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
   void_ftype = build_function_type (void_type_node, NULL_TREE);
   ptr_void_ftype = build_pointer_type (void_ftype);
 
+  /* Build the special descriptor type and its null node if needed.  */
+  if (TARGET_VTABLE_USES_DESCRIPTORS)
+    {
+      tree field_list = NULL_TREE, null_list = NULL_TREE;
+      int j;
+
+      fdesc_type_node = make_node (RECORD_TYPE);
+
+      for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
+       {
+         tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
+                                         fdesc_type_node, 0, 0, 0, 1);
+         TREE_CHAIN (field) = field_list;
+         field_list = field;
+         null_list = tree_cons (field, null_pointer_node, null_list);
+       }
+
+      finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
+      null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
+    }
+
   /* Now declare runtime functions. */
   endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);