OSDN Git Service

* gcc-interface/gigi.h (maybe_variable): Delete.
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 9 Apr 2010 10:49:46 +0000 (10:49 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 9 Apr 2010 10:49:46 +0000 (10:49 +0000)
(protect_multiple_eval): Likewise.
(maybe_stabilize_reference): Likewise.
(gnat_save_expr): Declare.
(gnat_protect_expr): Likewise.
(gnat_stabilize_reference): Likewise.
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
gnat_stabilize_reference.
(maybe_variable): Delete.
(elaborate_expression_1): Use gnat_save_expr.
* gcc-interface/trans.c (Attribute_to_gnu): Use gnat_protect_expr.
(call_to_gnu): Pass NULL to gnat_stabilize_reference.
(gnat_to_gnu) <N_Object_Declaration>: Use gnat_save_expr.
<N_Slice>: Use gnat_protect_exp.
<N_Selected_Component>: Pass NULL to gnat_stabilize_reference.
<N_In>: Use gnat_protect_expr.
Pass NULL to gnat_stabilize_reference.
(build_unary_op_trapv): Use gnat_protect_expr.
(build_binary_op_trapv): Likewise.
(emit_range_check): Likewise.
(emit_index_check): Likewise.
(convert_with_check): Likewise.
(protect_multiple_eval): Move to utils2.c file.
(maybe_stabilize_reference): Merge into...
(gnat_stabilize_reference): ...this.  Move to utils2.c file.
(gnat_stabilize_reference_1): Likewise.
* gcc-interface/utils.c (convert_to_fat_pointer): Use gnat_protect_expr
instead of protect_multiple_eval.
* gcc-interface/utils2.c (compare_arrays): Likewise.
(nonbinary_modular_operation): Likewise.
(maybe_wrap_malloc): Likewise.
(build_allocator): Likewise.
(gnat_save_expr): New function.
(gnat_protect_expr): Rename from protect_multiple_eval.  Early return
in common cases.  Propagate TREE_READONLY onto dereferences.
(gnat_stabilize_reference_1): Move from trans.c file.
(gnat_stabilize_reference): Likewise.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158159 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/gigi.h
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c
gcc/ada/gcc-interface/utils2.c

index 8cd43c6..2b8801f 100644 (file)
@@ -1,5 +1,45 @@
 2010-04-09  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/gigi.h (maybe_variable): Delete.
+       (protect_multiple_eval): Likewise.
+       (maybe_stabilize_reference): Likewise.
+       (gnat_save_expr): Declare.
+       (gnat_protect_expr): Likewise.
+       (gnat_stabilize_reference): Likewise.
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
+       gnat_stabilize_reference.
+       (maybe_variable): Delete.
+       (elaborate_expression_1): Use gnat_save_expr.
+       * gcc-interface/trans.c (Attribute_to_gnu): Use gnat_protect_expr.
+       (call_to_gnu): Pass NULL to gnat_stabilize_reference.
+       (gnat_to_gnu) <N_Object_Declaration>: Use gnat_save_expr.
+       <N_Slice>: Use gnat_protect_exp.
+       <N_Selected_Component>: Pass NULL to gnat_stabilize_reference.
+       <N_In>: Use gnat_protect_expr.
+       Pass NULL to gnat_stabilize_reference.
+       (build_unary_op_trapv): Use gnat_protect_expr.
+       (build_binary_op_trapv): Likewise.
+       (emit_range_check): Likewise.
+       (emit_index_check): Likewise.
+       (convert_with_check): Likewise.
+       (protect_multiple_eval): Move to utils2.c file.
+       (maybe_stabilize_reference): Merge into...
+       (gnat_stabilize_reference): ...this.  Move to utils2.c file.
+       (gnat_stabilize_reference_1): Likewise.
+       * gcc-interface/utils.c (convert_to_fat_pointer): Use gnat_protect_expr
+       instead of protect_multiple_eval.
+       * gcc-interface/utils2.c (compare_arrays): Likewise.
+       (nonbinary_modular_operation): Likewise.
+       (maybe_wrap_malloc): Likewise.
+       (build_allocator): Likewise.
+       (gnat_save_expr): New function.
+       (gnat_protect_expr): Rename from protect_multiple_eval.  Early return
+       in common cases.  Propagate TREE_READONLY onto dereferences.
+       (gnat_stabilize_reference_1): Move from trans.c file.
+       (gnat_stabilize_reference): Likewise.
+
+2010-04-09  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.
        * gcc-interface/decl.c (maybe_variable): Do not set TREE_STATIC on _REF
        node.  Use the type of the operand to set TREE_READONLY.
index 03938d1..dd76891 100644 (file)
@@ -897,7 +897,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            && !TREE_SIDE_EFFECTS (gnu_expr))))
                  {
                    maybe_stable_expr
-                     = maybe_stabilize_reference (gnu_expr, true, &stable);
+                     = gnat_stabilize_reference (gnu_expr, true, &stable);
 
                    if (stable)
                      {
@@ -973,7 +973,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                    else
                     {
                        maybe_stable_expr
-                         = maybe_stabilize_reference (gnu_expr, true, &stable);
+                         = gnat_stabilize_reference (gnu_expr, true, &stable);
 
                        if (stable)
                          renamed_obj = maybe_stable_expr;
@@ -5727,29 +5727,6 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
       }
 }
 \f
-/* Called when we need to protect a variable object using a SAVE_EXPR.  */
-
-tree
-maybe_variable (tree gnu_operand)
-{
-  if (TREE_CONSTANT (gnu_operand)
-      || TREE_READONLY (gnu_operand)
-      || TREE_CODE (gnu_operand) == SAVE_EXPR
-      || TREE_CODE (gnu_operand) == NULL_EXPR)
-    return gnu_operand;
-
-  if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF)
-    {
-      tree gnu_result
-       = build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand),
-                 variable_size (TREE_OPERAND (gnu_operand, 0)));
-      TREE_READONLY (gnu_result) = TYPE_READONLY (TREE_TYPE (gnu_operand));
-      return gnu_result;
-    }
-
-  return variable_size (gnu_operand);
-}
-\f
 /* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a
    type definition (either a bound or a discriminant value) for GNAT_ENTITY,
    return the GCC tree to use for that expression.  GNU_NAME is the suffix
@@ -5852,7 +5829,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
   if (expr_global && expr_variable)
     return gnu_decl;
 
-  return expr_variable ? maybe_variable (gnu_expr) : gnu_expr;
+  return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr;
 }
 \f
 /* Create a record type that contains a SIZE bytes long field of TYPE with a
index 97c5ca0..8ba0637 100644 (file)
@@ -112,9 +112,6 @@ extern void mark_out_of_scope (Entity_Id gnat_entity);
 /* Get the unpadded version of a GNAT type.  */
 extern tree get_unpadded_type (Entity_Id gnat_entity);
 
-/* Called when we need to protect a variable object using a save_expr.  */
-extern tree maybe_variable (tree gnu_operand);
-
 /* Create a record type that contains a SIZE bytes long field of TYPE with a
     starting bit position so that it is aligned to ALIGN bits, and leaving at
     least ROOM bytes free before the field.  BASE_ALIGN is the alignment the
@@ -256,9 +253,6 @@ extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
 extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
                                   tree t, int num);
 
-/* Protect EXP from multiple evaluation.  This may make a SAVE_EXPR.  */
-extern tree protect_multiple_eval (tree exp);
-
 /* Return a label to branch to for the exception type in KIND or NULL_TREE
    if none.  */
 extern tree get_exception_label (char kind);
@@ -267,12 +261,6 @@ extern tree get_exception_label (char kind);
    called.  */
 extern Node_Id error_gnat_node;
 
-/* This is equivalent to stabilize_reference in tree.c, but we know how to
-   handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  We set SUCCESS to true unless we walk
-   through something we don't know how to stabilize.  */
-extern tree maybe_stabilize_reference (tree ref, bool force, bool *success);
-
 /* Highest number in the front-end node table.  */
 extern int max_gnat_nodes;
 
@@ -875,6 +863,21 @@ extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal,
    should not be allocated in a register.  Returns true if successful.  */
 extern bool gnat_mark_addressable (tree t);
 
+/* Save EXP for later use or reuse.  This is equivalent to save_expr in tree.c
+   but we know how to handle our own nodes.  */
+extern tree gnat_save_expr (tree exp);
+
+/* Protect EXP for immediate reuse.  This is a variant of gnat_save_expr that
+   is optimized under the assumption that EXP's value doesn't change before
+   its subsequent reuse(s) except through its potential reevaluation.  */
+extern tree gnat_protect_expr (tree exp);
+
+/* This is equivalent to stabilize_reference in tree.c but we know how to
+   handle our own nodes and we take extra arguments.  FORCE says whether to
+   force evaluation of everything.  We set SUCCESS to true unless we walk
+   through something we don't know how to stabilize.  */
+extern tree gnat_stabilize_reference (tree ref, bool force, bool *success);
+
 /* Implementation of the builtin_function langhook.  */
 extern tree gnat_builtin_function (tree decl);
 
index 438799c..5fe9460 100644 (file)
@@ -214,8 +214,6 @@ static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
 static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
-static tree gnat_stabilize_reference (tree, bool);
-static tree gnat_stabilize_reference_1 (tree, bool);
 static void set_expr_location_from_node (tree, Node_Id);
 static int lvalue_required_p (Node_Id, tree, bool, bool);
 
@@ -1128,7 +1126,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 
       if (Do_Range_Check (First (Expressions (gnat_node))))
        {
-         gnu_expr = protect_multiple_eval (gnu_expr);
+         gnu_expr = gnat_protect_expr (gnu_expr);
          gnu_expr
            = emit_check
              (build_binary_op (EQ_EXPR, integer_type_node,
@@ -2492,7 +2490,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
         ??? This is more conservative than we need since we don't need to do
         this for pass-by-ref with no conversion.  */
       if (Ekind (gnat_formal) != E_In_Parameter)
-       gnu_name = gnat_stabilize_reference (gnu_name, true);
+       gnu_name = gnat_stabilize_reference (gnu_name, true, NULL);
 
       /* If we are passing a non-addressable parameter by reference, pass the
         address of a copy.  In the Out or In Out case, set up to copy back
@@ -2555,10 +2553,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
                                                   gnu_name_type)))
            gnu_name = convert (gnu_name_type, gnu_name);
 
-         /* Make a SAVE_EXPR to both properly account for potential side
-            effects and handle the creation of a temporary.  Special code
-            in gnat_gimplify_expr ensures that the same temporary is used
-            as the object and copied back after the call if needed.  */
+         /* Make a SAVE_EXPR to force the creation of a temporary.  Special
+            code in gnat_gimplify_expr ensures that the same temporary is
+            used as the object and copied back after the call if needed.  */
          gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
          TREE_SIDE_EFFECTS (gnu_name) = 1;
 
@@ -3722,7 +3719,7 @@ gnat_to_gnu (Node_Id gnat_node)
                                     gnu_expr, false, Is_Public (gnat_temp),
                                     false, false, NULL, gnat_temp);
              else
-               gnu_expr = maybe_variable (gnu_expr);
+               gnu_expr = gnat_save_expr (gnu_expr);
 
              save_gnu_tree (gnat_node, gnu_expr, true);
            }
@@ -3886,8 +3883,8 @@ gnat_to_gnu (Node_Id gnat_node)
              (TYPE_MAX_VALUE (gnu_base_index_type), gnu_result);
            tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
 
-          gnu_min_expr = protect_multiple_eval (gnu_min_expr);
-          gnu_max_expr = protect_multiple_eval (gnu_max_expr);
+          gnu_min_expr = gnat_protect_expr (gnu_min_expr);
+          gnu_max_expr = gnat_protect_expr (gnu_max_expr);
 
            /* Derive a good type to convert everything to.  */
            gnu_expr_type = get_base_type (gnu_index_type);
@@ -3989,7 +3986,7 @@ gnat_to_gnu (Node_Id gnat_node)
                                   ? Designated_Type (Etype
                                                      (Prefix (gnat_node)))
                                   : Etype (Prefix (gnat_node))))
-             gnu_prefix = gnat_stabilize_reference (gnu_prefix, false);
+             gnu_prefix = gnat_stabilize_reference (gnu_prefix, false, NULL);
 
            gnu_result
              = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
@@ -4177,7 +4174,7 @@ gnat_to_gnu (Node_Id gnat_node)
        else
          {
            tree t1, t2;
-           gnu_obj = protect_multiple_eval (gnu_obj);
+           gnu_obj = gnat_protect_expr (gnu_obj);
            t1 = build_binary_op (GE_EXPR, gnu_result_type, gnu_obj, gnu_low);
            if (EXPR_P (t1))
              set_expr_location_from_node (t1, gnat_node);
@@ -5293,7 +5290,7 @@ gnat_to_gnu (Node_Id gnat_node)
   if (TREE_SIDE_EFFECTS (gnu_result)
       && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
          || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
-    gnu_result = gnat_stabilize_reference (gnu_result, false);
+    gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
 
   /* Now convert the result to the result type, unless we are in one of the
      following cases:
@@ -6272,7 +6269,7 @@ build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand,
 {
   gcc_assert (code == NEGATE_EXPR || code == ABS_EXPR);
 
-  operand = protect_multiple_eval (operand);
+  operand = gnat_protect_expr (operand);
 
   return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
                                      operand, TYPE_MIN_VALUE (gnu_type)),
@@ -6291,8 +6288,8 @@ static tree
 build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
                       tree right, Node_Id gnat_node)
 {
-  tree lhs = protect_multiple_eval (left);
-  tree rhs = protect_multiple_eval (right);
+  tree lhs = gnat_protect_expr (left);
+  tree rhs = gnat_protect_expr (right);
   tree type_max = TYPE_MAX_VALUE (gnu_type);
   tree type_min = TYPE_MIN_VALUE (gnu_type);
   tree gnu_expr;
@@ -6488,7 +6485,7 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
     return gnu_expr;
 
   /* Checked expressions must be evaluated only once.  */
-  gnu_expr = protect_multiple_eval (gnu_expr);
+  gnu_expr = gnat_protect_expr (gnu_expr);
 
   /* There's no good type to use here, so we might as well use
      integer_type_node. Note that the form of the check is
@@ -6528,7 +6525,7 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
   tree gnu_expr_check;
 
   /* Checked expressions must be evaluated only once.  */
-  gnu_expr = protect_multiple_eval (gnu_expr);
+  gnu_expr = gnat_protect_expr (gnu_expr);
 
   /* Must do this computation in the base type in case the expression's
      type is an unsigned subtypes.  */
@@ -6619,7 +6616,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
       && !(FLOAT_TYPE_P (gnu_base_type) && INTEGRAL_TYPE_P (gnu_in_basetype)))
     {
       /* Ensure GNU_EXPR only gets evaluated once.  */
-      tree gnu_input = protect_multiple_eval (gnu_result);
+      tree gnu_input = gnat_protect_expr (gnu_result);
       tree gnu_cond = integer_zero_node;
       tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_basetype);
       tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_basetype);
@@ -6728,7 +6725,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
         conversion of the input to the calc_type (if necessary).  */
 
       gnu_zero = convert (gnu_in_basetype, integer_zero_node);
-      gnu_result = protect_multiple_eval (gnu_result);
+      gnu_result = gnat_protect_expr (gnu_result);
       gnu_conv = convert (calc_type, gnu_result);
       gnu_comp
        = fold_build2 (GE_EXPR, integer_type_node, gnu_result, gnu_zero);
@@ -7191,265 +7188,6 @@ maybe_implicit_deref (tree exp)
   return exp;
 }
 \f
-/* Protect EXP from multiple evaluation.  This may make a SAVE_EXPR.  */
-
-tree
-protect_multiple_eval (tree exp)
-{
-  tree type = TREE_TYPE (exp);
-  enum tree_code code = TREE_CODE (exp);
-
-  /* If EXP has no side effects, we theoritically don't need to do anything.
-     However, we may be recursively passed more and more complex expressions
-     involving checks which will be reused multiple times and eventually be
-     unshared for gimplification; in order to avoid a complexity explosion
-     at that point, we protect any expressions more complex than a simple
-     arithmetic expression.  */
-  if (!TREE_SIDE_EFFECTS (exp)
-      && (CONSTANT_CLASS_P (exp)
-         || !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp))))
-    return exp;
-
-  /* If this is a conversion, protect what's inside the conversion.
-     Similarly, if we're indirectly referencing something, we only
-     need to protect the address since the data itself can't change
-     in these situations.  */
-  if (code == NON_LVALUE_EXPR
-      || CONVERT_EXPR_CODE_P (code)
-      || code == VIEW_CONVERT_EXPR
-      || code == INDIRECT_REF
-      || code == UNCONSTRAINED_ARRAY_REF)
-  return build1 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)));
-
-  /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
-     This may be more efficient, but will also allow us to more easily find
-     the match for the PLACEHOLDER_EXPR.  */
-  if (code == COMPONENT_REF
-      && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
-    return build3 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)),
-                  TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
-
-  /* If this is a fat pointer or something that can be placed in a register,
-     just make a SAVE_EXPR.  Likewise for a CALL_EXPR as large objects are
-     returned via invisible reference in most ABIs so the temporary will
-     directly be filled by the callee.  */
-  if (TYPE_IS_FAT_POINTER_P (type)
-      || TYPE_MODE (type) != BLKmode
-      || code == CALL_EXPR)
-    return save_expr (exp);
-
-  /* Otherwise reference, protect the address and dereference.  */
-  return
-    build_unary_op (INDIRECT_REF, type,
-                   save_expr (build_unary_op (ADDR_EXPR,
-                                              build_reference_type (type),
-                                              exp)));
-}
-\f
-/* This is equivalent to stabilize_reference in tree.c, but we know how to
-   handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  We set SUCCESS to true unless we walk
-   through something we don't know how to stabilize.  */
-
-tree
-maybe_stabilize_reference (tree ref, bool force, bool *success)
-{
-  tree type = TREE_TYPE (ref);
-  enum tree_code code = TREE_CODE (ref);
-  tree result;
-
-  /* Assume we'll success unless proven otherwise.  */
-  *success = true;
-
-  switch (code)
-    {
-    case CONST_DECL:
-    case VAR_DECL:
-    case PARM_DECL:
-    case RESULT_DECL:
-      /* No action is needed in this case.  */
-      return ref;
-
-    case ADDR_EXPR:
-    CASE_CONVERT:
-    case FLOAT_EXPR:
-    case FIX_TRUNC_EXPR:
-    case VIEW_CONVERT_EXPR:
-      result
-       = build1 (code, type,
-                 maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                            success));
-      break;
-
-    case INDIRECT_REF:
-    case UNCONSTRAINED_ARRAY_REF:
-      result = build1 (code, type,
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
-                                                  force));
-      break;
-
-    case COMPONENT_REF:
-     result = build3 (COMPONENT_REF, type,
-                     maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                                success),
-                     TREE_OPERAND (ref, 1), NULL_TREE);
-      break;
-
-    case BIT_FIELD_REF:
-      result = build3 (BIT_FIELD_REF, type,
-                      maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                                 success),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                  force),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
-                                                  force));
-      break;
-
-    case ARRAY_REF:
-    case ARRAY_RANGE_REF:
-      result = build4 (code, type,
-                      maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                                 success),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                  force),
-                      NULL_TREE, NULL_TREE);
-      break;
-
-    case CALL_EXPR:
-    case COMPOUND_EXPR:
-      result = gnat_stabilize_reference_1 (ref, force);
-      break;
-
-    case CONSTRUCTOR:
-      /* Constructors with 1 element are used extensively to formally
-        convert objects to special wrapping types.  */
-      if (TREE_CODE (type) == RECORD_TYPE
-         && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
-       {
-         tree index
-           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
-         tree value
-           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
-         result
-           = build_constructor_single (type, index,
-                                       gnat_stabilize_reference_1 (value,
-                                                                   force));
-       }
-      else
-       {
-         *success = false;
-         return ref;
-       }
-      break;
-
-    case ERROR_MARK:
-      ref = error_mark_node;
-
-      /* ...  fall through to failure ... */
-
-      /* If arg isn't a kind of lvalue we recognize, make no change.
-        Caller should recognize the error for an invalid lvalue.  */
-    default:
-      *success = false;
-      return ref;
-    }
-
-  /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
-     may not be sustained across some paths, such as the way via build1 for
-     INDIRECT_REF.  We reset those flags here in the general case, which is
-     consistent with the GCC version of this routine.
-
-     Special care should be taken regarding TREE_SIDE_EFFECTS, because some
-     paths introduce side-effects where there was none initially (e.g. if a
-     SAVE_EXPR is built) and we also want to keep track of that.  */
-  TREE_READONLY (result) = TREE_READONLY (ref);
-  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
-  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
-
-  return result;
-}
-
-/* Wrapper around maybe_stabilize_reference, for common uses without lvalue
-   restrictions and without the need to examine the success indication.  */
-
-static tree
-gnat_stabilize_reference (tree ref, bool force)
-{
-  bool dummy;
-  return maybe_stabilize_reference (ref, force, &dummy);
-}
-
-/* Similar to stabilize_reference_1 in tree.c, but supports an extra
-   arg to force a SAVE_EXPR for everything.  */
-
-static tree
-gnat_stabilize_reference_1 (tree e, bool force)
-{
-  enum tree_code code = TREE_CODE (e);
-  tree type = TREE_TYPE (e);
-  tree result;
-
-  /* We cannot ignore const expressions because it might be a reference
-     to a const array but whose index contains side-effects.  But we can
-     ignore things that are actual constant or that already have been
-     handled by this function.  */
-  if (TREE_CONSTANT (e) || code == SAVE_EXPR)
-    return e;
-
-  switch (TREE_CODE_CLASS (code))
-    {
-    case tcc_exceptional:
-    case tcc_declaration:
-    case tcc_comparison:
-    case tcc_expression:
-    case tcc_reference:
-    case tcc_vl_exp:
-      /* If this is a COMPONENT_REF of a fat pointer, save the entire
-        fat pointer.  This may be more efficient, but will also allow
-        us to more easily find the match for the PLACEHOLDER_EXPR.  */
-      if (code == COMPONENT_REF
-         && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
-       result
-         = build3 (code, type,
-                   gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
-                   TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
-      /* If the expression has side-effects, then encase it in a SAVE_EXPR
-        so that it will only be evaluated once.  */
-      /* The tcc_reference and tcc_comparison classes could be handled as
-        below, but it is generally faster to only evaluate them once.  */
-      else if (TREE_SIDE_EFFECTS (e) || force)
-       return save_expr (e);
-      else
-       return e;
-      break;
-
-    case tcc_binary:
-      /* Recursively stabilize each operand.  */
-      result
-       = build2 (code, type,
-                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
-                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
-      break;
-
-    case tcc_unary:
-      /* Recursively stabilize each operand.  */
-      result
-       = build1 (code, type,
-                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
-      break;
-
-    default:
-      gcc_unreachable ();
-    }
-
-  /* See similar handling in maybe_stabilize_reference.  */
-  TREE_READONLY (result) = TREE_READONLY (e);
-  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
-  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
-
-  return result;
-}
-\f
 /* Convert SLOC into LOCUS.  Return true if SLOC corresponds to a source code
    location and false if it doesn't.  In the former case, set the Gigi global
    variable REF_FILENAME to the simple debug file name as given by sinput.  */
index f35e9c7..a59b565 100644 (file)
@@ -3587,7 +3587,7 @@ convert_to_fat_pointer (tree type, tree expr)
     {
       tree fields = TYPE_FIELDS (TREE_TYPE (etype));
 
-      expr = protect_multiple_eval (expr);
+      expr = gnat_protect_expr (expr);
       if (TREE_CODE (expr) == ADDR_EXPR)
        expr = TREE_OPERAND (expr, 0);
       else
index 5db38c5..a6ec65f 100644 (file)
@@ -254,10 +254,10 @@ compare_arrays (tree result_type, tree a1, tree a2)
   /* If either operand has side-effects, they have to be evaluated only once
      in spite of the multiple references to the operand in the comparison.  */
   if (a1_side_effects_p)
-    a1 = protect_multiple_eval (a1);
+    a1 = gnat_protect_expr (a1);
 
   if (a2_side_effects_p)
-    a2 = protect_multiple_eval (a2);
+    a2 = gnat_protect_expr (a2);
 
   /* Process each dimension separately and compare the lengths.  If any
      dimension has a size known to be zero, set SIZE_ZERO_P to 1 to
@@ -471,7 +471,7 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
   /* For subtraction, add the modulus back if we are negative.  */
   else if (op_code == MINUS_EXPR)
     {
-      result = protect_multiple_eval (result);
+      result = gnat_protect_expr (result);
       result = fold_build3 (COND_EXPR, op_type,
                            fold_build2 (LT_EXPR, integer_type_node, result,
                                         convert (op_type, integer_zero_node)),
@@ -482,7 +482,7 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
   /* For the other operations, subtract the modulus if we are >= it.  */
   else
     {
-      result = protect_multiple_eval (result);
+      result = gnat_protect_expr (result);
       result = fold_build3 (COND_EXPR, op_type,
                            fold_build2 (GE_EXPR, integer_type_node,
                                         result, modulus),
@@ -1800,7 +1800,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
     {
       /* Latch malloc's return value and get a pointer to the aligning field
         first.  */
-      tree storage_ptr = protect_multiple_eval (malloc_ptr);
+      tree storage_ptr = gnat_protect_expr (malloc_ptr);
 
       tree aligning_record_addr
        = convert (build_pointer_type (aligning_type), storage_ptr);
@@ -1961,7 +1961,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 
       storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
                                          gnat_proc, gnat_pool, gnat_node);
-      storage = convert (storage_ptr_type, protect_multiple_eval (storage));
+      storage = convert (storage_ptr_type, gnat_protect_expr (storage));
 
       if (TYPE_IS_PADDING_P (type))
        {
@@ -2039,7 +2039,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
      and return the address with a COMPOUND_EXPR.  */
   if (init)
     {
-      result = protect_multiple_eval (result);
+      result = gnat_protect_expr (result);
       result
        = build2 (COMPOUND_EXPR, TREE_TYPE (result),
                  build_binary_op
@@ -2147,3 +2147,293 @@ gnat_mark_addressable (tree t)
        return true;
     }
 }
+\f
+/* Save EXP for later use or reuse.  This is equivalent to save_expr in tree.c
+   but we know how to handle our own nodes.  */
+
+tree
+gnat_save_expr (tree exp)
+{
+  tree type = TREE_TYPE (exp);
+  enum tree_code code = TREE_CODE (exp);
+
+  if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
+    return exp;
+
+  if (code == UNCONSTRAINED_ARRAY_REF)
+    {
+      tree t = build1 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)));
+      TREE_READONLY (t) = TYPE_READONLY (type);
+      return t;
+    }
+
+  /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
+     This may be more efficient, but will also allow us to more easily find
+     the match for the PLACEHOLDER_EXPR.  */
+  if (code == COMPONENT_REF
+      && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+    return build3 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)),
+                  TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
+
+  return save_expr (exp);
+}
+
+/* Protect EXP for immediate reuse.  This is a variant of gnat_save_expr that
+   is optimized under the assumption that EXP's value doesn't change before
+   its subsequent reuse(s) except through its potential reevaluation.  */
+
+tree
+gnat_protect_expr (tree exp)
+{
+  tree type = TREE_TYPE (exp);
+  enum tree_code code = TREE_CODE (exp);
+
+  if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
+    return exp;
+
+  /* If EXP has no side effects, we theoritically don't need to do anything.
+     However, we may be recursively passed more and more complex expressions
+     involving checks which will be reused multiple times and eventually be
+     unshared for gimplification; in order to avoid a complexity explosion
+     at that point, we protect any expressions more complex than a simple
+     arithmetic expression.  */
+  if (!TREE_SIDE_EFFECTS (exp)
+      && !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp)))
+    return exp;
+
+  /* If this is a conversion, protect what's inside the conversion.  */
+  if (code == NON_LVALUE_EXPR
+      || CONVERT_EXPR_CODE_P (code)
+      || code == VIEW_CONVERT_EXPR)
+  return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
+
+  /* If we're indirectly referencing something, we only need to protect the
+     address since the data itself can't change in these situations.  */
+  if (code == INDIRECT_REF || code == UNCONSTRAINED_ARRAY_REF)
+    {
+      tree t = build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
+      TREE_READONLY (t) = TYPE_READONLY (type);
+      return t;
+    }
+
+  /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
+     This may be more efficient, but will also allow us to more easily find
+     the match for the PLACEHOLDER_EXPR.  */
+  if (code == COMPONENT_REF
+      && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+    return build3 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)),
+                  TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
+
+  /* If this is a fat pointer or something that can be placed in a register,
+     just make a SAVE_EXPR.  Likewise for a CALL_EXPR as large objects are
+     returned via invisible reference in most ABIs so the temporary will
+     directly be filled by the callee.  */
+  if (TYPE_IS_FAT_POINTER_P (type)
+      || TYPE_MODE (type) != BLKmode
+      || code == CALL_EXPR)
+    return save_expr (exp);
+
+  /* Otherwise reference, protect the address and dereference.  */
+  return
+    build_unary_op (INDIRECT_REF, type,
+                   save_expr (build_unary_op (ADDR_EXPR,
+                                              build_reference_type (type),
+                                              exp)));
+}
+
+/* This is equivalent to stabilize_reference_1 in tree.c but we take an extra
+   argument to force evaluation of everything.  */
+
+static tree
+gnat_stabilize_reference_1 (tree e, bool force)
+{
+  enum tree_code code = TREE_CODE (e);
+  tree type = TREE_TYPE (e);
+  tree result;
+
+  /* We cannot ignore const expressions because it might be a reference
+     to a const array but whose index contains side-effects.  But we can
+     ignore things that are actual constant or that already have been
+     handled by this function.  */
+  if (TREE_CONSTANT (e) || code == SAVE_EXPR)
+    return e;
+
+  switch (TREE_CODE_CLASS (code))
+    {
+    case tcc_exceptional:
+    case tcc_declaration:
+    case tcc_comparison:
+    case tcc_expression:
+    case tcc_reference:
+    case tcc_vl_exp:
+      /* If this is a COMPONENT_REF of a fat pointer, save the entire
+        fat pointer.  This may be more efficient, but will also allow
+        us to more easily find the match for the PLACEHOLDER_EXPR.  */
+      if (code == COMPONENT_REF
+         && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
+       result
+         = build3 (code, type,
+                   gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+                   TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+      /* If the expression has side-effects, then encase it in a SAVE_EXPR
+        so that it will only be evaluated once.  */
+      /* The tcc_reference and tcc_comparison classes could be handled as
+        below, but it is generally faster to only evaluate them once.  */
+      else if (TREE_SIDE_EFFECTS (e) || force)
+       return save_expr (e);
+      else
+       return e;
+      break;
+
+    case tcc_binary:
+      /* Recursively stabilize each operand.  */
+      result
+       = build2 (code, type,
+                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
+      break;
+
+    case tcc_unary:
+      /* Recursively stabilize each operand.  */
+      result
+       = build1 (code, type,
+                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  /* See similar handling in gnat_stabilize_reference.  */
+  TREE_READONLY (result) = TREE_READONLY (e);
+  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
+  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
+
+  return result;
+}
+
+/* This is equivalent to stabilize_reference in tree.c but we know how to
+   handle our own nodes and we take extra arguments.  FORCE says whether to
+   force evaluation of everything.  We set SUCCESS to true unless we walk
+   through something we don't know how to stabilize.  */
+
+tree
+gnat_stabilize_reference (tree ref, bool force, bool *success)
+{
+  tree type = TREE_TYPE (ref);
+  enum tree_code code = TREE_CODE (ref);
+  tree result;
+
+  /* Assume we'll success unless proven otherwise.  */
+  if (success)
+    *success = true;
+
+  switch (code)
+    {
+    case CONST_DECL:
+    case VAR_DECL:
+    case PARM_DECL:
+    case RESULT_DECL:
+      /* No action is needed in this case.  */
+      return ref;
+
+    case ADDR_EXPR:
+    CASE_CONVERT:
+    case FLOAT_EXPR:
+    case FIX_TRUNC_EXPR:
+    case VIEW_CONVERT_EXPR:
+      result
+       = build1 (code, type,
+                 gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                           success));
+      break;
+
+    case INDIRECT_REF:
+    case UNCONSTRAINED_ARRAY_REF:
+      result = build1 (code, type,
+                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
+                                                  force));
+      break;
+
+    case COMPONENT_REF:
+     result = build3 (COMPONENT_REF, type,
+                     gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                               success),
+                     TREE_OPERAND (ref, 1), NULL_TREE);
+      break;
+
+    case BIT_FIELD_REF:
+      result = build3 (BIT_FIELD_REF, type,
+                      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                                success),
+                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+                                                  force),
+                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
+                                                  force));
+      break;
+
+    case ARRAY_REF:
+    case ARRAY_RANGE_REF:
+      result = build4 (code, type,
+                      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                                success),
+                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+                                                  force),
+                      NULL_TREE, NULL_TREE);
+      break;
+
+    case CALL_EXPR:
+    case COMPOUND_EXPR:
+      result = gnat_stabilize_reference_1 (ref, force);
+      break;
+
+    case CONSTRUCTOR:
+      /* Constructors with 1 element are used extensively to formally
+        convert objects to special wrapping types.  */
+      if (TREE_CODE (type) == RECORD_TYPE
+         && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
+       {
+         tree index
+           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
+         tree value
+           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
+         result
+           = build_constructor_single (type, index,
+                                       gnat_stabilize_reference_1 (value,
+                                                                   force));
+       }
+      else
+       {
+         if (success)
+           *success = false;
+         return ref;
+       }
+      break;
+
+    case ERROR_MARK:
+      ref = error_mark_node;
+
+      /* ...  fall through to failure ... */
+
+      /* If arg isn't a kind of lvalue we recognize, make no change.
+        Caller should recognize the error for an invalid lvalue.  */
+    default:
+      if (success)
+       *success = false;
+      return ref;
+    }
+
+  /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
+     may not be sustained across some paths, such as the way via build1 for
+     INDIRECT_REF.  We reset those flags here in the general case, which is
+     consistent with the GCC version of this routine.
+
+     Special care should be taken regarding TREE_SIDE_EFFECTS, because some
+     paths introduce side-effects where there was none initially (e.g. if a
+     SAVE_EXPR is built) and we also want to keep track of that.  */
+  TREE_READONLY (result) = TREE_READONLY (ref);
+  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
+  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+
+  return result;
+}