@@ -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;
@@ -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);
@@ -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