Avoid creating useless local bounds around calls

This prevents the compiler from creating useless local bounds around calls
that take a parameter of an unconstrained array type when the bounds already
exist somewhere else for the actual parameter.

gcc/ada/
	* gcc-interface/decl.c (gnat_to_gnu_subprog_type): Do not demote a
	const or pure function because of a parameter whose type is pointer
	to function.
	* gcc-interface/trans.c (Call_to_gnu): Do not put back a conversion
	between an actual and a formal that are unconstrained array types.
	(gnat_gimplify_expr) <CALL_EXPR>: New case.
	* gcc-interface/utils2.c (build_binary_op): Do not use |= operator.
	(gnat_stabilize_reference_1): Likewise.
	(gnat_rewrite_reference): Likewise.
	(build_unary_op): Do not clear existing TREE_CONSTANT on the result.
	(gnat_build_constructor): Also accept the address of a constant
	CONSTRUCTOR as constant element.

3 files changed, 64 insertions, 21 deletions

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 27ef51a..6fd5c2c 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6059,12 +6059,13 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 
 	  /* A pure function in the Ada sense which takes an access parameter
 	     may modify memory through it and thus need be considered neither
-	     const nor pure in the GCC sense.  Likewise it if takes a by-ref
-	     In Out or Out parameter.  But if it takes a by-ref In parameter,
-	     then it may only read memory through it and can be considered
-	     pure in the GCC sense.  */
+	     const nor pure in the GCC sense, unless it's access-to-function.
+	     Likewise it if takes a by-ref In Out or Out parameter.  But if it
+	     takes a by-ref In parameter, then it may only read memory through
+	     it and can be considered pure in the GCC sense.  */
 	  if ((const_flag || pure_flag)
-	      && (POINTER_TYPE_P (gnu_param_type)
+	      && ((POINTER_TYPE_P (gnu_param_type)
+		   && TREE_CODE (TREE_TYPE (gnu_param_type)) != FUNCTION_TYPE)
 		  || TYPE_IS_FAT_POINTER_P (gnu_param_type)))
 	    {
 	      const_flag = false;
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 07f5e81..2461259 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -4816,7 +4816,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 	 may have suppressed a conversion to the Etype of the actual earlier,
 	 since the parent is a procedure call, so put it back here.  Note that
 	 we might have a dummy type here if the actual is the dereference of a
-	 pointer to it, but that's OK if the formal is passed by reference.  */
+	 pointer to it, but that's OK when the formal is passed by reference.
+	 We also do not put back a conversion between an actual and a formal
+	 that are unconstrained array types to avoid creating local bounds.  */
       tree gnu_actual_type = get_unpadded_type (Etype (gnat_actual));
       if (TYPE_IS_DUMMY_P (gnu_actual_type))
 	gcc_assert (is_true_formal_parm && DECL_BY_REF_P (gnu_formal));
@@ -4824,6 +4826,11 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 	       && Nkind (gnat_actual) == N_Unchecked_Type_Conversion)
 	gnu_actual = unchecked_convert (gnu_actual_type, gnu_actual,
 				        No_Truncation (gnat_actual));
+      else if ((TREE_CODE (TREE_TYPE (gnu_actual)) == UNCONSTRAINED_ARRAY_TYPE
+		|| (TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
+		    && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (gnu_actual))))
+	       && TREE_CODE (gnu_formal_type) == UNCONSTRAINED_ARRAY_TYPE)
+	;
       else
 	gnu_actual = convert (gnu_actual_type, gnu_actual);
 
@@ -8835,6 +8842,31 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
 
       return GS_UNHANDLED;
 
+    case CALL_EXPR:
+      /* If we are passing a constant fat pointer CONSTRUCTOR, make sure it is
+	 put into static memory; this performs a restricted version of constant
+	 propagation on fat pointers in calls.  But do not do it for strings to
+	 avoid blocking concatenation in the caller when it is inlined.  */
+      for (int i = 0; i < call_expr_nargs (expr); i++)
+	{
+	  tree arg = *(CALL_EXPR_ARGP (expr) + i);
+
+	  if (TREE_CODE (arg) == CONSTRUCTOR
+	      && TREE_CONSTANT (arg)
+	      && TYPE_IS_FAT_POINTER_P (TREE_TYPE (arg)))
+	    {
+	      tree t = CONSTRUCTOR_ELT (arg, 0)->value;
+	      if (TREE_CODE (t) == NOP_EXPR)
+		t = TREE_OPERAND (t, 0);
+	      if (TREE_CODE (t) == ADDR_EXPR)
+		t = TREE_OPERAND (t, 0);
+	      if (TREE_CODE (t) != STRING_CST)
+		*(CALL_EXPR_ARGP (expr) + i) = tree_output_constant_def (arg);
+	    }
+	}
+
+      return GS_UNHANDLED;
+
     case VIEW_CONVERT_EXPR:
       op = TREE_OPERAND (expr, 0);
 
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 83cc794..3bf0e15 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -1301,11 +1301,11 @@ build_binary_op (enum tree_code op_code, tree result_type,
       if (TYPE_VOLATILE (operation_type))
 	TREE_THIS_VOLATILE (result) = 1;
     }
-  else
-    TREE_CONSTANT (result)
-      |= (TREE_CONSTANT (left_operand) && TREE_CONSTANT (right_operand));
+  else if (TREE_CONSTANT (left_operand) && TREE_CONSTANT (right_operand))
+    TREE_CONSTANT (result) = 1;
 
-  TREE_SIDE_EFFECTS (result) |= has_side_effects;
+  if (has_side_effects)
+    TREE_SIDE_EFFECTS (result) = 1;
 
   /* If we are working with modular types, perform the MOD operation
      if something above hasn't eliminated the need for it.  */
@@ -1528,7 +1528,9 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 	  result = build_fold_addr_expr (operand);
 	}
 
-      TREE_CONSTANT (result) = staticp (operand) || TREE_CONSTANT (operand);
+      if (TREE_CONSTANT (operand) || staticp (operand))
+	TREE_CONSTANT (result) = 1;
+
       break;
 
     case INDIRECT_REF:
@@ -1957,14 +1959,19 @@ gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v)
      the elements along the way for possible sorting purposes below.  */
   FOR_EACH_CONSTRUCTOR_ELT (v, n_elmts, obj, val)
     {
-      /* The predicate must be in keeping with output_constructor.  */
+      /* The predicate must be in keeping with output_constructor and, unlike
+	 initializer_constant_valid_p, we accept "&{...}" because we'll put
+	 the CONSTRUCTOR into the constant pool during gimplification.  */
       if ((!TREE_CONSTANT (val) && !TREE_STATIC (val))
 	  || (TREE_CODE (type) == RECORD_TYPE
 	      && CONSTRUCTOR_BITFIELD_P (obj)
 	      && !initializer_constant_valid_for_bitfield_p (val))
-	  || !initializer_constant_valid_p (val,
-					    TREE_TYPE (val),
-					    TYPE_REVERSE_STORAGE_ORDER (type)))
+	  || (!initializer_constant_valid_p (val,
+					     TREE_TYPE (val),
+					     TYPE_REVERSE_STORAGE_ORDER (type))
+	      && !(TREE_CODE (val) == ADDR_EXPR
+		   && TREE_CODE (TREE_OPERAND (val, 0)) == CONSTRUCTOR
+		   && TREE_CONSTANT (TREE_OPERAND (val, 0)))))
 	allconstant = false;
 
       if (!TREE_READONLY (val))
@@ -2676,10 +2683,13 @@ gnat_stabilize_reference_1 (tree e, void *data)
       gcc_unreachable ();
     }
 
+  /* See gnat_rewrite_reference below for the rationale.  */
   TREE_READONLY (result) = TREE_READONLY (e);
-  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
 
+  if (TREE_SIDE_EFFECTS (e))
+    TREE_SIDE_EFFECTS (result) = 1;
+
   return result;
 }
 
@@ -2796,18 +2806,18 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, tree *init)
       gcc_unreachable ();
     }
 
-  /* 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.
+  /* TREE_READONLY and TREE_THIS_VOLATILE set on the initial expression may
+     not be sustained across some paths, such as the one for INDIRECT_REF.
 
      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);
 
+  if (TREE_SIDE_EFFECTS (ref))
+    TREE_SIDE_EFFECTS (result) = 1;
+
   if (code == INDIRECT_REF
       || code == UNCONSTRAINED_ARRAY_REF
       || code == ARRAY_REF