/* Stack of LOOP_STMT nodes. */
static GTY(()) VEC(tree,gc) *gnu_loop_label_stack;
-/* Stack of labels for switch statements. */
-static GTY(()) VEC(tree,gc) *gnu_switch_label_stack;
-
/* The stacks for N_{Push,Pop}_*_Label. */
static GTY(()) VEC(tree,gc) *gnu_constraint_error_label_stack;
static GTY(()) VEC(tree,gc) *gnu_storage_error_label_stack;
static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static tree maybe_implicit_deref (tree);
static void set_expr_location_from_node (tree, Node_Id);
+static void set_gnu_expr_location_from_node (tree, Node_Id);
static int lvalue_required_p (Node_Id, tree, bool, bool, bool);
/* Hooks for debug info back-ends, only supported and used in a restricted set
if (TARGET_VTABLE_USES_DESCRIPTORS)
{
tree null_node = fold_convert (ptr_void_ftype, null_pointer_node);
- tree field_list = NULL_TREE, null_list = NULL_TREE;
+ tree field_list = NULL_TREE;
int j;
+ VEC(constructor_elt,gc) *null_vec = NULL;
+ constructor_elt *elt;
fdesc_type_node = make_node (RECORD_TYPE);
+ VEC_safe_grow (constructor_elt, gc, null_vec,
+ TARGET_VTABLE_USES_DESCRIPTORS);
+ elt = (VEC_address (constructor_elt,null_vec)
+ + TARGET_VTABLE_USES_DESCRIPTORS - 1);
for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
{
NULL_TREE, NULL_TREE, 0, 1);
TREE_CHAIN (field) = field_list;
field_list = field;
- null_list = tree_cons (field, null_node, null_list);
+ elt->index = field;
+ elt->value = null_node;
+ elt--;
}
finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
record_builtin_type ("descriptor", fdesc_type_node);
- null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
+ null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_vec);
}
long_long_float_type
else if (TARGET_VTABLE_USES_DESCRIPTORS
&& Is_Dispatch_Table_Entity (Etype (gnat_node)))
{
- tree gnu_field, gnu_list = NULL_TREE, t;
+ tree gnu_field, t;
/* Descriptors can only be built here for top-level functions. */
bool build_descriptor = (global_bindings_p () != 0);
int i;
+ VEC(constructor_elt,gc) *gnu_vec = NULL;
+ constructor_elt *elt;
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result = build1 (INDIRECT_REF, gnu_result_type, gnu_result);
}
+ VEC_safe_grow (constructor_elt, gc, gnu_vec,
+ TARGET_VTABLE_USES_DESCRIPTORS);
+ elt = (VEC_address (constructor_elt, gnu_vec)
+ + TARGET_VTABLE_USES_DESCRIPTORS - 1);
for (gnu_field = TYPE_FIELDS (gnu_result_type), i = 0;
i < TARGET_VTABLE_USES_DESCRIPTORS;
gnu_field = TREE_CHAIN (gnu_field), i++)
t = build3 (COMPONENT_REF, ptr_void_ftype, gnu_result,
gnu_field, NULL_TREE);
- gnu_list = tree_cons (gnu_field, t, gnu_list);
+ elt->index = gnu_field;
+ elt->value = t;
+ elt--;
}
- gnu_result = gnat_build_constructor (gnu_result_type, gnu_list);
+ gnu_result = gnat_build_constructor (gnu_result_type, gnu_vec);
break;
}
static tree
Case_Statement_to_gnu (Node_Id gnat_node)
{
- tree gnu_result;
- tree gnu_expr;
+ tree gnu_result, gnu_expr, gnu_label;
Node_Id gnat_when;
+ bool may_fallthru = false;
gnu_expr = gnat_to_gnu (Expression (gnat_node));
gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
/* We build a SWITCH_EXPR that contains the code with interspersed
CASE_LABEL_EXPRs for each label. */
- VEC_safe_push (tree, gc, gnu_switch_label_stack,
- create_artificial_label (input_location));
+ gnu_label = create_artificial_label (input_location);
start_stmt_group ();
for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
containing the Case statement. */
if (choices_added_p)
{
- add_stmt (build_stmt_group (Statements (gnat_when), true));
- add_stmt (build1 (GOTO_EXPR, void_type_node,
- VEC_last (tree, gnu_switch_label_stack)));
+ tree group = build_stmt_group (Statements (gnat_when), true);
+ bool group_may_fallthru = block_may_fallthru (group);
+ add_stmt (group);
+ if (group_may_fallthru)
+ {
+ add_stmt (build1 (GOTO_EXPR, void_type_node, gnu_label));
+ may_fallthru = true;
+ }
}
}
- /* Now emit a definition of the label all the cases branched to. */
- add_stmt (build1 (LABEL_EXPR, void_type_node,
- VEC_last (tree, gnu_switch_label_stack)));
+ /* Now emit a definition of the label the cases branch to, if any. */
+ if (may_fallthru)
+ add_stmt (build1 (LABEL_EXPR, void_type_node, gnu_label));
gnu_result = build3 (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
end_stmt_group (), NULL_TREE);
- VEC_pop (tree, gnu_switch_label_stack);
return gnu_result;
}
{
/* Skip any entries that have been already filled in; they must
correspond to In Out parameters. */
- for (; gnu_cico_list && TREE_VALUE (gnu_cico_list);
- gnu_cico_list = TREE_CHAIN (gnu_cico_list))
- ;
+ while (gnu_cico_list && TREE_VALUE (gnu_cico_list))
+ gnu_cico_list = TREE_CHAIN (gnu_cico_list);
/* Do any needed references for padded types. */
TREE_VALUE (gnu_cico_list)
if (list_length (gnu_cico_list) == 1)
gnu_retval = TREE_VALUE (gnu_cico_list);
else
- gnu_retval = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
- gnu_cico_list);
+ gnu_retval = build_constructor_from_list (TREE_TYPE (gnu_subprog_type),
+ gnu_cico_list);
add_stmt_with_node (build_return_expr (gnu_result_decl, gnu_retval),
End_Label (Handled_Statement_Sequence (gnat_node)));
String_Id gnat_string = Strval (gnat_node);
int length = String_Length (gnat_string);
int i;
- tree gnu_list = NULL_TREE;
tree gnu_idx = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
+ VEC(constructor_elt,gc) *gnu_vec
+ = VEC_alloc (constructor_elt, gc, length);
for (i = 0; i < length; i++)
{
- gnu_list
- = tree_cons (gnu_idx,
- build_int_cst (TREE_TYPE (gnu_result_type),
- Get_String_Char (gnat_string,
- i + 1)),
- gnu_list);
+ tree t = build_int_cst (TREE_TYPE (gnu_result_type),
+ Get_String_Char (gnat_string, i + 1));
+ CONSTRUCTOR_APPEND_ELT (gnu_vec, gnu_idx, t);
gnu_idx = int_const_binop (PLUS_EXPR, gnu_idx, integer_one_node,
0);
}
- gnu_result
- = gnat_build_constructor (gnu_result_type, nreverse (gnu_list));
+ gnu_result = gnat_build_constructor (gnu_result_type, gnu_vec);
}
break;
ndim++, gnu_type = TREE_TYPE (gnu_type))
;
- gnat_expr_array = (Node_Id *) alloca (ndim * sizeof (Node_Id));
+ gnat_expr_array = XALLOCAVEC (Node_Id, ndim);
if (TYPE_CONVENTION_FORTRAN_P (TREE_TYPE (gnu_array_object)))
for (i = ndim - 1, gnat_temp = First (Expressions (gnat_node));
gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type);
if (Null_Record_Present (gnat_node))
- gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE);
+ gnu_result = gnat_build_constructor (gnu_aggr_type, NULL);
else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
|| TREE_CODE (gnu_aggr_type) == UNION_TYPE)
noutputs = list_length (gnu_outputs);
gnu_inputs = nreverse (gnu_inputs);
ninputs = list_length (gnu_inputs);
- oconstraints
- = (const char **) alloca (noutputs * sizeof (const char *));
+ oconstraints = XALLOCAVEC (const char *, noutputs);
for (i = 0, tail = gnu_outputs; tail; ++i, tail = TREE_CHAIN (tail))
{
/* Added Nodes */
/****************/
+ case N_Expression_With_Actions:
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ /* This construct doesn't define a scope so we don't wrap the statement
+ list in a BIND_EXPR; however, we wrap it in a SAVE_EXPR to protect it
+ from unsharing. */
+ gnu_result = build_stmt_group (Actions (gnat_node), false);
+ gnu_result = build1 (SAVE_EXPR, void_type_node, gnu_result);
+ TREE_SIDE_EFFECTS (gnu_result) = 1;
+ gnu_expr = gnat_to_gnu (Expression (gnat_node));
+ gnu_result
+ = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_result, gnu_expr);
+ break;
+
case N_Freeze_Entity:
start_stmt_group ();
process_freeze_entity (gnat_node);
convert (gnu_result_type,
boolean_false_node));
- /* Set the location information on the result if it is a real expression.
- References can be reused for multiple GNAT nodes and they would get
- the location information of their last use. Note that we may have
+ /* Set the location information on the result. Note that we may have
no result if we tried to build a CALL_EXPR node to a procedure with
no side-effects and optimization is enabled. */
- if (gnu_result
- && EXPR_P (gnu_result)
- && TREE_CODE (gnu_result) != NOP_EXPR
- && !REFERENCE_CLASS_P (gnu_result)
- && !EXPR_HAS_LOCATION (gnu_result))
- set_expr_location_from_node (gnu_result, gnat_node);
+ if (gnu_result && EXPR_P (gnu_result))
+ set_gnu_expr_location_from_node (gnu_result, gnat_node);
/* If we're supposed to return something of void_type, it means we have
something we're elaborating for effect, so just return. */
case ADDR_EXPR:
op = TREE_OPERAND (expr, 0);
- if (TREE_CODE (op) == CONSTRUCTOR)
+ /* If we are taking the address of a constant CONSTRUCTOR, make sure it
+ is put into static memory. We know that it's going to be read-only
+ given the semantics we have and it must be in static memory when the
+ reference is in an elaboration procedure. */
+ if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op))
{
- /* If we are taking the address of a constant CONSTRUCTOR, make sure
- it is put into static memory. We know it's going to be read-only
- given the semantics we have and it must be in static memory when
- the reference is in an elaboration procedure. */
- if (TREE_CONSTANT (op))
- {
- tree addr = build_fold_addr_expr (tree_output_constant_def (op));
- *expr_p = fold_convert (TREE_TYPE (expr), addr);
- }
-
- /* Otherwise explicitly create the local temporary. That's required
- if the type is passed by reference. */
- else
- {
- tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
- TREE_ADDRESSABLE (new_var) = 1;
- gimple_add_tmp_var (new_var);
+ tree addr = build_fold_addr_expr (tree_output_constant_def (op));
+ *expr_p = fold_convert (TREE_TYPE (expr), addr);
+ return GS_ALL_DONE;
+ }
- mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op);
- gimplify_and_add (mod, pre_p);
+ /* Otherwise, if we are taking the address of a non-constant CONSTRUCTOR
+ or of a call, explicitly create the local temporary. That's required
+ if the type is passed by reference. */
+ if (TREE_CODE (op) == CONSTRUCTOR || TREE_CODE (op) == CALL_EXPR)
+ {
+ tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
+ TREE_ADDRESSABLE (new_var) = 1;
+ gimple_add_tmp_var (new_var);
- TREE_OPERAND (expr, 0) = new_var;
- recompute_tree_invariant_for_addr_expr (expr);
- }
+ mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op);
+ gimplify_and_add (mod, pre_p);
+ TREE_OPERAND (expr, 0) = new_var;
+ recompute_tree_invariant_for_addr_expr (expr);
return GS_ALL_DONE;
}
pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
Entity_Id gnat_component_type)
{
- tree gnu_expr_list = NULL_TREE;
tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
tree gnu_expr;
+ VEC(constructor_elt,gc) *gnu_expr_vec = NULL;
for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr))
{
gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty);
}
- gnu_expr_list
- = tree_cons (gnu_index, convert (TREE_TYPE (gnu_array_type), gnu_expr),
- gnu_expr_list);
+ CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index,
+ convert (TREE_TYPE (gnu_array_type), gnu_expr));
gnu_index = int_const_binop (PLUS_EXPR, gnu_index, integer_one_node, 0);
}
- return gnat_build_constructor (gnu_array_type, nreverse (gnu_expr_list));
+ return gnat_build_constructor (gnu_array_type, gnu_expr_vec);
}
\f
/* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
static tree
extract_values (tree values, tree record_type)
{
- tree result = NULL_TREE;
tree field, tem;
+ VEC(constructor_elt,gc) *v = NULL;
- for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field))
+ for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
{
tree value = 0;
if (!value)
continue;
- result = tree_cons (field, value, result);
+ CONSTRUCTOR_APPEND_ELT (v, field, value);
}
- return gnat_build_constructor (record_type, nreverse (result));
+ return gnat_build_constructor (record_type, v);
}
\f
/* EXP is to be treated as an array or record. Handle the cases when it is
SET_EXPR_LOCATION (node, locus);
}
+
+/* More elaborate version of set_expr_location_from_node to be used in more
+ general contexts, for example the result of the translation of a generic
+ GNAT node. */
+
+static void
+set_gnu_expr_location_from_node (tree node, Node_Id gnat_node)
+{
+ /* Set the location information on the node if it is a real expression.
+ References can be reused for multiple GNAT nodes and they would get
+ the location information of their last use. Also make sure not to
+ overwrite an existing location as it is probably more precise. */
+
+ switch (TREE_CODE (node))
+ {
+ CASE_CONVERT:
+ case NON_LVALUE_EXPR:
+ break;
+
+ case COMPOUND_EXPR:
+ if (EXPR_P (TREE_OPERAND (node, 1)))
+ set_gnu_expr_location_from_node (TREE_OPERAND (node, 1), gnat_node);
+
+ /* ... fall through ... */
+
+ default:
+ if (!REFERENCE_CLASS_P (node) && !EXPR_HAS_LOCATION (node))
+ set_expr_location_from_node (node, gnat_node);
+ break;
+ }
+}
\f
/* Return a colon-separated list of encodings contained in encoded Ada
name. */
OSDN Git Service
