ada-tree.h (TREE_THIS_NOTRAP): Redefine.

	* gcc-interface/ada-tree.h (TREE_THIS_NOTRAP): Redefine.
	* gcc-interface/trans.c (Identifier_to_gnu): Factor out common code in
	the by-ref case.  Do not set TREE_READONLY on a renamed object.  Set
	TREE_THIS_NOTRAP on UNCONSTRAINED_ARRAY_REF nodes.
	(Attribute_to_gnu) <Attr_Length>: Expand the use of the parameter cache
	to the indirect case.
	* gcc-interface/utils.c (convert) <UNCONSTRAINED_ARRAY_REF>: Preserve
	the TREE_THIS_NOTRAP flag.

From-SVN: r179171

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ac679302bf6e7a9a3c36bc958ad1b41276ef7f62..eab2ec8c52a23e9f35b6491680232f7616be3b89 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2011-09-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/ada-tree.h (TREE_THIS_NOTRAP): Redefine.
+       * gcc-interface/trans.c (Identifier_to_gnu): Factor out common code in
+       the by-ref case.  Do not set TREE_READONLY on a renamed object.  Set
+       TREE_THIS_NOTRAP on UNCONSTRAINED_ARRAY_REF nodes.
+       (Attribute_to_gnu) <Attr_Length>: Expand the use of the parameter cache
+       to the indirect case.
+       * gcc-interface/utils.c (convert) <UNCONSTRAINED_ARRAY_REF>: Preserve
+       the TREE_THIS_NOTRAP flag.
+
 2011-09-25  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (Loop_Statement_to_gnu): In the case of an

diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 2d0e6e4945e189a8a10d5089293c6a7d0ac056e7..150dd8654deba1d341b9c552078176d7d4f8ea5e 100644 (file)
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -426,6 +426,15 @@ do {                                                  \
   SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
 
 
+/* Flags added to ref nodes.  */
+
+/* Nonzero means this node will not trap.  */
+#undef TREE_THIS_NOTRAP
+#define TREE_THIS_NOTRAP(NODE) \
+  (TREE_CHECK4 (NODE, INDIRECT_REF, ARRAY_REF, UNCONSTRAINED_ARRAY_REF, \
+               ARRAY_RANGE_REF)->base.nothrow_flag)
+
+
 /* Fields and macros for statements.  */
 #define IS_ADA_STMT(NODE) \
   (STATEMENT_CLASS_P (NODE) && TREE_CODE (NODE) >= STMT_STMT)

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 2f41ad3309db418feac75a27a6bec8bbb7d24e3d..73579861998ec57a37378d6a3d475a4bb57115f8 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -989,8 +989,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
              && DECL_BY_COMPONENT_PTR_P (gnu_result))))
     {
       const bool read_only = DECL_POINTS_TO_READONLY_P (gnu_result);
-      tree renamed_obj;
 
+      /* First do the first dereference if needed.  */
       if (TREE_CODE (gnu_result) == PARM_DECL
          && DECL_BY_DOUBLE_REF_P (gnu_result))
        {
@@ -999,42 +999,37 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
            TREE_THIS_NOTRAP (gnu_result) = 1;
        }
 
+      /* If it's a PARM_DECL to foreign convention subprogram, convert it.  */
       if (TREE_CODE (gnu_result) == PARM_DECL
          && DECL_BY_COMPONENT_PTR_P (gnu_result))
-       {
-         gnu_result
-           = build_unary_op (INDIRECT_REF, NULL_TREE,
-                             convert (build_pointer_type (gnu_result_type),
-                                      gnu_result));
-         if (TREE_CODE (gnu_result) == INDIRECT_REF)
-           TREE_THIS_NOTRAP (gnu_result) = 1;
-       }
+       gnu_result
+         = convert (build_pointer_type (gnu_result_type), gnu_result);
+
+      /* If it's a CONST_DECL, return the underlying constant like below.  */
+      else if (TREE_CODE (gnu_result) == CONST_DECL)
+       gnu_result = DECL_INITIAL (gnu_result);
 
       /* If it's a renaming pointer and we are at the right binding level,
         we can reference the renamed object directly, since the renamed
         expression has been protected against multiple evaluations.  */
-      else if (TREE_CODE (gnu_result) == VAR_DECL
-              && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result))
-              && (!DECL_RENAMING_GLOBAL_P (gnu_result)
-                  || global_bindings_p ()))
-       gnu_result = renamed_obj;
-
-      /* Return the underlying CST for a CONST_DECL like a few lines below,
-        after dereferencing in this case.  */
-      else if (TREE_CODE (gnu_result) == CONST_DECL)
-       gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
-                                    DECL_INITIAL (gnu_result));
+      if (TREE_CODE (gnu_result) == VAR_DECL
+         && DECL_RENAMED_OBJECT (gnu_result)
+         && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ()))
+       gnu_result = DECL_RENAMED_OBJECT (gnu_result);
 
+      /* Otherwise, do the final dereference.  */
       else
        {
          gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
-         if (TREE_CODE (gnu_result) == INDIRECT_REF
+
+         if ((TREE_CODE (gnu_result) == INDIRECT_REF
+              || TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF)
              && No (Address_Clause (gnat_temp)))
            TREE_THIS_NOTRAP (gnu_result) = 1;
-       }
 
-      if (read_only)
-       TREE_READONLY (gnu_result) = 1;
+         if (read_only)
+           TREE_READONLY (gnu_result) = 1;
+       }
     }
 
   /* The GNAT tree has the type of a function as the type of its result.  Also
@@ -1597,11 +1592,26 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
        /* Make sure any implicit dereference gets done.  */
        gnu_prefix = maybe_implicit_deref (gnu_prefix);
        gnu_prefix = maybe_unconstrained_array (gnu_prefix);
+
        /* We treat unconstrained array In parameters specially.  */
-       if (Nkind (Prefix (gnat_node)) == N_Identifier
-           && !Is_Constrained (Etype (Prefix (gnat_node)))
-           && Ekind (Entity (Prefix (gnat_node))) == E_In_Parameter)
-         gnat_param = Entity (Prefix (gnat_node));
+       if (!Is_Constrained (Etype (Prefix (gnat_node))))
+         {
+           Node_Id gnat_prefix = Prefix (gnat_node);
+
+           /* This is the direct case.  */
+           if (Nkind (gnat_prefix) == N_Identifier
+               && Ekind (Entity (gnat_prefix)) == E_In_Parameter)
+             gnat_param = Entity (gnat_prefix);
+
+           /* This is the indirect case.  Note that we need to be sure that
+              the access value cannot be null as we'll hoist the load.  */
+           if (Nkind (gnat_prefix) == N_Explicit_Dereference
+               && Nkind (Prefix (gnat_prefix)) == N_Identifier
+               && Ekind (Entity (Prefix (gnat_prefix))) == E_In_Parameter
+               && Can_Never_Be_Null (Entity (Prefix (gnat_prefix))))
+             gnat_param = Entity (Prefix (gnat_prefix));
+         }
+
        gnu_type = TREE_TYPE (gnu_prefix);
        prefix_unused = true;
        gnu_result_type = get_unpadded_type (Etype (gnat_node));

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 0176c3ea0c43fc5f01c35c62eb932f5ab664dc18..de9256ae17d67bc911f9b89e2cf1e364021b600b 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3947,17 +3947,21 @@ convert (tree type, tree expr)
       break;
 
     case UNCONSTRAINED_ARRAY_REF:
-      /* Convert this to the type of the inner array by getting the address of
-        the array from the template.  */
-      expr = TREE_OPERAND (expr, 0);
-      expr = build_unary_op (INDIRECT_REF, NULL_TREE,
-                            build_component_ref (expr, NULL_TREE,
-                                                 TYPE_FIELDS
-                                                 (TREE_TYPE (expr)),
-                                                 false));
-      etype = TREE_TYPE (expr);
-      ecode = TREE_CODE (etype);
-      break;
+      {
+       /* Convert this to the type of the inner array by getting the address
+          of the array from the template.  */
+       const bool no_trap = TREE_THIS_NOTRAP (expr);
+       expr = TREE_OPERAND (expr, 0);
+       expr = build_unary_op (INDIRECT_REF, NULL_TREE,
+                              build_component_ref (expr, NULL_TREE,
+                                                   TYPE_FIELDS
+                                                   (TREE_TYPE (expr)),
+                                                   false));
+       TREE_THIS_NOTRAP (expr) = no_trap;
+       etype = TREE_TYPE (expr);
+       ecode = TREE_CODE (etype);
+       break;
+      }
 
     case VIEW_CONVERT_EXPR:
       {
@@ -3992,8 +3996,9 @@ convert (tree type, tree expr)
                     && !TYPE_IS_FAT_POINTER_P (etype))
              return convert (type, op0);
          }
+
+       break;
       }
-      break;
 
     default:
       break;