From: Richard Kenner Date: Mon, 14 Jun 2004 14:09:38 +0000 (+0000) Subject: ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=966389eeaaf6b674bbfbdc34b06314c2dd7f8591;p=gcc.git ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation. * 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. From-SVN: r83103 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8cb9164d848..f0551826626 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2004-06-14 Richard Kenner + + * 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 * gnat_ugn.texi: Document relocatable vs. dynamic Library_Kind on diff --git a/gcc/ada/ada-tree.def b/gcc/ada/ada-tree.def index 5922d54ef51..b185106f62e 100644 --- a/gcc/ada/ada-tree.def +++ b/gcc/ada/ada-tree.def @@ -61,13 +61,13 @@ DEFTREECODE (STMT_STMT, "stmt_stmt", 's', 1) /* 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) @@ -85,4 +85,3 @@ DEFTREECODE (HANDLER_STMT, "handler_stmt", 's', 3) /* A statement that emits a USE for its single operand. */ DEFTREECODE (USE_STMT, "use_expr", 's', 1) - diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h index a43cd48ecf2..9cdcc5d5584 100644 --- a/gcc/ada/ada-tree.h +++ b/gcc/ada/ada-tree.h @@ -272,7 +272,7 @@ struct lang_type GTY(()) {union lang_tree_node t; }; #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) diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 41d405a47d4..3f5d80939fb 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -299,12 +299,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* 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. */ diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index e7a5f9fc89a..0dec6721252 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -106,8 +106,8 @@ static GTY(()) tree gnu_except_ptr_stack; 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. */ @@ -2139,11 +2139,13 @@ gnat_to_gnu (Node_Id gnat_node) 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. */ @@ -2227,10 +2229,12 @@ gnat_to_gnu (Node_Id gnat_node) 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 @@ -2258,7 +2262,7 @@ gnat_to_gnu (Node_Id gnat_node) else gnu_result = gnu_loop_stmt; - pop_stack (&gnu_loop_stmt_stack); + pop_stack (&gnu_loop_label_stack); } break; @@ -2281,7 +2285,7 @@ gnat_to_gnu (Node_Id gnat_node) ? 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: @@ -4025,7 +4029,7 @@ add_stmt (tree gnu_stmt) 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); } } @@ -4254,20 +4258,44 @@ gnat_gimplify_stmt (tree *stmt_p) 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 @@ -4314,8 +4342,7 @@ gnat_gimplify_stmt (tree *stmt_p) 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 ()); @@ -5255,12 +5282,12 @@ assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type) 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)) { @@ -5285,8 +5312,12 @@ pos_to_constructor (Node_Id 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)); @@ -5454,17 +5485,12 @@ gnat_stabilize_reference (tree ref, int force) 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: diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 1b50b71313e..6906e98e293 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -467,6 +467,13 @@ gnat_install_builtins () 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); @@ -2489,7 +2496,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) 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, @@ -2847,10 +2855,10 @@ convert (tree type, tree expr) 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 diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index ed9953103c0..0d83f74e9b6 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -84,6 +84,14 @@ gnat_truthvalue_conversion (tree expr) 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 @@ -578,10 +586,8 @@ nonbinary_modular_operation (enum tree_code op_code, 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); @@ -739,17 +745,7 @@ build_binary_op (enum tree_code op_code, 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; } @@ -894,7 +890,8 @@ build_binary_op (enum tree_code op_code, 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), @@ -1008,9 +1005,12 @@ build_binary_op (enum tree_code op_code, 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)