+2004-06-14 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+ * ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.
+ * ada-tree.h (EXIT_STMT_LABEL): Renamed from EXIT_STMT_LOOP.
+ * decl.c (gnat_to_gnu_entity): Also set force_global for imported
+ subprograms.
+ * trans.c (gnu_loop_label_stack): Renamed from gnu_loop_stmt_stack;
+ all callers changed.
+ (gnat_to_gnu, case N_Loop_Statement, case N_Exit_Statement): Change
+ the way that EXIT_STMT finds the loop label.
+ (gnat_gimplify_stmt, case LOOP_STMT, EXIT_STMT): Likewise.
+ (gnat_gimplify_stmt, case DECL_STMT): Handle variable-sized decls here.
+ (add_stmt): Use annotate_with_locus insted of setting directly.
+ (pos_to_construct): Set TREE_PURPOSE of each entry to index.
+ (gnat_stabilize_reference, case ARRAY_RANGE_REF): Merge with ARRAY_REF.
+ * utils.c (gnat_install_builtins): Install __builtin_memcmp.
+ (build_vms_descriptor): Add extra args to ARRAY_REF.
+ (convert): Use VIEW_CONVERT_EXPR between aggregate types.
+ * utils2.c (gnat_truthvalue_conversion, case INTEGER_CST, REAL_CST):
+ New cases.
+ (build_binary_op): Don't make explicit CONVERT_EXPR.
+ Add extra rgs to ARRAY_REF.
+
2004-06-14 Pascal Obry <obry@gnat.com>
* gnat_ugn.texi: Document relocatable vs. dynamic Library_Kind on
/* A loop. LOOP_STMT_TOP_COND and LOOP_STMT_BOT_COND are the tests to exit a
loop at the top and bottom, respectively. LOOP_STMT_UPDATE is the statement
to update the loop iterator at the continue point. LOOP_STMT_BODY are the
- statements in the body of the loop. LOOP_STMT_LABEL is used during
- gimplification to point to the LABEL_DECL of the end label of the loop. */
+ statements in the body of the loop. LOOP_STMT_LABEL points to the LABEL_DECL
+ of the end label of the loop. */
DEFTREECODE (LOOP_STMT, "loop_stmt", 's', 5)
/* Conditionally exit a loop. EXIT_STMT_COND is the condition, which, if
true, will cause the loop to be exited. If no condition is specified,
- the loop is unconditionally exited. EXIT_STMT_LOOP is the LOOP_STMT
+ the loop is unconditionally exited. EXIT_STMT_LABEL is the end label
corresponding to the loop to exit. */
DEFTREECODE (EXIT_STMT, "exit_stmt", 's', 2)
/* A statement that emits a USE for its single operand. */
DEFTREECODE (USE_STMT, "use_expr", 's', 1)
-
#define LOOP_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 3)
#define LOOP_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 4)
#define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
-#define EXIT_STMT_LOOP(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
+#define EXIT_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
#define REGION_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 0)
#define REGION_STMT_HANDLE(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 1)
#define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
/* For cases when we are not defining (i.e., we are referencing from
another compilation unit) Public entities, show we are at global level
- for the purpose of computing sizes. Don't do this for components or
+ for the purpose of computing scopes. Don't do this for components or
discriminants since the relevant test is whether or not the record is
- being defined. */
- if (! definition && Is_Public (gnat_entity)
- && ! Is_Statically_Allocated (gnat_entity)
- && kind != E_Discriminant && kind != E_Component)
+ being defined. But do this for Imported functions or procedures in
+ all cases. */
+ if ((! definition && Is_Public (gnat_entity)
+ && ! Is_Statically_Allocated (gnat_entity)
+ && kind != E_Discriminant && kind != E_Component)
+ || (Is_Imported (gnat_entity)
+ && (kind == E_Function || kind == E_Procedure)))
force_global++, this_global = 1;
/* Handle any attributes. */
static GTY(()) tree gnu_return_label_stack;
/* List of TREE_LIST nodes representing a stack of LOOP_STMT nodes.
- TREE_VALUE of each entry is the corresponding LOOP_STMT. */
-static GTY(()) tree gnu_loop_stmt_stack;
+ TREE_VALUE of each entry is the label of the corresponding LOOP_STMT. */
+static GTY(()) tree gnu_loop_label_stack;
/* List of TREE_LIST nodes containing pending elaborations lists.
used to prevent the elaborations being reclaimed by GC. */
TREE_TYPE (gnu_loop_stmt) = void_type_node;
TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
+ LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label ();
annotate_with_node (gnu_loop_stmt, gnat_node);
- /* Save this LOOP_STMT in a stack so that the corresponding
- N_Exit_Statement can find it. */
- push_stack (&gnu_loop_stmt_stack, NULL_TREE, gnu_loop_stmt);
+ /* Save the end label of this LOOP_STMT in a stack so that the
+ corresponding N_Exit_Statement can find it. */
+ push_stack (&gnu_loop_label_stack, NULL_TREE,
+ LOOP_STMT_LABEL (gnu_loop_stmt));
/* Set the condition that under which the loop should continue.
For "LOOP .... END LOOP;" the condition is always true. */
gnat_iter_scheme);
}
- /* If the loop was named, have the name point to this loop. In this
- case, the association is not a ..._DECL node, but this LOOP_STMT. */
+ /* If the loop was named, have the name point to this loop. In this case,
+ the association is not a ..._DECL node, but the end label from this
+ LOOP_STMT. */
if (Present (Identifier (gnat_node)))
- save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_stmt, 1);
+ save_gnu_tree (Entity (Identifier (gnat_node)),
+ LOOP_STMT_LABEL (gnu_loop_stmt), 1);
/* Make the loop body into its own block, so any allocated storage
will be released every iteration. This is needed for stack
else
gnu_result = gnu_loop_stmt;
- pop_stack (&gnu_loop_stmt_stack);
+ pop_stack (&gnu_loop_label_stack);
}
break;
? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
(Present (Name (gnat_node))
? get_gnu_tree (Entity (Name (gnat_node)))
- : TREE_VALUE (gnu_loop_stmt_stack)));
+ : TREE_VALUE (gnu_loop_label_stack)));
break;
case N_Return_Statement:
gnu_lhs, DECL_INITIAL (gnu_decl));
DECL_INITIAL (gnu_decl) = 0;
- SET_EXPR_LOCUS (gnu_assign_stmt, &DECL_SOURCE_LOCATION (gnu_decl));
+ annotate_with_locus (gnu_assign_stmt, DECL_SOURCE_LOCATION (gnu_decl));
add_stmt (gnu_assign_stmt);
}
}
return GS_ALL_DONE;
case DECL_STMT:
- if (TREE_CODE (DECL_STMT_VAR (stmt)) == TYPE_DECL)
- *stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (DECL_STMT_VAR (stmt)));
- else
- *stmt_p = build_empty_stmt ();
- return GS_ALL_DONE;
+ {
+ tree var = DECL_STMT_VAR (stmt);
+
+ if (TREE_CODE (var) == TYPE_DECL)
+ *stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (var));
+ else if (TREE_CODE (var) == VAR_DECL && !DECL_EXTERNAL (var)
+ && !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
+ {
+ tree pt_type = build_pointer_type (TREE_TYPE (var));
+ tree size, pre = NULL_TREE, post = NULL_TREE;
+
+ /* This is a variable-sized decl. Simplify its size and mark it
+ for deferred expansion. Note that mudflap depends on the format
+ of the emitted code: see mx_register_decls. */
+ *stmt_p = NULL_TREE;
+ size = get_initialized_tmp_var (DECL_SIZE_UNIT (var), &pre, &post);
+ DECL_DEFER_OUTPUT (var) = 1;
+ append_to_statement_list (pre, stmt_p);
+ append_to_statement_list
+ (build_function_call_expr
+ (implicit_built_in_decls[BUILT_IN_STACK_ALLOC],
+ tree_cons (NULL_TREE,
+ build1 (ADDR_EXPR, pt_type, var),
+ tree_cons (NULL_TREE, size, NULL_TREE))),
+ stmt_p);
+ append_to_statement_list (post, stmt_p);
+ }
+ else
+ *stmt_p = build_empty_stmt ();
+ return GS_ALL_DONE;
+ }
case LOOP_STMT:
{
tree gnu_start_label = create_artificial_label ();
- tree gnu_end_label = create_artificial_label ();
+ tree gnu_end_label = LOOP_STMT_LABEL (stmt);
- /* Save the end label for EXIT_STMT and set to emit the statements
- of the loop. */
- LOOP_STMT_LABEL (stmt) = gnu_end_label;
+ /* Set to emit the statements of the loop. */
*stmt_p = NULL_TREE;
/* We first emit the start label and then a conditional jump to
case EXIT_STMT:
/* Build a statement to jump to the corresponding end label, then
see if it needs to be conditional. */
- *stmt_p = build1 (GOTO_EXPR, void_type_node,
- LOOP_STMT_LABEL (EXIT_STMT_LOOP (stmt)));
+ *stmt_p = build1 (GOTO_EXPR, void_type_node, EXIT_STMT_LABEL (stmt));
if (EXIT_STMT_COND (stmt))
*stmt_p = build (COND_EXPR, void_type_node,
EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ());
of the array component. It is needed for range checking. */
static tree
-pos_to_constructor (Node_Id gnat_expr,
- tree gnu_array_type,
+pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
Entity_Id gnat_component_type)
{
- tree gnu_expr;
tree gnu_expr_list = NULL_TREE;
+ tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
+ tree gnu_expr;
for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr))
{
}
gnu_expr_list
- = tree_cons (NULL_TREE, convert (TREE_TYPE (gnu_array_type), gnu_expr),
+ = tree_cons (gnu_index, convert (TREE_TYPE (gnu_array_type), gnu_expr),
gnu_expr_list);
+
+ gnu_index = fold (build2 (PLUS_EXPR, TREE_TYPE (gnu_index), gnu_index,
+ convert (TREE_TYPE (gnu_index),
+ integer_one_node)));
}
return gnat_build_constructor (gnu_array_type, nreverse (gnu_expr_list));
break;
case ARRAY_REF:
- result = build (ARRAY_REF, type,
- gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
- gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
- force));
- break;
-
case ARRAY_RANGE_REF:
- result = build (ARRAY_RANGE_REF, type,
+ result = build (code, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
- force));
+ force),
+ NULL_TREE, NULL_TREE);
break;
case COMPOUND_EXPR:
gnat_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY,
"memcpy", false);
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ ftype = build_function_type (integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_memcmp", ftype, BUILT_IN_MEMCMP,
+ "memcmp", false);
+
tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gnat_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
for (i = 0, inner_type = type; i < ndim;
i++, inner_type = TREE_TYPE (inner_type))
tem = build (ARRAY_REF, TREE_TYPE (inner_type), tem,
- convert (TYPE_DOMAIN (inner_type), size_zero_node));
+ convert (TYPE_DOMAIN (inner_type), size_zero_node),
+ NULL_TREE, NULL_TREE);
field_list
= chainon (field_list,
if (type == etype)
return expr;
/* If we're converting between two aggregate types that have the same main
- variant, just make a NOP_EXPR. */
+ variant, just make a VIEW_CONVER_EXPR. */
else if (AGGREGATE_TYPE_P (type)
&& TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
- return build1 (NOP_EXPR, type, expr);
+ return build1 (VIEW_CONVERT_EXPR, type, expr);
/* If the input type has padding, remove it by doing a component reference
to the field. If the output type has padding, make a constructor
case ERROR_MARK:
return expr;
+ case INTEGER_CST:
+ return (integer_zerop (expr) ? convert (type, integer_zero_node)
+ : convert (type, integer_one_node));
+
+ case REAL_CST:
+ return (real_zerop (expr) ? convert (type, integer_zero_node)
+ : convert (type, integer_one_node));
+
case COND_EXPR:
/* Distribute the conversion into the arms of a COND_EXPR. */
return fold
have to do here is validate the work done by SEM and handle subtypes. */
tree
-build_binary_op (enum tree_code op_code,
- tree result_type,
- tree left_operand,
- tree right_operand)
+build_binary_op (enum tree_code op_code, tree result_type,
+ tree left_operand, tree right_operand)
{
tree left_type = TREE_TYPE (left_operand);
tree right_type = TREE_TYPE (right_operand);
if (operation_type != right_type
&& (! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (operation_type))))
{
- /* For a variable-size type, with both BLKmode, convert using
- CONVERT_EXPR instead of an unchecked conversion since we don't
- need to make a temporary (and can't anyway). */
- if (TREE_CODE (TYPE_SIZE (operation_type)) != INTEGER_CST
- && TYPE_MODE (TREE_TYPE (right_operand)) == BLKmode
- && TREE_CODE (right_operand) != UNCONSTRAINED_ARRAY_REF)
- right_operand = build1 (CONVERT_EXPR, operation_type,
- right_operand);
- else
- right_operand = convert (operation_type, right_operand);
-
+ right_operand = convert (operation_type, right_operand);
right_type = operation_type;
}
just compare the data pointer. */
else if (TYPE_FAT_POINTER_P (left_base_type)
&& TREE_CODE (right_operand) == CONSTRUCTOR
- && integer_zerop (TREE_VALUE (CONSTRUCTOR_ELTS (right_operand))))
+ && integer_zerop (TREE_VALUE
+ (CONSTRUCTOR_ELTS (right_operand))))
{
right_operand = build_component_ref (left_operand, NULL_TREE,
TYPE_FIELDS (left_base_type),
return build1 (NULL_EXPR, operation_type, TREE_OPERAND (left_operand, 0));
else if (TREE_CODE (right_operand) == NULL_EXPR)
return build1 (NULL_EXPR, operation_type, TREE_OPERAND (right_operand, 0));
+ else if (op_code == ARRAY_REF || op_code == ARRAY_RANGE_REF)
+ result = fold (build (op_code, operation_type, left_operand, right_operand,
+ NULL_TREE, NULL_TREE));
else
- result = fold (build (op_code, operation_type,
- left_operand, right_operand));
+ result
+ = fold (build (op_code, operation_type, left_operand, right_operand));
TREE_SIDE_EFFECTS (result) |= has_side_effects;
TREE_CONSTANT (result)
OSDN Git Service
