decl.c (gnat_to_gnu_entity): Create a mere scalar constant instead of a reference...
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 15 Apr 2014 09:23:21 +0000 (09:23 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Tue, 15 Apr 2014 09:23:21 +0000 (09:23 +0000)
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create a mere
scalar constant instead of a reference for renaming of scalar literal.
Do not create a new object for constant renaming except for a function
call.  Make sure a VAR_DECL is created for the renaming pointer.
* gcc-interface/trans.c (constant_decl_with_initializer_p): New.
(fold_constant_decl_in_expr): New function.
(Identifier_to_gnu): Use constant_decl_with_initializer_p.
For a constant renaming, try to fold a constant DECL in the result.
(lvalue_required_p) <N_Object_Renaming_Declaration>: Always return 1.
(Identifier_to_gnu): Reference the renamed object of constant renaming
pointers directly.
(Case_Statement_to_gnu): Do not re-fold the bounds of integer types.
Assert that the case values are constant.
* gcc-interface/utils.c (invalidate_global_renaming_pointers): Do not
invalidate constant renaming pointers.

Co-Authored-By: Pierre-Marie de Rodat <derodat@adacore.com>
From-SVN: r209411

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c

index 7f66b56..090f121 100644 (file)
@@ -1,4 +1,23 @@
 2014-04-15  Eric Botcazou  <ebotcazou@adacore.com>
+            Pierre-Marie de Rodat  <derodat@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create a mere
+       scalar constant instead of a reference for renaming of scalar literal.
+       Do not create a new object for constant renaming except for a function
+       call.  Make sure a VAR_DECL is created for the renaming pointer.
+       * gcc-interface/trans.c (constant_decl_with_initializer_p): New.
+       (fold_constant_decl_in_expr): New function.
+       (Identifier_to_gnu): Use constant_decl_with_initializer_p.
+       For a constant renaming, try to fold a constant DECL in the result.
+       (lvalue_required_p) <N_Object_Renaming_Declaration>: Always return 1.
+       (Identifier_to_gnu): Reference the renamed object of constant renaming
+       pointers directly.
+       (Case_Statement_to_gnu): Do not re-fold the bounds of integer types.
+       Assert that the case values are constant.
+       * gcc-interface/utils.c (invalidate_global_renaming_pointers): Do not
+       invalidate constant renaming pointers.
+
+2014-04-15  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/utils.c (type_for_vector_element_p): New predicate.
        (build_vector_type_for_size): New function.
index aed49b7..7c3f7e5 100644 (file)
@@ -960,18 +960,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              gnu_type = TREE_TYPE (gnu_expr);
 
            /* Case 1: If this is a constant renaming stemming from a function
-              call, treat it as a normal object whose initial value is what
-              is being renamed.  RM 3.3 says that the result of evaluating a
-              function call is a constant object.  As a consequence, it can
-              be the inner object of a constant renaming.  In this case, the
-              renaming must be fully instantiated, i.e. it cannot be a mere
-              reference to (part of) an existing object.  */
+              call, treat it as a normal object whose initial value is what is
+              being renamed.  RM 3.3 says that the result of evaluating a
+              function call is a constant object.  Treat constant literals
+              the same way.  As a consequence, it can be the inner object of
+              a constant renaming.  In this case, the renaming must be fully
+              instantiated, i.e. it cannot be a mere reference to (part of) an
+              existing object.  */
            if (const_flag)
              {
                tree inner_object = gnu_expr;
                while (handled_component_p (inner_object))
                  inner_object = TREE_OPERAND (inner_object, 0);
-               if (TREE_CODE (inner_object) == CALL_EXPR)
+               if (TREE_CODE (inner_object) == CALL_EXPR
+                   || CONSTANT_CLASS_P (inner_object))
                  create_normal_object = true;
              }
 
@@ -1030,15 +1032,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                       about that failure.  */
                  }
 
-               /* Case 3: If this is a constant renaming and creating a
-                  new object is allowed and cheap, treat it as a normal
-                  object whose initial value is what is being renamed.  */
-               if (const_flag
-                   && !Is_Composite_Type
-                       (Underlying_Type (Etype (gnat_entity))))
-                 ;
-
-               /* Case 4: Make this into a constant pointer to the object we
+               /* Case 3: Make this into a constant pointer to the object we
                   are to rename and attach the object to the pointer if it is
                   something we can stabilize.
 
@@ -1050,68 +1044,59 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                   The pointer is called a "renaming" pointer in this case.
 
                   In the rare cases where we cannot stabilize the renamed
-                  object, we just make a "bare" pointer, and the renamed
-                  entity is always accessed indirectly through it.  */
-               else
-                 {
-                   /* We need to preserve the volatileness of the renamed
-                      object through the indirection.  */
-                   if (TREE_THIS_VOLATILE (gnu_expr)
-                       && !TYPE_VOLATILE (gnu_type))
-                     gnu_type
-                       = build_qualified_type (gnu_type,
-                                               (TYPE_QUALS (gnu_type)
-                                                | TYPE_QUAL_VOLATILE));
-                   gnu_type = build_reference_type (gnu_type);
-                   inner_const_flag = TREE_READONLY (gnu_expr);
-                   const_flag = true;
-
-                   /* If the previous attempt at stabilizing failed, there
-                      is no point in trying again and we reuse the result
-                      without attaching it to the pointer.  In this case it
-                      will only be used as the initializing expression of
-                      the pointer and thus needs no special treatment with
-                      regard to multiple evaluations.  */
-                   if (maybe_stable_expr)
-                     ;
-
-                   /* Otherwise, try to stabilize and attach the expression
-                      to the pointer if the stabilization succeeds.
-
-                      Note that this might introduce SAVE_EXPRs and we don't
-                      check whether we're at the global level or not.  This
-                      is fine since we are building a pointer initializer and
-                      neither the pointer nor the initializing expression can
-                      be accessed before the pointer elaboration has taken
-                      place in a correct program.
-
-                      These SAVE_EXPRs will be evaluated at the right place
-                      by either the evaluation of the initializer for the
-                      non-global case or the elaboration code for the global
-                      case, and will be attached to the elaboration procedure
-                      in the latter case.  */
-                   else
-                    {
-                       maybe_stable_expr
-                         = gnat_stabilize_reference (gnu_expr, true, &stable);
+                  object, we just make a "bare" pointer and the renamed
+                  object will always be accessed indirectly through it.
+
+                  Note that we need to preserve the volatility of the renamed
+                  object through the indirection.  */
+               if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
+                 gnu_type = build_qualified_type (gnu_type,
+                                                  (TYPE_QUALS (gnu_type)
+                                                   | TYPE_QUAL_VOLATILE));
+               gnu_type = build_reference_type (gnu_type);
+               inner_const_flag = TREE_READONLY (gnu_expr);
+               const_flag = true;
 
-                       if (stable)
-                         renamed_obj = maybe_stable_expr;
+               /* If the previous attempt at stabilizing failed, there is
+                  no point in trying again and we reuse the result without
+                  attaching it to the pointer.  In this case it will only
+                  be used as the initializing expression of the pointer and
+                  thus needs no special treatment with regard to multiple
+                  evaluations.
+
+                  Otherwise, try to stabilize and attach the expression to
+                  the pointer if the stabilization succeeds.
+
+                  Note that this might introduce SAVE_EXPRs and we don't
+                  check whether we are at the global level or not.  This
+                  is fine since we are building a pointer initializer and
+                  neither the pointer nor the initializing expression can
+                  be accessed before the pointer elaboration has taken
+                  place in a correct program.
+
+                  These SAVE_EXPRs will be evaluated at the right place
+                  by either the evaluation of the initializer for the
+                  non-global case or the elaboration code for the global
+                  case, and will be attached to the elaboration procedure
+                  in the latter case.  */
+               if (!maybe_stable_expr)
+                 {
+                   maybe_stable_expr
+                     = gnat_stabilize_reference (gnu_expr, true, &stable);
 
-                       /* Attaching is actually performed downstream, as soon
-                          as we have a VAR_DECL for the pointer we make.  */
-                     }
+                   if (stable)
+                     renamed_obj = maybe_stable_expr;
+                 }
 
-                   if (type_annotate_only
-                       && TREE_CODE (maybe_stable_expr) == ERROR_MARK)
-                     gnu_expr = NULL_TREE;
-                   else
-                     gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
-                                                maybe_stable_expr);
+               if (type_annotate_only
+                   && TREE_CODE (maybe_stable_expr) == ERROR_MARK)
+                 gnu_expr = NULL_TREE;
+               else
+                 gnu_expr
+                   = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
 
-                   gnu_size = NULL_TREE;
-                   used_by_ref = true;
-                 }
+               gnu_size = NULL_TREE;
+               used_by_ref = true;
              }
          }
 
@@ -1483,10 +1468,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
        /* Now create the variable or the constant and set various flags.  */
        gnu_decl
-         = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
-                            gnu_expr, const_flag, Is_Public (gnat_entity),
-                            imported_p || !definition, static_p, attr_list,
-                            gnat_entity);
+         = create_var_decl_1 (gnu_entity_name, gnu_ext_name, gnu_type,
+                              gnu_expr, const_flag, Is_Public (gnat_entity),
+                              imported_p || !definition, static_p,
+                              !renamed_obj, attr_list, gnat_entity);
        DECL_BY_REF_P (gnu_decl) = used_by_ref;
        DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
        DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity);
@@ -1517,7 +1502,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* If this is a renaming pointer, attach the renamed object to it and
           register it if we are at the global level.  Note that an external
           constant is at the global level.  */
-       if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+       if (renamed_obj)
          {
            SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
            if ((!definition && kind == E_Constant) || global_bindings_p ())
index 3b6d5bd..ae7a2ef 100644 (file)
@@ -898,17 +898,8 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
                                address_of_constant, aliased);
 
     case N_Object_Renaming_Declaration:
-      /* We need to make a real renaming only if the constant object is
-        aliased or if we may use a renaming pointer; otherwise we can
-        optimize and return the rvalue.  We make an exception if the object
-        is an identifier since in this case the rvalue can be propagated
-        attached to the CONST_DECL.  */
-      return (!constant
-             || aliased
-             /* This should match the constant case of the renaming code.  */
-             || Is_Composite_Type
-                (Underlying_Type (Etype (Name (gnat_parent))))
-             || Nkind (Name (gnat_parent)) == N_Identifier);
+      /* We need to preserve addresses through a renaming.  */
+      return 1;
 
     case N_Object_Declaration:
       /* We cannot use a constructor if this is an atomic object because
@@ -968,6 +959,77 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
   gcc_unreachable ();
 }
 
+/* Return true if T is a constant DECL node that can be safely replaced
+   by its initializer.  */
+
+static bool
+constant_decl_with_initializer_p (tree t)
+{
+  if (!TREE_CONSTANT (t) || !DECL_P (t) || !DECL_INITIAL (t))
+    return false;
+
+  /* Return false for aggregate types that contain a placeholder since
+     their initializers cannot be manipulated easily.  */
+  if (AGGREGATE_TYPE_P (TREE_TYPE (t))
+      && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (t))
+      && type_contains_placeholder_p (TREE_TYPE (t)))
+    return false;
+
+  return true;
+}
+
+/* Return an expression equivalent to EXP but where constant DECL nodes
+   have been replaced by their initializer.  */
+
+static tree
+fold_constant_decl_in_expr (tree exp)
+{
+  enum tree_code code = TREE_CODE (exp);
+  tree op0;
+
+  switch (code)
+    {
+    case CONST_DECL:
+    case VAR_DECL:
+      if (!constant_decl_with_initializer_p (exp))
+       return exp;
+
+      return DECL_INITIAL (exp);
+
+    case BIT_FIELD_REF:
+    case COMPONENT_REF:
+      op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0));
+      if (op0 == TREE_OPERAND (exp, 0))
+       return exp;
+
+      return fold_build3 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1),
+                         TREE_OPERAND (exp, 2));
+
+    case ARRAY_REF:
+    case ARRAY_RANGE_REF:
+      op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0));
+      if (op0 == TREE_OPERAND (exp, 0))
+       return exp;
+
+      return fold (build4 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1),
+                          TREE_OPERAND (exp, 2), TREE_OPERAND (exp, 3)));
+
+    case VIEW_CONVERT_EXPR:
+    case REALPART_EXPR:
+    case IMAGPART_EXPR:
+      op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0));
+      if (op0 == TREE_OPERAND (exp, 0))
+       return exp;
+
+      return fold_build1 (code, TREE_TYPE (exp), op0);
+
+    default:
+      return exp;
+    }
+
+  gcc_unreachable ();
+}
+
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
    to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer
    to where we should place the result type.  */
@@ -1112,13 +1174,16 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
                                          true, false)))
        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.  */
+      /* If it's a renaming pointer and, either the renamed object is constant
+        or we are at the right binding level, we can reference the renamed
+        object directly, since it is constant or has been protected against
+        multiple evaluations.  */
       if (TREE_CODE (gnu_result) == VAR_DECL
           && !DECL_LOOP_PARM_P (gnu_result)
          && DECL_RENAMED_OBJECT (gnu_result)
-         && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ()))
+         && (TREE_CONSTANT (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.  */
@@ -1138,15 +1203,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 
   /* If we have a constant declaration and its initializer, try to return the
      latter to avoid the need to call fold in lots of places and the need for
-     elaboration code if this identifier is used as an initializer itself.
-     Don't do it for aggregate types that contain a placeholder since their
-     initializers cannot be manipulated easily.  */
-  if (TREE_CONSTANT (gnu_result)
-      && DECL_P (gnu_result)
-      && DECL_INITIAL (gnu_result)
-      && !(AGGREGATE_TYPE_P (TREE_TYPE (gnu_result))
-          && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (gnu_result))
-          && type_contains_placeholder_p (TREE_TYPE (gnu_result))))
+     elaboration code if this identifier is used as an initializer itself.  */
+  if (constant_decl_with_initializer_p (gnu_result))
     {
       bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL
                            && !DECL_CONST_CORRESPONDING_VAR (gnu_result));
@@ -1166,6 +1224,21 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
        gnu_result = DECL_INITIAL (gnu_result);
     }
 
+  /* But for a constant renaming we couldn't do that incrementally for its
+     definition because of the need to return an lvalue so, if the present
+     context doesn't itself require an lvalue, we try again here.  */
+  else if (Ekind (gnat_temp) == E_Constant
+          && Is_Elementary_Type (gnat_temp_type)
+          && Present (Renamed_Object (gnat_temp)))
+    {
+      if (require_lvalue < 0)
+       require_lvalue
+         = lvalue_required_p (gnat_node, gnu_result_type, true, false,
+                              Is_Aliased (gnat_temp));
+      if (!require_lvalue)
+       gnu_result = fold_constant_decl_in_expr (gnu_result);
+    }
+
   /* The GNAT tree has the type of a function set to its result type, so we
      adjust here.  Also use the type of the result if the Etype is a subtype
      that is nominally unconstrained.  Likewise if this is a deferred constant
@@ -2327,9 +2400,11 @@ Case_Statement_to_gnu (Node_Id gnat_node)
       /* First compile all the different case choices for the current WHEN
         alternative.  */
       for (gnat_choice = First (Discrete_Choices (gnat_when));
-          Present (gnat_choice); gnat_choice = Next (gnat_choice))
+          Present (gnat_choice);
+          gnat_choice = Next (gnat_choice))
        {
          tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
+         tree label = create_artificial_label (input_location);
 
          switch (Nkind (gnat_choice))
            {
@@ -2353,8 +2428,8 @@ Case_Statement_to_gnu (Node_Id gnat_node)
                {
                  tree gnu_type = get_unpadded_type (Entity (gnat_choice));
 
-                 gnu_low = fold (TYPE_MIN_VALUE (gnu_type));
-                 gnu_high = fold (TYPE_MAX_VALUE (gnu_type));
+                 gnu_low = TYPE_MIN_VALUE (gnu_type);
+                 gnu_high = TYPE_MAX_VALUE (gnu_type);
                  break;
                }
 
@@ -2372,20 +2447,13 @@ Case_Statement_to_gnu (Node_Id gnat_node)
              gcc_unreachable ();
            }
 
-         /* If the case value is a subtype that raises Constraint_Error at
-            run time because of a wrong bound, then gnu_low or gnu_high is
-            not translated into an INTEGER_CST.  In such a case, we need
-            to ensure that the when statement is not added in the tree,
-            otherwise it will crash the gimplifier.  */
-         if ((!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST)
-             && (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST))
-           {
-             add_stmt_with_node (build_case_label
-                                 (gnu_low, gnu_high,
-                                  create_artificial_label (input_location)),
-                                 gnat_choice);
-             choices_added_p = true;
-           }
+         /* Everything should be folded into constants at this point.  */
+         gcc_assert (!gnu_low  || TREE_CODE (gnu_low)  == INTEGER_CST);
+         gcc_assert (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST);
+
+         add_stmt_with_node (build_case_label (gnu_low, gnu_high, label),
+                             gnat_choice);
+         choices_added_p = true;
        }
 
       /* This construct doesn't define a scope so we shouldn't push a binding
index 8172f5f..4814f9a 100644 (file)
@@ -2514,7 +2514,10 @@ record_global_renaming_pointer (tree decl)
   vec_safe_push (global_renaming_pointers, decl);
 }
 
-/* Invalidate the global renaming pointers.   */
+/* Invalidate the global renaming pointers that are not constant, lest their
+   renamed object contains SAVE_EXPRs tied to an elaboration routine.  Note
+   that we should not blindly invalidate everything here because of the need
+   to propagate constant values through renaming.  */
 
 void
 invalidate_global_renaming_pointers (void)
@@ -2526,7 +2529,8 @@ invalidate_global_renaming_pointers (void)
     return;
 
   FOR_EACH_VEC_ELT (*global_renaming_pointers, i, iter)
-    SET_DECL_RENAMED_OBJECT (iter, NULL_TREE);
+    if (!TREE_CONSTANT (DECL_RENAMED_OBJECT (iter)))
+      SET_DECL_RENAMED_OBJECT (iter, NULL_TREE);
 
   vec_free (global_renaming_pointers);
 }