From 821e1ea1b155e9ca33f12e8e7af447042822c66b Mon Sep 17 00:00:00 2001 From: Richard Kenner Date: Mon, 7 Jun 2004 19:52:53 +0000 Subject: [PATCH] ada-tree.def (TRANSFORM_EXPR, [...]): Deleted. * ada-tree.def (TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR): Deleted. (GNAT_NOP_EXPR, GNAT_LOOP_ID, EXPR_STMT, NULL_STMT): Likewise. (BLOCK_STMT, IF_STMT, GOTO_STMT, LABEL_STMT, RETURN_STMT): Likewise. (ASM_STMT, BREAK_STMT, REGION_STMT,HANDLER_STMT): Likewise. (STMT_STMT, USE_STMT): New statement codes. (LOOP_STMT, EXIT_STMT): Make slight semantic changes. * ada-tree.h: Reflect above changes. (struct tree_loop_id): Deleted. (union lang_tree_node, struct lang_decl, struct lang_type): Now just contains a tree node; update macros using TYPE_LANG_SPECIFIC and DECL_LANGUAGE_SPECIFIC to reflect these changes. (DECL_INIT_BY_ASSIGN_P, TRE_LOOP_NODE_ID, TREE_SLOC): Deleted. (IS_ADA_STMT): New macro. * decl.c (annotate_decl_with_node): New function. (gnat_to_gnu_entity): Use it and Sloc_to_locus instead of set_lineno. (gnat_to_gnu_entity, case object): Remove call to expand CONVERT_EXPR. Call add_stmt_with_node to do needed assignments. Add call to update setjmp buffer directly, not via EXPR_STMT. (maybe_variable): Argment GNAT_NODE deleted. * gigi.h (maybe_variable): Likewise. (make_transform, add_stmt_with_node, set_block_for_group): New. (gnat_gimplify_expr, gnat_expand_body, Sloc_to_locus): Likewise. (set_block_jmpbuf_decl, get_block_jmpbuf_decl): Likewise. (discard_file_names, gnu_block_stack, gnat_to_code): Deleted. (set_lineno, set_lineno_from_sloc): Likewise. (record_code_position, insert_code_for): Likewise. (gnat_poplevel): Now returns void. (end_subprog_body): Now takes argument. * misc.c (cgraph.h, tree-inline.h): New includes. (gnat_tree_size, LANG_HOOKS_TREE_SIZE): Deleted. (gnat_post_options, LANG_HOOKS_POST_OPTIONS): New. (LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): Likewise. (LANG_HOOKS_RTL_EXPAND_STMT, LANG_HOOKS_GIMPLIFY_EXPR): Likewise. (gnat_parse_file): Don't set immediate_size_expand. Call cgraph functions. (gnat_expand_expr): Remove most cases. (record_code_position, insert_code_for): Remove from here. * trans.c (toplev.h, tree-gimple.h): Now included. (discard_file_names): Deleted. (gnu_block_stack, gnu_block_stmt_node, gnu_block_stmt_free_list): Del. (first_nondeleted_insn, make_expr_stmt_from_rtl): Likewise. (struct stmt_group, current_stmt_group, stmt_group_free_list): New. (gnu_stack_free_list, record_cost_position, insert_code_for): Likewise. (add_cleanup, push_stack, gnat_gimplify_stmt, add_cleanup): Likewise. (gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Likewise. (gnat_expand_body_1, gnat_gimplify_expr, annotate_with_node): Likewise. (set_block_for_group, add_stmt_list): Likewise. (start_stmt_group): Renamed from start_block_stmt. (end_stmt_group): Likewise, from end_block_stmt. (build_stmt_group): Likewise, from build_block_stmt, also add arg. (gigi): Don't set discard_file_names or call set_lineno. Disallow front end ZCX; call gnat_to_gnu, not gnat_to_code. (tree_transform): Deleted, now renamed to be gnat_to_gnu. Numerous changes throughout to reflect new names and complete function-at-a-time implementation. (gnat_expand_stmt): Delete or comment out all cases. (process_inlined_subprograms): Use add_stmt. (process_decls): Use gnat_to_gnu, not gnat_to_code, and don't call set_lineno; also remove unneeded block handling. (process_type): Remove unneeded block handling. (build_unit_elab): Remove calls to deleted functions. * utils.c (cgraph.h, tree-inline.h, tree-gimple.h): Now include. (tree-dump.h): Likewise. (struct ada_binding_level): Add field jmpbuf_decl. (gnat_define_builtin, gnat_install_builtins): New. (gnat_gimplify_function, gnat_finalize): Likewise. (gnat_poplevel): No longer return BLOCK, set it instead. Remove code dealing with nested functions. (gnat_init_decl_processing): Also set size_type_node. Call gnat_install_builtins. (create_var_decl): Don't set DECL_INIT_BY_ASSIGN. (create_subprog_decl): Change handling of inline_flag; set TREE_STATIC. Remove special-case for "main". (end_subprog_body): Add arg and rework for tree-ssa. (convert): Don't use GNAT_NOP_EXPR or look for TRANSFORM_EXPR. Add case for BOOLEAN_TYPE. * utils2.c (rtl.h): Now include. (build_call_raise): Test Debug_Flag_NN directly. (build_call_alloc_dealloc): Don't use local stack allocation for now. (gnat_mark_addressable, case GNAT_NOP_EXPR): Deleted. (gnat_mark_addressable, case VAR_DECL): Handle both early & late cases. From-SVN: r82714 --- gcc/ada/ChangeLog | 84 ++ gcc/ada/ada-tree.def | 105 +-- gcc/ada/ada-tree.h | 92 +- gcc/ada/decl.c | 161 ++-- gcc/ada/gigi.h | 70 +- gcc/ada/misc.c | 155 +--- gcc/ada/trans.c | 2063 +++++++++++++++++++----------------------- gcc/ada/utils.c | 313 ++++--- gcc/ada/utils2.c | 38 +- 9 files changed, 1474 insertions(+), 1607 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index da33d279e46..d4a85250bb4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,87 @@ +2004-06-07 Richard Kenner + + * ada-tree.def (TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR): Deleted. + (GNAT_NOP_EXPR, GNAT_LOOP_ID, EXPR_STMT, NULL_STMT): Likewise. + (BLOCK_STMT, IF_STMT, GOTO_STMT, LABEL_STMT, RETURN_STMT): Likewise. + (ASM_STMT, BREAK_STMT, REGION_STMT,HANDLER_STMT): Likewise. + (STMT_STMT, USE_STMT): New statement codes. + (LOOP_STMT, EXIT_STMT): Make slight semantic changes. + * ada-tree.h: Reflect above changes. + (struct tree_loop_id): Deleted. + (union lang_tree_node, struct lang_decl, struct lang_type): + Now just contains a tree node; update macros using TYPE_LANG_SPECIFIC + and DECL_LANGUAGE_SPECIFIC to reflect these changes. + (DECL_INIT_BY_ASSIGN_P, TRE_LOOP_NODE_ID, TREE_SLOC): Deleted. + (IS_ADA_STMT): New macro. + * decl.c (annotate_decl_with_node): New function. + (gnat_to_gnu_entity): Use it and Sloc_to_locus instead of set_lineno. + (gnat_to_gnu_entity, case object): Remove call to expand CONVERT_EXPR. + Call add_stmt_with_node to do needed assignments. + Add call to update setjmp buffer directly, not via EXPR_STMT. + (maybe_variable): Argment GNAT_NODE deleted. + * gigi.h (maybe_variable): Likewise. + (make_transform, add_stmt_with_node, set_block_for_group): New. + (gnat_gimplify_expr, gnat_expand_body, Sloc_to_locus): Likewise. + (set_block_jmpbuf_decl, get_block_jmpbuf_decl): Likewise. + (discard_file_names, gnu_block_stack, gnat_to_code): Deleted. + (set_lineno, set_lineno_from_sloc): Likewise. + (record_code_position, insert_code_for): Likewise. + (gnat_poplevel): Now returns void. + (end_subprog_body): Now takes argument. + * misc.c (cgraph.h, tree-inline.h): New includes. + (gnat_tree_size, LANG_HOOKS_TREE_SIZE): Deleted. + (gnat_post_options, LANG_HOOKS_POST_OPTIONS): New. + (LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): Likewise. + (LANG_HOOKS_RTL_EXPAND_STMT, LANG_HOOKS_GIMPLIFY_EXPR): Likewise. + (gnat_parse_file): Don't set immediate_size_expand. + Call cgraph functions. + (gnat_expand_expr): Remove most cases. + (record_code_position, insert_code_for): Remove from here. + * trans.c (toplev.h, tree-gimple.h): Now included. + (discard_file_names): Deleted. + (gnu_block_stack, gnu_block_stmt_node, gnu_block_stmt_free_list): Del. + (first_nondeleted_insn, make_expr_stmt_from_rtl): Likewise. + (struct stmt_group, current_stmt_group, stmt_group_free_list): New. + (gnu_stack_free_list, record_cost_position, insert_code_for): Likewise. + (add_cleanup, push_stack, gnat_gimplify_stmt, add_cleanup): Likewise. + (gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Likewise. + (gnat_expand_body_1, gnat_gimplify_expr, annotate_with_node): Likewise. + (set_block_for_group, add_stmt_list): Likewise. + (start_stmt_group): Renamed from start_block_stmt. + (end_stmt_group): Likewise, from end_block_stmt. + (build_stmt_group): Likewise, from build_block_stmt, also add arg. + (gigi): Don't set discard_file_names or call set_lineno. + Disallow front end ZCX; call gnat_to_gnu, not gnat_to_code. + (tree_transform): Deleted, now renamed to be gnat_to_gnu. + Numerous changes throughout to reflect new names and complete + function-at-a-time implementation. + (gnat_expand_stmt): Delete or comment out all cases. + (process_inlined_subprograms): Use add_stmt. + (process_decls): Use gnat_to_gnu, not gnat_to_code, and don't + call set_lineno; also remove unneeded block handling. + (process_type): Remove unneeded block handling. + (build_unit_elab): Remove calls to deleted functions. + * utils.c (cgraph.h, tree-inline.h, tree-gimple.h): Now include. + (tree-dump.h): Likewise. + (struct ada_binding_level): Add field jmpbuf_decl. + (gnat_define_builtin, gnat_install_builtins): New. + (gnat_gimplify_function, gnat_finalize): Likewise. + (gnat_poplevel): No longer return BLOCK, set it instead. + Remove code dealing with nested functions. + (gnat_init_decl_processing): Also set size_type_node. + Call gnat_install_builtins. + (create_var_decl): Don't set DECL_INIT_BY_ASSIGN. + (create_subprog_decl): Change handling of inline_flag; set TREE_STATIC. + Remove special-case for "main". + (end_subprog_body): Add arg and rework for tree-ssa. + (convert): Don't use GNAT_NOP_EXPR or look for TRANSFORM_EXPR. + Add case for BOOLEAN_TYPE. + * utils2.c (rtl.h): Now include. + (build_call_raise): Test Debug_Flag_NN directly. + (build_call_alloc_dealloc): Don't use local stack allocation for now. + (gnat_mark_addressable, case GNAT_NOP_EXPR): Deleted. + (gnat_mark_addressable, case VAR_DECL): Handle both early & late cases. + 2004-06-07 Robert Dewar * a-direct.ads, einfo.ads: Minor comment updates diff --git a/gcc/ada/ada-tree.def b/gcc/ada/ada-tree.def index 719f15ec4be..5922d54ef51 100644 --- a/gcc/ada/ada-tree.def +++ b/gcc/ada/ada-tree.def @@ -24,21 +24,6 @@ * * ****************************************************************************/ -/* A GNAT tree node to transform to a GCC tree. This is only used when the - node would generate code, rather then just a tree, and we are in the global - context. - - The only field used is TREE_COMPLEXITY, which contains the GNAT node - number. */ - -DEFTREECODE (TRANSFORM_EXPR, "transform_expr", 'e', 0) - -/* Dynamically allocate on the stack a number of bytes of memory given - by operand 0 at the alignment given by operand 1 and return the - address of the resulting memory. */ - -DEFTREECODE (ALLOCATE_EXPR, "allocate_expr", '2', 2) - /* A type that is an unconstrained array itself. This node is never passed to GCC. TREE_TYPE is the type of the fat pointer and TYPE_OBJECT_RECORD_TYPE is the type of a record containing the template and data. */ @@ -54,70 +39,50 @@ DEFTREECODE (UNCONSTRAINED_ARRAY_REF, "unconstrained_array_ref", 'r', 1) /* An expression that returns an RTL suitable for its type. Operand 0 is an expression to be evaluated for side effects only. */ - DEFTREECODE (NULL_EXPR, "null_expr", 'e', 1) -/* An expression that emits a USE for its single operand. */ - -DEFTREECODE (USE_EXPR, "use_expr", 'e', 1) - /* Same as ADDR_EXPR, except that if the operand represents a bit field, return the address of the byte containing the bit. This is used for the 'Address attribute and never shows up in the tree. */ DEFTREECODE (ATTR_ADDR_EXPR, "attr_addr_expr", 'r', 1) -/* An expression that is treated as a conversion while generating code, but is - used to prevent infinite recursion when conversions of biased types are - involved. */ - -DEFTREECODE (GNAT_NOP_EXPR, "gnat_nop_expr", '1', 1) - -/* This is used as a place to store the ID of a loop. - - ??? This should be redone at some point. */ - -DEFTREECODE (GNAT_LOOP_ID, "gnat_loop_id", 'x', 0) - /* Here are the tree codes for the statement types known to Ada. These - must be at the end of this file to allow IS_STMT to work. - - We start with an expression statement, whose only operand is an - expression, EXPR_STMT_EXPR, Execution of the statement means evaluation of - the expression (such as a MODIFY_EXPR) and discarding its result. */ -DEFTREECODE (EXPR_STMT, "expr_stmt", 's', 1) - -/* This is a null statement. The intent is for it not to survive very far. */ -DEFTREECODE (NULL_STMT, "null_stmt", 's', 0) + must be at the end of this file to allow IS_ADA_STMT to work. */ -/* This defines the variable in DECL_STMT_VAR and performs any initialization - in DECL_INITIAL. */ +/* This defines the variable in DECL_STMT_VAR. */ DEFTREECODE (DECL_STMT, "decl_stmt", 's', 1) -/* This represents a list of statements. BLOCK_STMT_LIST is a list - statement tree, chained via TREE_CHAIN. BLOCK_STMT_BLOCK, if nonzero, - is the BLOCK node for these statements. */ -DEFTREECODE (BLOCK_STMT, "block_stmt", 's', 2) - -/* This is an IF statement. IF_STMT_COND is the condition being tested, - IF_STMT_TRUE is the statement to be executed if the condition is - true; IF_STMT_ELSEIF, if non-null, is a list of more IF_STMT nodes (where - we only look at IF_STMT_COND and IF_STMT_TRUE) that correspond to - any "else if" parts; and IF_STMT_ELSE is the statement to be executed if - all conditions are. */ -DEFTREECODE (IF_STMT, "if_stmt", 's', 4) - -/* A goto just points to the label: GOTO_STMT_LABEL. */ -DEFTREECODE (GOTO_STMT, "goto_stmt", 's', 1) - -/* A label: LABEL_STMT_LABEL is the label. */ -DEFTREECODE (LABEL_STMT, "label_stmt", 's', 1) - -/* A "return". RETURN_STMT_EXPR is the value to return if non-null. */ -DEFTREECODE (RETURN_STMT, "return_stmt", 's', 1) - -/* An "asm" statement. The operands are ASM_STMT_TEMPLATE, ASM_STMT_OUTPUT, - ASM_STMT_ORIG_OUT, ASM_STMT_INPUT, and ASM_STMT_CLOBBER. */ -DEFTREECODE (ASM_STMT, "asm_stmt", 's', 5) +/* This is how record_code_position and insert_code_for work. The former + makes this tree node, whose operand is a statement. The latter inserts + the actual statements into this node. Gimplification consists of + just returning the inner statement. */ +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. */ +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 + corresponding to the loop to exit. */ +DEFTREECODE (EXIT_STMT, "exit_stmt", 's', 2) + +/* A exception region. REGION_STMT_BODY is the statement to be executed + inside the region. REGION_STMT_HANDLE is a statement that represents + the exception handlers (usually a BLOCK_STMT of HANDLE_STMTs). + REGION_STMT_BLOCK is the BLOCK node for the declarative region, if any. */ +DEFTREECODE (REGION_STMT, "region_stmt", 's', 3) + +/* An exception handler. HANDLER_STMT_ARG is the value to pass to + expand_start_catch, HANDLER_STMT_LIST is the list of statements for the + handler itself, and HANDLER_STMT_BLOCK is the BLOCK node for this + binding. */ +DEFTREECODE (HANDLER_STMT, "handler_stmt", 's', 3) + +/* A statement that emits a USE for its single operand. */ +DEFTREECODE (USE_STMT, "use_expr", 's', 1) -/* An analog to the C "break" statement. */ -DEFTREECODE (BREAK_STMT, "break_stmt", 's', 0) diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h index 6ab348e9d20..a43cd48ecf2 100644 --- a/gcc/ada/ada-tree.h +++ b/gcc/ada/ada-tree.h @@ -33,35 +33,10 @@ enum gnat_tree_code { }; #undef DEFTREECODE -/* A tree to hold a loop ID. */ -struct tree_loop_id GTY(()) -{ - struct tree_common common; - struct nesting *loop_id; -}; - -/* The language-specific tree. */ -union lang_tree_node - GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"), - chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) -{ - union tree_node GTY ((tag ("0"), - desc ("tree_node_structure (&%h)"))) - generic; - struct tree_loop_id GTY ((tag ("1"))) loop_id; -}; - /* Ada uses the lang_decl and lang_type fields to hold more trees. */ -struct lang_decl GTY(()) -{ - union lang_tree_node - GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"))) t; -}; -struct lang_type GTY(()) -{ - union lang_tree_node - GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"))) t; -}; +union lang_tree_node GTY((desc ("0"))) {union tree_node GTY((tag ("0"))) t; }; +struct lang_decl GTY(()) {union lang_tree_node t; }; +struct lang_type GTY(()) {union lang_tree_node t; }; /* Flags added to GCC type nodes. */ @@ -164,28 +139,28 @@ struct lang_type GTY(()) by copy in copy out. It is a CONSTRUCTOR. For a full description of the cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */ #define TYPE_CI_CO_LIST(NODE) \ - (&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.generic) + (&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.t) #define SET_TYPE_CI_CO_LIST(NODE, X) \ (TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) /* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the modulus. */ #define TYPE_MODULUS(NODE) \ - (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) + (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t) #define SET_TYPE_MODULUS(NODE, X) \ (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) /* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to the type corresponding to the Ada index type. */ #define TYPE_INDEX_TYPE(NODE) \ - (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) + (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t) #define SET_TYPE_INDEX_TYPE(NODE, X) \ (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X)) /* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the Digits_Value. */ #define TYPE_DIGITS_VALUE(NODE) \ - (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) + (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t) #define SET_TYPE_DIGITS_VALUE(NODE, X) \ (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X)) @@ -194,7 +169,7 @@ struct lang_type GTY(()) /* Likewise for ENUMERAL_TYPE. */ #define TYPE_RM_SIZE_ENUM(NODE) \ - (&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.generic) + (&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.t) #define SET_TYPE_RM_SIZE_ENUM(NODE, X) \ (TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) @@ -207,21 +182,21 @@ struct lang_type GTY(()) unconstrained object. Likewise for a RECORD_TYPE that is pointed to by a thin pointer. */ #define TYPE_UNCONSTRAINED_ARRAY(NODE) \ - (&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.generic) + (&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.t) #define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \ (TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) /* For other RECORD_TYPEs and all UNION_TYPEs and QUAL_UNION_TYPEs, the Ada size of the object. This differs from the GCC size in that it does not include any rounding up to the alignment of the type. */ -#define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.generic) +#define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t) #define SET_TYPE_ADA_SIZE(NODE, X) \ (TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X)) /* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is the index type that should be used when the actual bounds are required for a template. This is used in the case of packed arrays. */ -#define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.generic) +#define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t) #define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \ (TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X)) @@ -238,9 +213,6 @@ struct lang_type GTY(()) discriminant. */ #define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE)) -/* Nonzero in a VAR_DECL if it needs to be initialized by an assignment. */ -#define DECL_INIT_BY_ASSIGN_P(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE)) - /* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF is needed to access the object. */ #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE) @@ -270,14 +242,14 @@ struct lang_type GTY(()) memory. Used when a scalar constant is aliased or has its address taken. */ #define DECL_CONST_CORRESPONDING_VAR(NODE) \ - (&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.generic) + (&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.t) #define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \ (DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE)) = (struct lang_decl *)(X)) /* In a FIELD_DECL, points to the FIELD_DECL that was the ultimate source of the decl. */ #define DECL_ORIGINAL_FIELD(NODE) \ - (&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.generic) + (&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.t) #define SET_DECL_ORIGINAL_FIELD(NODE, X) \ (DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE)) = (struct lang_decl *)(X)) @@ -285,31 +257,25 @@ struct lang_type GTY(()) discriminant number. */ #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) -/* This is the loop id for a GNAT_LOOP_ID node. */ -#define TREE_LOOP_ID(NODE) \ - ((union lang_tree_node *) GNAT_LOOP_ID_CHECK (NODE))->loop_id.loop_id - /* Define fields and macros for statements. Start by defining which tree codes are used for statements. */ #define IS_STMT(NODE) (TREE_CODE_CLASS (TREE_CODE (NODE)) == 's') +#define IS_ADA_STMT(NODE) (IS_STMT (NODE) \ + && TREE_CODE (NODE) >= DECL_STMT) -/* We store the Sloc in statement nodes. */ -#define TREE_SLOC(NODE) TREE_COMPLEXITY (STMT_CHECK (NODE)) - -#define EXPR_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXPR_STMT, 0) #define DECL_STMT_VAR(NODE) TREE_OPERAND_CHECK_CODE (NODE, DECL_STMT, 0) -#define BLOCK_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 0) -#define BLOCK_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 1) -#define IF_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 0) -#define IF_STMT_TRUE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 1) -#define IF_STMT_ELSEIF(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 2) -#define IF_STMT_ELSE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 3) -#define GOTO_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, GOTO_STMT, 0) -#define LABEL_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LABEL_STMT, 0) -#define RETURN_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, RETURN_STMT, 0) -#define ASM_STMT_TEMPLATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 0) -#define ASM_STMT_OUTPUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 1) -#define ASM_STMT_ORIG_OUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 2) -#define ASM_STMT_INPUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 3) -#define ASM_STMT_CLOBBER(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 4) +#define STMT_STMT_STMT(NODE) TREE_OPERAND_CHECK_CODE (NODE, STMT_STMT, 0) +#define LOOP_STMT_TOP_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 0) +#define LOOP_STMT_BOT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 1) +#define LOOP_STMT_UPDATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 2) +#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 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) +#define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0) +#define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1) +#define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 2) diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index e38fcf05d43..41d405a47d4 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -102,6 +102,7 @@ static void set_rm_size (Uint, tree, Entity_Id); static tree make_type_from_size (tree, tree, int); static unsigned int validate_alignment (Uint, Entity_Id, unsigned int); static void check_ok_for_atomic (tree, Entity_Id, int); +static void annotate_decl_with_node (tree, Node_Id); /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a GCC type corresponding to that entity. GNAT_ENTITY is assumed to @@ -279,9 +280,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Get the name of the entity and set up the line number and filename of the original definition for use in any decl we make. */ - gnu_entity_id = get_entity_name (gnat_entity); - set_lineno (gnat_entity, 0); + Sloc_to_locus (Sloc (gnat_entity), &input_location); /* If we get here, it means we have not yet done anything with this entity. If we are not defining it here, it must be external, @@ -767,14 +767,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (staticp (gnu_expr) && ! TREE_SIDE_EFFECTS (gnu_expr)))) { - set_lineno (gnat_entity, ! global_bindings_p ()); gnu_decl = gnat_stabilize_reference (gnu_expr, 1); save_gnu_tree (gnat_entity, gnu_decl, 1); saved = 1; - - if (! global_bindings_p ()) - expand_expr_stmt (build1 (CONVERT_EXPR, void_type_node, - gnu_decl)); break; } else @@ -955,20 +950,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_SIZE_UNIT (gnu_type)); tree gnu_new_var; - set_lineno (gnat_entity, 1); gnu_new_var = create_var_decl (create_concat_name (gnat_entity, "ALIGN"), NULL_TREE, gnu_new_type, gnu_expr, 0, 0, 0, 0, 0); + annotate_decl_with_node (gnu_new_var, gnat_entity); add_decl_stmt (gnu_new_var, gnat_entity); if (gnu_expr != 0) - expand_expr_stmt - (build_binary_op - (MODIFY_EXPR, NULL_TREE, - build_component_ref (gnu_new_var, NULL_TREE, - TYPE_FIELDS (gnu_new_type), 0), - gnu_expr)); + add_stmt_with_node + (build_binary_op (MODIFY_EXPR, NULL_TREE, + build_component_ref + (gnu_new_var, NULL_TREE, + TYPE_FIELDS (gnu_new_type), 0), + gnu_expr), + gnat_entity); gnu_type = build_reference_type (gnu_type); gnu_expr @@ -1024,13 +1020,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TYPE_IS_PADDING_P (gnu_type)))) static_p = 1; - set_lineno (gnat_entity, ! global_bindings_p ()); gnu_decl = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, gnu_expr, const_flag, Is_Public (gnat_entity), imported_p || !definition, static_p, attr_list); - + annotate_decl_with_node (gnu_decl, gnat_entity); DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; @@ -1045,25 +1040,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) add_decl_stmt (gnu_decl, gnat_entity); if (definition && DECL_SIZE (gnu_decl) != 0 - && gnu_block_stack != 0 - && TREE_VALUE (gnu_block_stack) != 0 + && get_block_jmpbuf_decl () && (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST || (flag_stack_check && ! STACK_CHECK_BUILTIN && 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl), STACK_CHECK_MAX_VAR_SIZE)))) - { - tree gnu_stmt - = build_nt (EXPR_STMT, - (build_call_1_expr - (update_setjmp_buf_decl, - build_unary_op - (ADDR_EXPR, NULL_TREE, - TREE_VALUE (gnu_block_stack))))); - - TREE_SLOC (gnu_stmt) = Sloc (gnat_entity); - TREE_TYPE (gnu_stmt) = void_type_node; - add_stmt (gnu_stmt); - } + add_stmt_with_node (build_call_1_expr + (update_setjmp_buf_decl, + build_unary_op (ADDR_EXPR, NULL_TREE, + get_block_jmpbuf_decl ())), + gnat_entity); /* If this is a public constant or we're not optimizing and we're not making a VAR_DECL for it, make one just for export or debugger @@ -1527,7 +1513,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Make the FIELD_DECLs for the minimum and maximum of this type and then make extractions of that field from the template. */ - set_lineno (gnat_entity, 0); sprintf (field_name, "LB%d", index); gnu_min_field = create_field_decl (get_identifier (field_name), gnu_ind_subtype, @@ -1537,6 +1522,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_ind_subtype, gnu_template_type, 0, 0, 0, 0); + annotate_decl_with_node (gnu_min_field, gnat_entity); + annotate_decl_with_node (gnu_max_field, gnat_entity); gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field); /* We can't use build_component_ref here since the template @@ -2062,14 +2049,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* First finish the type we had been making so that we output debugging information for it */ - gnu_type = build_qualified_type (gnu_type, - (TYPE_QUALS (gnu_type) - | (TYPE_QUAL_VOLATILE - * Treat_As_Volatile (gnat_entity)))); - set_lineno (gnat_entity, 0); + gnu_type + = build_qualified_type (gnu_type, + (TYPE_QUALS (gnu_type) + | (TYPE_QUAL_VOLATILE + * Treat_As_Volatile (gnat_entity)))); gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, ! Comes_From_Source (gnat_entity), debug_info_p); + annotate_decl_with_node (gnu_decl, gnat_entity); if (! Comes_From_Source (gnat_entity)) DECL_ARTIFICIAL (gnu_decl) = 1; @@ -2128,14 +2116,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) for (gnat_index = First_Index (gnat_entity); Present (gnat_index); gnat_index = Next_Index (gnat_index)) - SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type, - tree_cons (NULL_TREE, - get_unpadded_type (Etype (gnat_index)), - TYPE_ACTUAL_BOUNDS (gnu_inner_type))); + SET_TYPE_ACTUAL_BOUNDS + (gnu_inner_type, + tree_cons (NULL_TREE, + get_unpadded_type (Etype (gnat_index)), + TYPE_ACTUAL_BOUNDS (gnu_inner_type))); if (Convention (gnat_entity) != Convention_Fortran) - SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type, - nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type))); + SET_TYPE_ACTUAL_BOUNDS + (gnu_inner_type, + nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type))); if (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type)) @@ -2295,10 +2285,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { defer_incomplete_level++; this_deferred = 1; - set_lineno (gnat_entity, 0); gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, ! Comes_From_Source (gnat_entity), debug_info_p); + annotate_decl_with_node (gnu_decl, gnat_entity); save_gnu_tree (gnat_entity, gnu_decl, 0); this_made_decl = saved = 1; } @@ -2656,10 +2646,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) DECL_INTERNAL_P (gnu_field) = DECL_INTERNAL_P (gnu_old_field); - SET_DECL_ORIGINAL_FIELD (gnu_field, - (DECL_ORIGINAL_FIELD (gnu_old_field) != 0 - ? DECL_ORIGINAL_FIELD (gnu_old_field) - : gnu_old_field)); + SET_DECL_ORIGINAL_FIELD + (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field) != 0 + ? DECL_ORIGINAL_FIELD (gnu_old_field) + : gnu_old_field)); DECL_DISCRIMINANT_NUMBER (gnu_field) = DECL_DISCRIMINANT_NUMBER (gnu_old_field); TREE_THIS_VOLATILE (gnu_field) @@ -2700,10 +2690,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type))) for (gnu_temp = gnu_subst_list; gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp)) - SET_TYPE_ADA_SIZE (gnu_type, - substitute_in_expr (TYPE_ADA_SIZE (gnu_type), - TREE_PURPOSE (gnu_temp), - TREE_VALUE (gnu_temp))); + SET_TYPE_ADA_SIZE + (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type), + TREE_PURPOSE (gnu_temp), + TREE_VALUE (gnu_temp))); /* Recompute the mode of this record type now that we know its actual size. */ @@ -2901,7 +2891,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old); TYPE_POINTER_TO (gnu_old) = gnu_type; - set_lineno (gnat_entity, 0); + Sloc_to_locus (Sloc (gnat_entity), &input_location); fields = chainon (chainon (NULL_TREE, create_field_decl @@ -3492,7 +3482,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_param = 0; else { - set_lineno (gnat_param, 0); gnu_param = create_param_decl (gnu_param_name, gnu_param_type, @@ -3505,6 +3494,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) DECL_POINTS_TO_READONLY_P (gnu_param) = (Ekind (gnat_param) == E_In_Parameter && (by_ref_p || by_component_ptr_p)); + annotate_decl_with_node (gnu_param, gnat_param); save_gnu_tree (gnat_param, gnu_param, 0); gnu_param_list = chainon (gnu_param, gnu_param_list); @@ -3530,9 +3520,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) has_copy_in_out = 1; } - set_lineno (gnat_param, 0); gnu_field = create_field_decl (gnu_param_name, gnu_param_type, gnu_return_type, 0, 0, 0, 0); + annotate_decl_with_node (gnu_field, gnat_param); TREE_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; gnu_return_list = tree_cons (gnu_field, gnu_param, @@ -3595,7 +3585,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) | (TYPE_QUAL_CONST * pure_flag) | (TYPE_QUAL_VOLATILE * volatile_flag))); - set_lineno (gnat_entity, 0); + Sloc_to_locus (Sloc (gnat_entity), &input_location); /* If there was no specified Interface_Name and the external and internal names of the subprogram are the same, only use the @@ -3702,10 +3692,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Save this type as the full declaration's type so we can do any needed updates when we see it. */ - set_lineno (gnat_entity, 0); gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, ! Comes_From_Source (gnat_entity), debug_info_p); + annotate_decl_with_node (gnu_decl, gnat_entity); save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0); break; @@ -3867,12 +3857,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); if (TREE_CODE (gnu_type) == RECORD_TYPE) - SET_TYPE_ADA_SIZE (gnu_type, - elaborate_expression_1 (gnat_entity, gnat_entity, - TYPE_ADA_SIZE (gnu_type), - get_identifier ("RM_SIZE"), - definition, 0)); - } + SET_TYPE_ADA_SIZE + (gnu_type, + elaborate_expression_1 (gnat_entity, + gnat_entity, + TYPE_ADA_SIZE (gnu_type), + get_identifier ("RM_SIZE"), + definition, 0)); + } } /* If this is a record type or subtype, call elaborate_expression_1 on @@ -3919,10 +3911,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (gnu_decl == 0) { - set_lineno (gnat_entity, 0); gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, ! Comes_From_Source (gnat_entity), debug_info_p); + annotate_decl_with_node (gnu_decl, gnat_entity); } else TREE_TYPE (gnu_decl) = gnu_type; @@ -4171,8 +4163,8 @@ mark_out_of_scope (Entity_Id gnat_entity) for (gnat_sub_entity = First_Entity (gnat_entity); Present (gnat_sub_entity); gnat_sub_entity = Next_Entity (gnat_sub_entity)) - if (Scope (gnat_sub_entity) == gnat_entity - && gnat_sub_entity != gnat_entity) + if (Scope (gnat_sub_entity) == gnat_entity + && gnat_sub_entity != gnat_entity) mark_out_of_scope (gnat_sub_entity); /* Now clear this if it has been defined, but only do so if it isn't @@ -4427,18 +4419,13 @@ get_unpadded_type (Entity_Id gnat_entity) /* Called when we need to protect a variable object using a save_expr. */ tree -maybe_variable (tree gnu_operand, Node_Id gnat_node) +maybe_variable (tree gnu_operand) { if (TREE_CONSTANT (gnu_operand) || TREE_READONLY (gnu_operand) || TREE_CODE (gnu_operand) == SAVE_EXPR || TREE_CODE (gnu_operand) == NULL_EXPR) return gnu_operand; - /* If we will be generating code, make sure we are at the proper - line number. */ - if (! global_bindings_p () && ! CONTAINS_PLACEHOLDER_P (gnu_operand)) - set_lineno (gnat_node, 1); - if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF) { tree gnu_result = build1 (UNCONSTRAINED_ARRAY_REF, @@ -4554,12 +4541,12 @@ elaborate_expression_1 (Node_Id gnat_expr, /* Now create the variable if we need it. */ if (need_debug || (expr_variable && expr_global)) { - set_lineno (gnat_entity, ! global_bindings_p ()); gnu_decl = create_var_decl (create_concat_name (gnat_entity, IDENTIFIER_POINTER (gnu_name)), NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1, Is_Public (gnat_entity), ! definition, 0, 0); + annotate_decl_with_node (gnu_decl, gnat_entity); add_decl_stmt (gnu_decl, gnat_entity); } @@ -4570,7 +4557,7 @@ elaborate_expression_1 (Node_Id gnat_expr, else if (! expr_variable) return gnu_expr; else - return maybe_variable (gnu_expr, gnat_expr); + return maybe_variable (gnu_expr); } /* Create a record type that contains a field of TYPE with a starting bit @@ -4675,9 +4662,9 @@ make_packable_type (tree type) ! DECL_NONADDRESSABLE_P (old_field)); DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); - SET_DECL_ORIGINAL_FIELD (new_field, - (DECL_ORIGINAL_FIELD (old_field) != 0 - ? DECL_ORIGINAL_FIELD (old_field) : old_field)); + SET_DECL_ORIGINAL_FIELD + (new_field, (DECL_ORIGINAL_FIELD (old_field) != 0 + ? DECL_ORIGINAL_FIELD (old_field) : old_field)); if (TREE_CODE (new_type) == QUAL_UNION_TYPE) DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); @@ -5193,11 +5180,10 @@ gnat_to_gnu_field (Entity_Id gnat_field, gigi_abort (118); /* Now create the decl for the field. */ - set_lineno (gnat_field, 0); gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, packed, gnu_size, gnu_pos, Is_Aliased (gnat_field)); - + annotate_decl_with_node (gnu_field, gnat_field); TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field); if (Ekind (gnat_field) == E_Discriminant) @@ -6201,6 +6187,15 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, int comp_p) gnat_error_point, gnat_entity); } +/* Set the DECL_SOURCE_LOCATION of GNU_DECL to the location of + GNAT_NODE. */ + +static void +annotate_decl_with_node (tree gnu_decl, Node_Id gnat_node) +{ + Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_decl)); +} + /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type with all size expressions that contain F updated by replacing F with R. This is identical to GCC's @@ -6231,8 +6226,8 @@ gnat_substitute_in_type (tree t, tree f, tree r) new = build_range_type (TREE_TYPE (t), low, high); if (TYPE_INDEX_TYPE (t)) - SET_TYPE_INDEX_TYPE (new, - gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r)); + SET_TYPE_INDEX_TYPE + (new, gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r)); return new; } @@ -6351,8 +6346,8 @@ gnat_substitute_in_type (tree t, tree f, tree r) DECL_CONTEXT (new_field) = new; SET_DECL_ORIGINAL_FIELD (new_field, - (DECL_ORIGINAL_FIELD (field) != 0 - ? DECL_ORIGINAL_FIELD (field) : field)); + (DECL_ORIGINAL_FIELD (field) != 0 + ? DECL_ORIGINAL_FIELD (field) : field)); /* If the size of the old field was set at a constant, propagate the size in case the type's size was variable. diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h index b9c1d2c4cb8..ae8b401b766 100644 --- a/gcc/ada/gigi.h +++ b/gcc/ada/gigi.h @@ -36,12 +36,6 @@ extern unsigned int largest_move_alignment; /* Declare all functions and types used by gigi. */ -/* Record the current code position in GNAT_NODE. */ -extern void record_code_position (Node_Id); - -/* Insert the code for GNAT_NODE at the position saved for that node. */ -extern void insert_code_for (Node_Id); - /* Compute the alignment of the largest mode that can be used for copying objects. */ extern void gnat_compute_largest_alignment (void); @@ -50,9 +44,6 @@ extern void gnat_compute_largest_alignment (void); expression that contains the last address on the stack to check. */ extern tree emit_stack_check (tree); -/* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */ -extern tree make_transform_expr (Node_Id); - /* GNU_TYPE is a type. Determine if it should be passed by reference by default. */ extern int default_pass_by_ref (tree); @@ -92,6 +83,12 @@ extern tree gnat_to_gnu_type (Entity_Id); /* Add GNU_STMT to the current BLOCK_STMT node. */ extern void add_stmt (tree); +/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */ +extern void add_stmt_with_node (tree, Node_Id); + +/* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */ +extern void set_block_for_group (tree); + /* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node. Get SLOC from Entity_Id. */ extern void add_decl_stmt (tree, Entity_Id); @@ -111,7 +108,7 @@ extern tree make_dummy_type (Entity_Id); extern tree get_unpadded_type (Entity_Id); /* Called when we need to protect a variable object using a save_expr. */ -extern tree maybe_variable (tree, Node_Id); +extern tree maybe_variable (tree); /* Create a record type that contains a field of TYPE with a starting bit position so that it is aligned to ALIGN bits. */ @@ -147,22 +144,14 @@ extern tree get_entity_name (Entity_Id); SUFFIX. */ extern tree create_concat_name (Entity_Id, const char *); -/* Flag indicating whether file names are discarded in exception messages */ -extern int discard_file_names; - -/* If true, then gigi is being called on an analyzed but unexpanded - tree, and the only purpose of the call is to properly annotate - types with representation information */ +/* If true, then gigi is being called on an analyzed but unexpanded tree, and + the only purpose of the call is to properly annotate types with + representation information. */ extern int type_annotate_only; /* Current file name without path */ extern const char *ref_filename; -/* List of TREE_LIST nodes representing a block stack. TREE_VALUE - of each gives the variable used for the setjmp buffer in the current - block, if any. */ -extern GTY(()) tree gnu_block_stack; - /* This is the main program of the back-end. It sets up all the table structures and then generates code. */ @@ -171,11 +160,6 @@ extern void gigi (Node_Id, int, int, struct Node *, Node_Id *, Node_Id *, struct String_Entry *, Char_Code *, struct List_Header *, Int, char *, Entity_Id, Entity_Id, Entity_Id, Int); -/* This function is the driver of the GNAT to GCC tree transformation process. - GNAT_NODE is the root of some gnat tree. It generates code for that - part of the tree. */ -extern void gnat_to_code (Node_Id); - /* GNAT_NODE is the root of some GNAT tree. Return the root of the GCC tree corresponding to that GNAT tree. Normally, no code is generated; we just return an equivalent tree which is used elsewhere to generate @@ -185,19 +169,23 @@ extern tree gnat_to_gnu (Node_Id); /* GNU_STMT is a statement. We generate code for that statement. */ extern void gnat_expand_stmt (tree); +extern int gnat_gimplify_expr (tree *, tree *, tree *); + +/* Expand the body of GNU_DECL, which is not a nested function. */ +extern void gnat_expand_body (tree); + /* Do the processing for the declaration of a GNAT_ENTITY, a type. If a separate Freeze node exists, delay the bulk of the processing. Otherwise make a GCC type for GNAT_ENTITY and set up the correspondance. */ extern void process_type (Entity_Id); -/* Determine the input_filename and the input_line from the source location - (Sloc) of GNAT_NODE node. Set the global variable input_filename and - input_line. If WRITE_NOTE_P is true, emit a line number note. */ -extern void set_lineno (Node_Id, int); - -/* Likewise, but passed a Sloc. */ -extern void set_lineno_from_sloc (Source_Ptr, int); +/* Convert Sloc into *LOCUS (a location_t). Return true if this Sloc + corresponds to a source code location and false if it doesn't. In the + latter case, we don't update *LOCUS. We also set the Gigi global variable + REF_FILENAME to the reference file name as given by sinput (i.e no + directory). */ +extern bool Sloc_to_locus (Source_Ptr, location_t *); /* Post an error message. MSG is the error message, properly annotated. NODE is the node at which to post the error and the node to use for the @@ -383,10 +371,15 @@ extern int global_bindings_p (void); is in reverse order (it has to be so for back-end compatibility). */ extern tree getdecls (void); -/* Enter and exit a new binding level. We return the BLOCK node, if any - when we exit a binding level. */ +/* Enter and exit a new binding level. */ extern void gnat_pushlevel (void); -extern tree gnat_poplevel (void); +extern void gnat_poplevel (void); + +/* Set the jmpbuf_decl for the current binding level to DECL. */ +extern void set_block_jmpbuf_decl (tree); + +/* Get the setjmp_decl, if any, for the current binding level. */ +extern tree get_block_jmpbuf_decl (void); /* Insert BLOCK at the end of the list of subblocks of the current binding level. This is used when a BIND_EXPR is expanded, @@ -563,8 +556,9 @@ extern tree create_label_decl (tree); extern void begin_subprog_body (tree); /* Finish the definition of the current subprogram and compile it all the way - to assembler language output. */ -extern void end_subprog_body (void); + to assembler language output. BODY is the tree corresponding to + the subprogram. */ +extern void end_subprog_body (tree); /* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE. EXPR is an expression that we can use to locate any PLACEHOLDER_EXPRs. diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index f8fe4de4c19..0cb89058286 100644 --- a/gcc/ada/misc.c +++ b/gcc/ada/misc.c @@ -48,6 +48,8 @@ #include "ggc.h" #include "flags.h" #include "debug.h" +#include "cgraph.h" +#include "tree-inline.h" #include "insn-codes.h" #include "insn-flags.h" #include "insn-config.h" @@ -84,11 +86,11 @@ extern FILE *asm_out_file; move instruction. */ unsigned int largest_move_alignment; -static size_t gnat_tree_size (enum tree_code); static bool gnat_init (void); static void gnat_finish_incomplete_decl (tree); static unsigned int gnat_init_options (unsigned int, const char **); static int gnat_handle_option (size_t, const char *, int); +static bool gnat_post_options (const char **); static HOST_WIDE_INT gnat_get_alias_set (tree); static void gnat_print_decl (FILE *, tree, int); static void gnat_print_type (FILE *, tree, int); @@ -107,14 +109,14 @@ static void gnat_adjust_rli (record_layout_info); #define LANG_HOOKS_NAME "GNU Ada" #undef LANG_HOOKS_IDENTIFIER_SIZE #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) -#undef LANG_HOOKS_TREE_SIZE -#define LANG_HOOKS_TREE_SIZE gnat_tree_size #undef LANG_HOOKS_INIT #define LANG_HOOKS_INIT gnat_init #undef LANG_HOOKS_INIT_OPTIONS #define LANG_HOOKS_INIT_OPTIONS gnat_init_options #undef LANG_HOOKS_HANDLE_OPTION #define LANG_HOOKS_HANDLE_OPTION gnat_handle_option +#undef LANG_HOOKS_POST_OPTIONS +#define LANG_HOOKS_POST_OPTIONS gnat_post_options #undef LANG_HOOKS_PARSE_FILE #define LANG_HOOKS_PARSE_FILE gnat_parse_file #undef LANG_HOOKS_HONOR_READONLY @@ -143,6 +145,13 @@ static void gnat_adjust_rli (record_layout_info); #define LANG_HOOKS_PRINT_TYPE gnat_print_type #undef LANG_HOOKS_DECL_PRINTABLE_NAME #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name +#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION +#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gnat_expand_body +#undef LANG_HOOKS_RTL_EXPAND_STMT +#define LANG_HOOKS_RTL_EXPAND_STMT gnat_expand_stmt +#undef LANG_HOOKS_GIMPLIFY_EXPR +#define LANG_HOOKS_GIMPLIFY_EXPR gnat_gimplify_expr + #undef LANG_HOOKS_TYPE_FOR_MODE #define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode #undef LANG_HOOKS_TYPE_FOR_SIZE @@ -224,10 +233,11 @@ gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED) /* Call the front-end elaboration procedures */ adainit (); - immediate_size_expand = 1; - /* Call the front end */ _ada_gnat1drv (); + + cgraph_finalize_compilation_unit (); + cgraph_optimize (); } /* Decode all the language specific options that cannot be decoded by GCC. @@ -332,6 +342,24 @@ gnat_init_options (unsigned int argc, const char **argv) return CL_Ada; } +/* Post-switch processing. */ + +bool +gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) +{ + flag_inline_trees = 1; + + if (!flag_no_inline) + flag_no_inline = 1; + if (flag_inline_functions) + { + flag_inline_trees = 2; + flag_inline_functions = 0; + } + + return false; +} + /* Here is the function to handle the compiler error processing in GCC. */ static void @@ -359,21 +387,6 @@ internal_error_function (const char *msgid, va_list *ap) Compiler_Abort (fp, -1); } -/* Langhook for tree_size: Determine size of our 'x' and 'c' nodes. */ - -static size_t -gnat_tree_size (enum tree_code code) -{ - switch (code) - { - case GNAT_LOOP_ID: - return sizeof (struct tree_loop_id); - default: - abort (); - } - /* NOTREACHED */ -} - /* Perform all the initialization steps that are language-specific. */ static bool @@ -559,7 +572,7 @@ gnat_printable_name (tree decl, int verbosity) } /* Expands GNAT-specific GCC tree nodes. The only ones we support - here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR. */ + here are and NULL_EXPR. */ static rtx gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode, @@ -567,7 +580,6 @@ gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode, { tree type = TREE_TYPE (exp); tree new; - rtx result; /* If this is a statement, call the expansion routine for statements. */ if (IS_STMT (exp)) @@ -579,48 +591,14 @@ gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode, /* Update EXP to be the new expression to expand. */ switch (TREE_CODE (exp)) { - case TRANSFORM_EXPR: - gnat_to_code (TREE_COMPLEXITY (exp)); - return const0_rtx; - break; - - case NULL_EXPR: - expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0); - - /* We aren't going to be doing anything with this memory, but allocate - it anyway. If it's variable size, make a bogus address. */ - if (! host_integerp (TYPE_SIZE_UNIT (type), 1)) - result = gen_rtx_MEM (BLKmode, virtual_stack_vars_rtx); - else - result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1); - - return result; - +#if 0 case ALLOCATE_EXPR: return allocate_dynamic_stack_space (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype), EXPAND_NORMAL), NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1)); - - case USE_EXPR: - if (target != const0_rtx) - gigi_abort (203); - - /* First write a volatile ASM_INPUT to prevent anything from being - moved. */ - result = gen_rtx_ASM_INPUT (VOIDmode, ""); - MEM_VOLATILE_P (result) = 1; - emit_insn (result); - - result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode, - modifier); - emit_insn (gen_rtx_USE (VOIDmode, result)); - return target; - - case GNAT_NOP_EXPR: - return expand_expr_real (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)), - target, tmode, modifier, alt_rtl); +#endif case UNCONSTRAINED_ARRAY_REF: /* If we are evaluating just for side-effects, just evaluate our @@ -667,18 +645,6 @@ gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED) rli->record_align = record_align; #endif } - -/* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */ - -tree -make_transform_expr (Node_Id gnat_node) -{ - tree gnu_result = build (TRANSFORM_EXPR, void_type_node); - - TREE_SIDE_EFFECTS (gnu_result) = 1; - TREE_COMPLEXITY (gnu_result) = gnat_node; - return gnu_result; -} /* These routines are used in conjunction with GCC exception handling. */ @@ -704,55 +670,6 @@ gnat_eh_type_covers (tree a, tree b) return (a == b || a == integer_zero_node); } -/* Record the current code position in GNAT_NODE. */ - -void -record_code_position (Node_Id gnat_node) -{ - if (global_bindings_p ()) - { - /* Make a dummy entry so multiple things at the same location don't - end up in the same place. */ - add_pending_elaborations (NULL_TREE, NULL_TREE); - save_gnu_tree (gnat_node, get_elaboration_location (), 1); - } - else - /* Always emit another insn in case marking the last insn - addressable needs some fixups and also for above reason. */ - save_gnu_tree (gnat_node, - build (RTL_EXPR, void_type_node, NULL_TREE, - (tree) emit_note (NOTE_INSN_DELETED), NULL_TREE), - 1); -} - -/* Insert the code for GNAT_NODE at the position saved for that node. */ - -void -insert_code_for (Node_Id gnat_node) -{ - if (global_bindings_p ()) - { - push_pending_elaborations (); - gnat_to_code (gnat_node); - Check_Elaboration_Code_Allowed (gnat_node); - insert_elaboration_list (get_gnu_tree (gnat_node)); - pop_pending_elaborations (); - } - else - { - rtx insns; - - do_pending_stack_adjust (); - start_sequence (); - mark_all_temps_used (); - gnat_to_code (gnat_node); - do_pending_stack_adjust (); - insns = get_insns (); - end_sequence (); - emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node))); - } -} - /* Get the alias set corresponding to a type or expression. */ static HOST_WIDE_INT diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 51c8edc0fd4..e7a5f9fc89a 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -31,6 +31,7 @@ #include "tree.h" #include "real.h" #include "flags.h" +#include "toplev.h" #include "rtl.h" #include "expr.h" #include "ggc.h" @@ -38,6 +39,7 @@ #include "except.h" #include "debug.h" #include "output.h" +#include "tree-gimple.h" #include "ada.h" #include "types.h" #include "atree.h" @@ -68,27 +70,30 @@ struct List_Header *List_Headers_Ptr; /* Current filename without path. */ const char *ref_filename; -/* Flag indicating whether file names are discarded in exception messages */ -int discard_file_names; - /* If true, then gigi is being called on an analyzed but unexpanded tree, and the only purpose of the call is to properly annotate types with representation information. */ int type_annotate_only; -/* List of TREE_LIST nodes representing a block stack. TREE_VALUE - of each gives the variable used for the setjmp buffer in the current - block, if any. TREE_PURPOSE gives the bottom condition for a loop, - if this block is for a loop. The latter is only used to save the tree - over GC. */ -tree gnu_block_stack; +/* A structure used to gather together information about a statement group. + We use this to gather related statements, for example the "then" part + of a IF. In the case where it represents a lexical scope, we may also + have a BLOCK node corresponding to it and/or cleanups. */ + +struct stmt_group GTY((chain_next ("%h.previous"))) { + struct stmt_group *previous; /* Previous code group. */ + tree stmt_list; /* List of statements for this code group. */ + tree block; /* BLOCK for this code group, if any. */ + tree cleanups; /* Cleanups for this code group, if any. */ +}; -/* The current BLOCK_STMT node. TREE_CHAIN points to the previous - BLOCK_STMT node. */ -static GTY(()) tree gnu_block_stmt_node; +static GTY(()) struct stmt_group *current_stmt_group; -/* List of unused BLOCK_STMT nodes. */ -static GTY((deletable)) tree gnu_block_stmt_free_list; +/* List of unused struct stmt_group nodes. */ +static GTY((deletable)) struct stmt_group *stmt_group_free_list; + +/* Free list of TREE_LIST nodes used for stacks. */ +static GTY((deletable)) tree gnu_stack_free_list; /* List of TREE_LIST nodes representing a stack of exception pointer variables. TREE_VALUE is the VAR_DECL that stores the address of @@ -96,6 +101,14 @@ static GTY((deletable)) tree gnu_block_stmt_free_list; handler. Not used in the zero-cost case. */ static GTY(()) tree gnu_except_ptr_stack; +/* Variable that stores a list of labels to be used as a goto target instead of + a return in some functions. See processing for N_Subprogram_Body. */ +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; + /* List of TREE_LIST nodes containing pending elaborations lists. used to prevent the elaborations being reclaimed by GC. */ static GTY(()) tree gnu_pending_elaboration_lists; @@ -106,16 +119,19 @@ static enum tree_code gnu_codes[Number_Node_Kinds]; /* Current node being treated, in case gigi_abort called. */ Node_Id error_gnat_node; -/* Variable that stores a list of labels to be used as a goto target instead of - a return in some functions. See processing for N_Subprogram_Body. */ -static GTY(()) tree gnu_return_label_stack; - -static tree tree_transform (Node_Id); -static rtx first_nondeleted_insn (rtx); -static tree start_block_stmt (void); -static tree end_block_stmt (bool); -static tree build_block_stmt (List_Id); -static tree make_expr_stmt_from_rtl (rtx, Node_Id); +static void record_code_position (Node_Id); +static void insert_code_for (Node_Id); +static void start_stmt_group (void); +static void add_cleanup (tree); +static tree end_stmt_group (void); +static void add_stmt_list (List_Id); +static tree build_stmt_group (List_Id, bool); +static void push_stack (tree *, tree, tree); +static void pop_stack (tree *); +static enum gimplify_status gnat_gimplify_stmt (tree *); +static tree gnat_gimplify_type_sizes (tree); +static void gnat_gimplify_one_sizepos (tree *, tree *); +static void gnat_expand_body_1 (tree, bool); static void elaborate_all_entities (Node_Id); static void process_freeze_entity (Node_Id); static void process_inlined_subprograms (Node_Id); @@ -131,6 +147,7 @@ static tree pos_to_constructor (Node_Id, tree, Entity_Id); static tree maybe_implicit_deref (tree); static tree gnat_stabilize_reference_1 (tree, int); static int build_unit_elab (Entity_Id, int, tree); +static void annotate_with_node (tree, Node_Id); /* Constants for +0.5 and -0.5 for float-to-integer rounding. */ static REAL_VALUE_TYPE dconstp5; @@ -182,25 +199,23 @@ gigi (Node_Id gnat_root, TYPE_SIZE_UNIT (void_type_node) = size_zero_node; } - /* See if we should discard file names in exception messages. */ - discard_file_names = Debug_Flag_NN; - if (Nkind (gnat_root) != N_Compilation_Unit) gigi_abort (301); - set_lineno (gnat_root, 0); - /* Initialize ourselves. */ init_gnat_to_gnu (); init_dummy_type (); init_code_table (); gnat_compute_largest_alignment (); - start_block_stmt (); + start_stmt_group (); /* Enable GNAT stack checking method if needed */ if (!Stack_Check_Probes_On_Target) set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check")); + if (Exception_Mechanism == Front_End_ZCX) + abort (); + /* Save the type we made for integer as the type for Standard.Integer. Then make the rest of the standard types. Note that some of these may be subtypes. */ @@ -231,124 +246,20 @@ gigi (Node_Id gnat_root, if (Exception_Mechanism == GCC_ZCX) gnat_init_gcc_eh (); - gnat_to_code (gnat_root); + gnat_to_gnu (gnat_root); } - -/* This function is the driver of the GNAT to GCC tree transformation process. - GNAT_NODE is the root of some gnat tree. It generates code for that - part of the tree. */ - -void -gnat_to_code (Node_Id gnat_node) -{ - tree gnu_root; - - /* Save node number in case error */ - error_gnat_node = gnat_node; - - start_block_stmt (); - gnu_root = tree_transform (gnat_node); - gnat_expand_stmt (end_block_stmt (false)); - - /* If we return a statement, generate code for it. */ - if (IS_STMT (gnu_root)) - { - if (TREE_CODE (gnu_root) != NULL_STMT) - gnat_expand_stmt (gnu_root); - } - /* This should just generate code, not return a value. If it returns - a value, something is wrong. */ - else if (gnu_root != error_mark_node) - gigi_abort (302); -} - -/* GNAT_NODE is the root of some GNAT tree. Return the root of the GCC - tree corresponding to that GNAT tree. Normally, no code is generated. - We just return an equivalent tree which is used elsewhere to generate - code. */ +/* This function is the driver of the GNAT to GCC tree transformation + process. It is the entry point of the tree transformer. GNAT_NODE is the + root of some GNAT tree. Return the root of the corresponding GCC tree. + If this is an expression, return the GCC equivalent of the expression. If + it is a statement, return the statement. In the case when called for a + statement, it may also add statements to the current statement group, in + which case anything it returns is to be interpreted as occuring after + anything `it already added. */ tree gnat_to_gnu (Node_Id gnat_node) -{ - tree gnu_root; - bool made_sequence = false; - - /* We support the use of this on statements now as a transition - to full function-at-a-time processing. So we need to see if anything - we do generates RTL and returns error_mark_node. */ - if (!global_bindings_p ()) - { - do_pending_stack_adjust (); - emit_queue (); - start_sequence (); - emit_note (NOTE_INSN_DELETED); - made_sequence = true; - } - - /* Save node number in case error */ - error_gnat_node = gnat_node; - - start_block_stmt (); - gnu_root = tree_transform (gnat_node); - gnat_expand_stmt (end_block_stmt (false)); - - if (gnu_root == error_mark_node) - { - if (!made_sequence) - { - if (type_annotate_only) - return gnu_root; - else - gigi_abort (303); - } - - do_pending_stack_adjust (); - emit_queue (); - gnu_root = make_expr_stmt_from_rtl (first_nondeleted_insn (get_insns ()), - gnat_node); - end_sequence (); - } - else if (made_sequence) - { - rtx insns; - - do_pending_stack_adjust (); - emit_queue (); - insns = first_nondeleted_insn (get_insns ()); - end_sequence (); - - if (insns) - { - /* If we have a statement, we need to first evaluate any RTL we - made in the process of building it and then the statement. */ - if (IS_STMT (gnu_root)) - { - tree gnu_expr_stmt = make_expr_stmt_from_rtl (insns, gnat_node); - - TREE_CHAIN (gnu_expr_stmt) = gnu_root; - gnu_root = build_nt (BLOCK_STMT, gnu_expr_stmt, NULL_TREE); - TREE_SLOC (gnu_root) = Sloc (gnat_node); - } - else - emit_insn (insns); - } - } - - return gnu_root; -} - -/* This function is the driver of the GNAT to GCC tree transformation process. - It is the entry point of the tree transformer. GNAT_NODE is the root of - some GNAT tree. Return the root of the corresponding GCC tree or - error_mark_node to signal that there is no GCC tree to return. - - The latter is the case if only code generation actions have to be performed - like in the case of if statements, loops, etc. This routine is wrapped - in the above two routines for most purposes. */ - -static tree -tree_transform (Node_Id gnat_node) { tree gnu_result = error_mark_node; /* Default to no value. */ tree gnu_result_type = void_type_node; @@ -357,53 +268,22 @@ tree_transform (Node_Id gnat_node) Node_Id gnat_temp; Entity_Id gnat_temp_type; - /* Set input_file_name and lineno from the Sloc in the GNAT tree. */ - set_lineno (gnat_node, 0); - - if (IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call) - && type_annotate_only) - return error_mark_node; - - /* If this is a Statement and we are at top level, we add the statement - as an elaboration for a null tree. That will cause it to be placed - in the elaboration procedure. */ - if (global_bindings_p () - && ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call) - && Nkind (gnat_node) != N_Null_Statement) - || Nkind (gnat_node) == N_Procedure_Call_Statement - || Nkind (gnat_node) == N_Label - || (Nkind (gnat_node) == N_Handled_Sequence_Of_Statements - && (Present (Exception_Handlers (gnat_node)) - || Present (At_End_Proc (gnat_node)))) - || ((Nkind (gnat_node) == N_Raise_Constraint_Error - || Nkind (gnat_node) == N_Raise_Storage_Error - || Nkind (gnat_node) == N_Raise_Program_Error) - && (Ekind (Etype (gnat_node)) == E_Void)))) - { - add_pending_elaborations (NULL_TREE, make_transform_expr (gnat_node)); + /* Save node number for error message and set location information. */ + error_gnat_node = gnat_node; + Sloc_to_locus (Sloc (gnat_node), &input_location); - return error_mark_node; - } + if (type_annotate_only + && IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)) + return alloc_stmt_list (); /* If this node is a non-static subexpression and we are only - annotating types, make this into a NULL_EXPR for non-VOID types - and error_mark_node for void return types. But allow - N_Identifier since we use it for lots of things, including - getting trees for discriminants. */ - + annotating types, make this into a NULL_EXPR. */ if (type_annotate_only && IN (Nkind (gnat_node), N_Subexpr) && Nkind (gnat_node) != N_Identifier && ! Compile_Time_Known_Value (gnat_node)) - { - gnu_result_type = get_unpadded_type (Etype (gnat_node)); - - if (TREE_CODE (gnu_result_type) == VOID_TYPE) - return error_mark_node; - else - return build1 (NULL_EXPR, gnu_result_type, - build_call_raise (CE_Range_Check_Failed)); - } + return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)), + build_call_raise (CE_Range_Check_Failed)); switch (Nkind (gnat_node)) { @@ -416,17 +296,15 @@ tree_transform (Node_Id gnat_node) case N_Operator_Symbol: case N_Defining_Identifier: - /* If the Etype of this node does not equal the Etype of the - Entity, something is wrong with the entity map, probably in - generic instantiation. However, this does not apply to - types. Since we sometime have strange Ekind's, just do - this test for objects. Also, if the Etype of the Entity is - private, the Etype of the N_Identifier is allowed to be the full - type and also we consider a packed array type to be the same as - the original type. Similarly, a class-wide type is equivalent - to a subtype of itself. Finally, if the types are Itypes, - one may be a copy of the other, which is also legal. */ - + /* If the Etype of this node does not equal the Etype of the Entity, + something is wrong with the entity map, probably in generic + instantiation. However, this does not apply to types. Since we + sometime have strange Ekind's, just do this test for objects. Also, + if the Etype of the Entity is private, the Etype of the N_Identifier + is allowed to be the full type and also we consider a packed array + type to be the same as the original type. Similarly, a class-wide + type is equivalent to a subtype of itself. Finally, if the types are + Itypes, one may be a copy of the other, which is also legal. */ gnat_temp = (Nkind (gnat_node) == N_Defining_Identifier ? gnat_node : Entity (gnat_node)); gnat_temp_type = Etype (gnat_temp); @@ -458,7 +336,6 @@ tree_transform (Node_Id gnat_node) attribute Position, generated for dispatching code (see Make_DT in exp_disp,adb). In that case we need the type itself, not is parent, in particular if it is a derived type */ - if (Is_Private_Type (gnat_temp_type) && Has_Unknown_Discriminants (gnat_temp_type) && Present (Full_View (gnat_temp)) @@ -498,12 +375,13 @@ tree_transform (Node_Id gnat_node) ??? Note that we need not do this if the variable is declared within the handler, only if it is referenced in the handler and declared in an enclosing block, but we have no way of testing that - right now. */ - if (TREE_VALUE (gnu_except_ptr_stack) != 0) - { - gnat_mark_addressable (gnu_result); - flush_addressof (gnu_result); - } + right now. + + ??? Also, for now all we can do is make it volatile. But we only + do this for SJLJ. */ + if (TREE_VALUE (gnu_except_ptr_stack) != 0 + && TREE_CODE (gnu_result) == VAR_DECL) + TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1; /* Some objects (such as parameters passed by reference, globals of variable size, and renamed objects) actually represent the address @@ -741,11 +619,11 @@ tree_transform (Node_Id gnat_node) break; case N_Pragma: - if (type_annotate_only) - break; - - /* Check for (and ignore) unrecognized pragma */ - if (! Is_Pragma_Name (Chars (gnat_node))) + gnu_result = alloc_stmt_list (); + /* Check for (and ignore) unrecognized pragma and do nothing if + we are just annotating types. */ + if (type_annotate_only + || ! Is_Pragma_Name (Chars (gnat_node))) break; switch (Get_Pragma_Id (Chars (gnat_node))) @@ -756,7 +634,6 @@ tree_transform (Node_Id gnat_node) if (global_bindings_p ()) break; - set_lineno (gnat_node, 1); for (gnat_temp = First (Pragma_Argument_Associations (gnat_node)); Present (gnat_temp); gnat_temp = Next (gnat_temp)) @@ -765,9 +642,8 @@ tree_transform (Node_Id gnat_node) if (TREE_CODE (gnu_expr) == UNCONSTRAINED_ARRAY_REF) gnu_expr = TREE_OPERAND (gnu_expr, 0); - gnu_expr = build1 (USE_EXPR, void_type_node, gnu_expr); - TREE_SIDE_EFFECTS (gnu_expr) = 1; - expand_expr_stmt (gnu_expr); + gnu_expr = build1 (USE_STMT, void_type_node, gnu_expr); + add_stmt (gnu_expr); } break; @@ -809,11 +685,13 @@ tree_transform (Node_Id gnat_node) case N_Private_Extension_Declaration: case N_Task_Type_Declaration: process_type (Defining_Entity (gnat_node)); + gnu_result = alloc_stmt_list (); break; case N_Object_Declaration: case N_Exception_Declaration: gnat_temp = Defining_Entity (gnat_node); + gnu_result = alloc_stmt_list (); /* If we are just annotating types and this object has an unconstrained or task type, don't elaborate it. */ @@ -850,7 +728,7 @@ tree_transform (Node_Id gnat_node) add_decl_stmt (gnu_expr, gnat_temp); } else - gnu_expr = maybe_variable (gnu_expr, Expression (gnat_node)); + gnu_expr = maybe_variable (gnu_expr); save_gnu_tree (gnat_node, gnu_expr, 1); } @@ -867,8 +745,8 @@ tree_transform (Node_Id gnat_node) break; case N_Object_Renaming_Declaration: - gnat_temp = Defining_Entity (gnat_node); + gnu_result = alloc_stmt_list (); /* Don't do anything if this renaming is handled by the front end. or if we are just annotating types and this object has a @@ -884,6 +762,7 @@ tree_transform (Node_Id gnat_node) case N_Implicit_Label_Declaration: gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1); + gnu_result = alloc_stmt_list (); break; case N_Exception_Renaming_Declaration: @@ -891,6 +770,7 @@ tree_transform (Node_Id gnat_node) case N_Package_Renaming_Declaration: case N_Subprogram_Renaming_Declaration: /* These are fully handled in the front end. */ + gnu_result = alloc_stmt_list (); break; /*************************************/ @@ -1861,42 +1741,6 @@ tree_transform (Node_Id gnat_node) gnu_result_type, gnu_lhs, gnu_rhs); break; - case N_And_Then: case N_Or_Else: - { - /* Some processing below (e.g. clear_last_expr) requires access to - status fields now maintained in the current function context, so - we'll setup a dummy one if needed. We cannot use global_binding_p, - since it might be true due to force_global and making a dummy - context would kill the current function context. */ - bool make_dummy_context = (cfun == 0); - enum tree_code code = gnu_codes[Nkind (gnat_node)]; - tree gnu_rhs_side; - - if (make_dummy_context) - init_dummy_function_start (); - - /* The elaboration of the RHS may generate code. If so, - we need to make sure it gets executed after the LHS. */ - gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node)); - clear_last_expr (); - - gnu_rhs_side = expand_start_stmt_expr (1 /*has_scope*/); - gnu_rhs = gnat_to_gnu (Right_Opnd (gnat_node)); - expand_end_stmt_expr (gnu_rhs_side); - - if (make_dummy_context) - expand_dummy_function_end (); - - gnu_result_type = get_unpadded_type (Etype (gnat_node)); - - if (first_nondeleted_insn (RTL_EXPR_SEQUENCE (gnu_rhs_side))) - gnu_rhs = build (COMPOUND_EXPR, gnu_result_type, gnu_rhs_side, - gnu_rhs); - - gnu_result = build_binary_op (code, gnu_result_type, gnu_lhs, gnu_rhs); - } - break; - case N_Op_Or: case N_Op_And: case N_Op_Xor: /* These can either be operations on booleans or on modular types. Fall through for boolean types since that's the way GNU_CODES is @@ -1928,6 +1772,7 @@ tree_transform (Node_Id gnat_node) case N_Op_Shift_Left: case N_Op_Shift_Right: case N_Op_Shift_Right_Arithmetic: + case N_And_Then: case N_Or_Else: { enum tree_code code = gnu_codes[Nkind (gnat_node)]; tree gnu_type; @@ -2114,11 +1959,12 @@ tree_transform (Node_Id gnat_node) /***************************/ case N_Label: - gnu_result = build_nt (LABEL_STMT, gnat_to_gnu (Identifier (gnat_node))); + gnu_result = build1 (LABEL_EXPR, void_type_node, + gnat_to_gnu (Identifier (gnat_node))); break; case N_Null_Statement: - gnu_result = build_nt (NULL_STMT); + gnu_result = alloc_stmt_list (); break; case N_Assignment_Statement: @@ -2143,46 +1989,46 @@ tree_transform (Node_Id gnat_node) else gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs); - - gnu_result = build_nt (EXPR_STMT, gnu_result); break; case N_If_Statement: - gnu_result = NULL_TREE; - - /* Make an IF_STMT for each of the "else if" parts. Avoid - non-determinism. */ - if (Present (Elsif_Parts (gnat_node))) - for (gnat_temp = First (Elsif_Parts (gnat_node)); - Present (gnat_temp); gnat_temp = Next (gnat_temp)) - { - gnu_expr = make_node (IF_STMT); - - IF_STMT_COND (gnu_expr) = gnat_to_gnu (Condition (gnat_temp)); - IF_STMT_TRUE (gnu_expr) - = build_block_stmt (Then_Statements (gnat_temp)); - IF_STMT_ELSE (gnu_expr) = IF_STMT_ELSEIF (gnu_expr) = NULL_TREE; - TREE_SLOC (gnu_expr) = Sloc (Condition (gnat_temp)); - TREE_CHAIN (gnu_expr) = gnu_result; - TREE_TYPE (gnu_expr) = void_type_node; - gnu_result = gnu_expr; - } + { + tree *gnu_else_ptr; /* Point to put next "else if" or "else". */ + + /* Make the outer COND_EXPR. Avoid non-determinism. */ + gnu_result = build (COND_EXPR, void_type_node, + gnat_to_gnu (Condition (gnat_node)), + NULL_TREE, NULL_TREE); + COND_EXPR_THEN (gnu_result) + = build_stmt_group (Then_Statements (gnat_node), false); + TREE_SIDE_EFFECTS (gnu_result) = 1; + gnu_else_ptr = &COND_EXPR_ELSE (gnu_result); + + /* Now make a COND_EXPR for each of the "else if" parts. Put each + into the previous "else" part and point to where to put any + outer "else". Also avoid non-determinism. */ + if (Present (Elsif_Parts (gnat_node))) + for (gnat_temp = First (Elsif_Parts (gnat_node)); + Present (gnat_temp); gnat_temp = Next (gnat_temp)) + { + gnu_expr = build (COND_EXPR, void_type_node, + gnat_to_gnu (Condition (gnat_temp)), + NULL_TREE, NULL_TREE); + COND_EXPR_THEN (gnu_expr) + = build_stmt_group (Then_Statements (gnat_temp), false); + TREE_SIDE_EFFECTS (gnu_expr) = 1; + annotate_with_node (gnu_expr, gnat_temp); + *gnu_else_ptr = gnu_expr; + gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr); + } - /* Now make the IF_STMT. Also avoid non-determinism. */ - gnu_expr = make_node (IF_STMT); - IF_STMT_COND (gnu_expr) = gnat_to_gnu (Condition (gnat_node)); - IF_STMT_TRUE (gnu_expr) = build_block_stmt (Then_Statements (gnat_node)); - IF_STMT_ELSEIF (gnu_expr) = nreverse (gnu_result); - IF_STMT_ELSE (gnu_expr) = build_block_stmt (Else_Statements (gnat_node)); - gnu_result = gnu_expr; + *gnu_else_ptr = build_stmt_group (Else_Statements (gnat_node), false); + } break; case N_Case_Statement: { Node_Id gnat_when; - Node_Id gnat_choice; - tree gnu_label; - Node_Id gnat_statement; gnu_expr = gnat_to_gnu (Expression (gnat_node)); gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr); @@ -2204,137 +2050,100 @@ tree_transform (Node_Id gnat_node) (Etype (Expression (gnat_node))))) gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr); - set_lineno (gnat_node, 1); - expand_start_case (1, gnu_expr, TREE_TYPE (gnu_expr), "case"); + /* We build a SWITCH_EXPR that contains the code with interspersed + CASE_LABEL_EXPRs for each label. */ + start_stmt_group (); for (gnat_when = First_Non_Pragma (Alternatives (gnat_node)); Present (gnat_when); gnat_when = Next_Non_Pragma (gnat_when)) { - tree gnu_temp_stmt, gnu_block; + Node_Id gnat_choice; - /* First compile all the different case choices for the current + /* First compile all the different case choices for the current WHEN alternative. */ - for (gnat_choice = First (Discrete_Choices (gnat_when)); Present (gnat_choice); gnat_choice = Next (gnat_choice)) - { - int error_code; - - gnu_label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); + { + tree gnu_low = NULL_TREE, gnu_high = NULL_TREE; - set_lineno (gnat_choice, 1); switch (Nkind (gnat_choice)) { case N_Range: - /* Abort on all errors except range empty, which - means we ignore this alternative. */ - error_code - = pushcase_range (gnat_to_gnu (Low_Bound (gnat_choice)), - gnat_to_gnu (High_Bound (gnat_choice)), - convert, gnu_label, 0); - - if (error_code != 0 && error_code != 4) - gigi_abort (332); + gnu_low = gnat_to_gnu (Low_Bound (gnat_choice)); + gnu_high = gnat_to_gnu (High_Bound (gnat_choice)); break; case N_Subtype_Indication: - error_code - = pushcase_range - (gnat_to_gnu (Low_Bound (Range_Expression - (Constraint (gnat_choice)))), - gnat_to_gnu (High_Bound (Range_Expression - (Constraint (gnat_choice)))), - convert, gnu_label, 0); - - if (error_code != 0 && error_code != 4) - gigi_abort (332); + gnu_low = gnat_to_gnu (Low_Bound + (Range_Expression + (Constraint (gnat_choice)))); + gnu_high = gnat_to_gnu (High_Bound + (Range_Expression + (Constraint (gnat_choice)))); break; case N_Identifier: - case N_Expanded_Name: + case N_Expanded_Name: /* This represents either a subtype range or a static value of some kind; Ekind says which. If a static value, fall through to the next case. */ if (IN (Ekind (Entity (gnat_choice)), Type_Kind)) { - tree type = get_unpadded_type (Entity (gnat_choice)); - - error_code - = pushcase_range (fold (TYPE_MIN_VALUE (type)), - fold (TYPE_MAX_VALUE (type)), - convert, gnu_label, 0); + tree gnu_type + = get_unpadded_type (Entity (gnat_choice)); - if (error_code != 0 && error_code != 4) - gigi_abort (332); + gnu_low = fold (TYPE_MIN_VALUE (gnu_type)); + gnu_high = fold (TYPE_MAX_VALUE (gnu_type)); break; } + /* ... fall through ... */ case N_Character_Literal: case N_Integer_Literal: - if (pushcase (gnat_to_gnu (gnat_choice), convert, - gnu_label, 0)) - gigi_abort (332); + gnu_low = gnat_to_gnu (gnat_choice); break; case N_Others_Choice: - if (pushcase (NULL_TREE, convert, gnu_label, 0)) - gigi_abort (332); break; default: gigi_abort (316); } - } - - /* After compiling the choices attached to the WHEN compile the - body of statements that have to be executed, should the - "WHEN ... =>" be taken. Push a binding level here in case - variables are declared since we want them to be local to this - set of statements instead of the block containing the Case - statement. */ - gnat_pushlevel (); - start_block_stmt (); - - for (gnat_statement = First (Statements (gnat_when)); - Present (gnat_statement); - gnat_statement = Next (gnat_statement)) - add_stmt (gnat_to_gnu (gnat_statement)); - /* Communicate to GCC that we are done with the current WHEN, - i.e. insert a "break" statement. */ - gnu_temp_stmt = build_nt (BREAK_STMT); - TREE_SLOC (gnu_temp_stmt) = Sloc (gnat_when); - add_stmt (gnu_temp_stmt); - - gnu_block = gnat_poplevel (); - gnu_temp_stmt = end_block_stmt (gnu_block != 0); - if (gnu_block) - BLOCK_STMT_BLOCK (gnu_temp_stmt) = gnu_block; + add_stmt_with_node (build (CASE_LABEL_EXPR, void_type_node, + gnu_low, gnu_high, + create_artificial_label ()), + gnat_choice); + } - expand_expr_stmt (gnu_temp_stmt); + /* Push a binding level here in case variables are declared since + we want them to be local to this set of statements instead of + the block containing the Case statement. */ + add_stmt (build_stmt_group (Statements (gnat_when), true)); } - - expand_end_case (gnu_expr); + + gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr, + end_stmt_group (), NULL_TREE); + break; } - break; case N_Loop_Statement: { - /* The loop variable in GCC form, if any. */ + /* ??? It would be nice to use "build" here, but there's no build5. */ + tree gnu_loop_stmt = build_nt (LOOP_STMT, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, NULL_TREE); tree gnu_loop_var = NULL_TREE; - /* PREINCREMENT_EXPR or PREDECREMENT_EXPR. */ - enum tree_code gnu_update = ERROR_MARK; - /* Used if this is a named loop for so EXIT can work. */ - struct nesting *loop_id; - /* Condition to continue loop tested at top of loop. */ - tree gnu_top_condition = integer_one_node; - /* Similar, but tested at bottom of loop. */ - tree gnu_bottom_condition = integer_one_node; - Node_Id gnat_statement; Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node); - Node_Id gnat_top_condition = Empty; - int enclosing_if_p = 0; + tree gnu_cond_expr = NULL_TREE; + + TREE_TYPE (gnu_loop_stmt) = void_type_node; + TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1; + 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); /* Set the condition that under which the loop should continue. For "LOOP .... END LOOP;" the condition is always true. */ @@ -2342,7 +2151,8 @@ tree_transform (Node_Id gnat_node) ; /* The case "WHILE condition LOOP ..... END LOOP;" */ else if (Present (Condition (gnat_iter_scheme))) - gnat_top_condition = Condition (gnat_iter_scheme); + LOOP_STMT_TOP_COND (gnu_loop_stmt) + = gnat_to_gnu (Condition (gnat_iter_scheme)); else { /* We have an iteration scheme. */ @@ -2371,22 +2181,21 @@ tree_transform (Node_Id gnat_node) || TREE_CODE (gnu_limit) != INTEGER_CST || tree_int_cst_equal (gnu_last, gnu_limit)) { - gnu_expr = build_binary_op (LE_EXPR, integer_type_node, - gnu_low, gnu_high); - set_lineno (gnat_loop_spec, 1); - expand_start_cond (gnu_expr, 0); - enclosing_if_p = 1; + gnu_cond_expr + = build (COND_EXPR, void_type_node, + build_binary_op (LE_EXPR, integer_type_node, + gnu_low, gnu_high), + NULL_TREE, alloc_stmt_list ()); + annotate_with_node (gnu_cond_expr, gnat_loop_spec); } /* Open a new nesting level that will surround the loop to declare the loop index variable. */ + start_stmt_group (); gnat_pushlevel (); - expand_start_bindings (0); /* Declare the loop index and set it to its initial value. */ - start_block_stmt (); gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1); - expand_expr_stmt (end_block_stmt (false)); if (DECL_BY_REF_P (gnu_loop_var)) gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var); @@ -2398,132 +2207,81 @@ tree_transform (Node_Id gnat_node) /* Set either the top or bottom exit condition as appropriate depending on whether we know an overflow cannot occur or not. */ - if (enclosing_if_p) - gnu_bottom_condition + if (gnu_cond_expr) + LOOP_STMT_BOT_COND (gnu_loop_stmt) = build_binary_op (NE_EXPR, integer_type_node, gnu_loop_var, gnu_last); else - gnu_top_condition + LOOP_STMT_TOP_COND (gnu_loop_stmt) = build_binary_op (end_code, integer_type_node, gnu_loop_var, gnu_last); - gnu_update = reversep ? PREDECREMENT_EXPR : PREINCREMENT_EXPR; + LOOP_STMT_UPDATE (gnu_loop_stmt) + = build_binary_op (reversep ? PREDECREMENT_EXPR + : PREINCREMENT_EXPR, + TREE_TYPE (gnu_loop_var), + gnu_loop_var, + convert (TREE_TYPE (gnu_loop_var), + integer_one_node)); + annotate_with_node (LOOP_STMT_UPDATE (gnu_loop_stmt), + gnat_iter_scheme); } - set_lineno (gnat_node, 1); - if (gnu_loop_var) - loop_id = expand_start_loop_continue_elsewhere (1); - else - loop_id = expand_start_loop (1); - /* If the loop was named, have the name point to this loop. In this - case, the association is not a ..._DECL node; in fact, it isn't - a GCC tree node at all. Since this name is referenced inside - the loop, do it before we process the statements of the loop. */ + case, the association is not a ..._DECL node, but this LOOP_STMT. */ if (Present (Identifier (gnat_node))) - { - tree gnu_loop_id = make_node (GNAT_LOOP_ID); - - TREE_LOOP_ID (gnu_loop_id) = loop_id; - save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_id, 1); - } - - set_lineno (gnat_node, 1); - - /* We must evaluate the condition after we've entered the - loop so that any expression actions get done in the right - place. */ - if (Present (gnat_top_condition)) - gnu_top_condition = gnat_to_gnu (gnat_top_condition); - - expand_exit_loop_top_cond (0, gnu_top_condition); - - /* Make the loop body into its own block, so any allocated - storage will be released every iteration. This is needed - for stack allocation. */ - - gnat_pushlevel (); - gnu_block_stack - = tree_cons (gnu_bottom_condition, NULL_TREE, gnu_block_stack); - expand_start_bindings (0); + save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_stmt, 1); - for (gnat_statement = First (Statements (gnat_node)); - Present (gnat_statement); - gnat_statement = Next (gnat_statement)) - gnat_to_code (gnat_statement); - - expand_end_bindings (NULL_TREE, block_has_vars (), -1); - gnat_poplevel (); - gnu_block_stack = TREE_CHAIN (gnu_block_stack); - - set_lineno (gnat_node, 1); - expand_exit_loop_if_false (0, gnu_bottom_condition); - - if (gnu_loop_var) - { - expand_loop_continue_here (); - gnu_expr = build_binary_op (gnu_update, TREE_TYPE (gnu_loop_var), - gnu_loop_var, - convert (TREE_TYPE (gnu_loop_var), - integer_one_node)); - set_lineno (gnat_iter_scheme, 1); - expand_expr_stmt (gnu_expr); - } - - set_lineno (gnat_node, 1); - expand_end_loop (); + /* Make the loop body into its own block, so any allocated storage + will be released every iteration. This is needed for stack + allocation. */ + LOOP_STMT_BODY (gnu_loop_stmt) + = build_stmt_group (Statements (gnat_node), true); + /* If we declared a variable, then we are in a statement group for + that declaration. Add the LOOP_STMT to it and make that the + "loop". */ if (gnu_loop_var) { - /* Close the nesting level that sourround the loop that was used to - declare the loop index variable. */ - set_lineno (gnat_node, 1); - expand_end_bindings (NULL_TREE, block_has_vars (), -1); + add_stmt (gnu_loop_stmt); gnat_poplevel (); + gnu_loop_stmt = end_stmt_group (); } - if (enclosing_if_p) + /* If we have an outer COND_EXPR, that's our result and this loop + is its "true" statement. Otherwise, the result is the LOOP_STMT. */ + if (gnu_cond_expr) { - set_lineno (gnat_node, 1); - expand_end_cond (); + COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt; + gnu_result = gnu_cond_expr; } + else + gnu_result = gnu_loop_stmt; + + pop_stack (&gnu_loop_stmt_stack); } break; case N_Block_Statement: + start_stmt_group (); gnat_pushlevel (); - gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); - expand_start_bindings (0); - start_block_stmt (); process_decls (Declarations (gnat_node), Empty, Empty, 1, 1); - gnat_expand_stmt (end_block_stmt (false)); - gnat_to_code (Handled_Statement_Sequence (gnat_node)); - expand_end_bindings (NULL_TREE, block_has_vars (), -1); + add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node))); gnat_poplevel (); - gnu_block_stack = TREE_CHAIN (gnu_block_stack); + gnu_result = end_stmt_group (); + if (Present (Identifier (gnat_node))) mark_out_of_scope (Entity (Identifier (gnat_node))); break; case N_Exit_Statement: - { - /* Which loop to exit, NULL if the current loop. */ - struct nesting *loop_id = 0; - /* The GCC version of the optional GNAT condition node attached to the - exit statement. Exit the loop if this is false. */ - tree gnu_cond = integer_zero_node; - - if (Present (Name (gnat_node))) - loop_id - = TREE_LOOP_ID (get_gnu_tree (Entity (Name (gnat_node)))); - - if (Present (Condition (gnat_node))) - gnu_cond = invert_truthvalue (gnat_truthvalue_conversion - (gnat_to_gnu (Condition (gnat_node)))); - - set_lineno (gnat_node, 1); - expand_exit_loop_if_false (loop_id, gnu_cond); - } + gnu_result + = build (EXIT_STMT, void_type_node, + (Present (Condition (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))); break; case N_Return_Statement: @@ -2547,8 +2305,8 @@ tree_transform (Node_Id gnat_node) if (TREE_VALUE (gnu_return_label_stack) != 0) { - gnu_result = build_nt (GOTO_STMT, - TREE_VALUE (gnu_return_label_stack)); + gnu_result = build1 (GOTO_EXPR, void_type_node, + TREE_VALUE (gnu_return_label_stack)); break; } @@ -2610,12 +2368,18 @@ tree_transform (Node_Id gnat_node) } } - gnu_result = build_nt (RETURN_STMT, gnu_ret_val); + gnu_result = build1 (RETURN_EXPR, void_type_node, + (gnu_ret_val + ? build (MODIFY_EXPR, TREE_TYPE (gnu_ret_val), + DECL_RESULT (current_function_decl), + gnu_ret_val) + : NULL_TREE)); } break; case N_Goto_Statement: - gnu_result = build_nt (GOTO_STMT, gnat_to_gnu (Name (gnat_node))); + gnu_result = build1 (GOTO_EXPR, void_type_node, + gnat_to_gnu (Name (gnat_node))); break; /****************************/ @@ -2631,7 +2395,7 @@ tree_transform (Node_Id gnat_node) if (No (Freeze_Node (Defining_Entity (Specification (gnat_node))))) gnat_to_gnu_entity (Defining_Entity (Specification (gnat_node)), NULL_TREE, 1); - + gnu_result = alloc_stmt_list (); break; case N_Abstract_Subprogram_Declaration: @@ -2646,13 +2410,14 @@ tree_transform (Node_Id gnat_node) && !From_With_Type (Etype (gnat_temp))) gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); + gnu_result = alloc_stmt_list (); break; case N_Defining_Program_Unit_Name: /* For a child unit identifier go up a level to get the specificaton. We get this when we try to find the spec of a child unit package that is the compilation unit being compiled. */ - gnat_to_code (Parent (gnat_node)); + gnu_result = gnat_to_gnu (Parent (gnat_node)); break; case N_Subprogram_Body: @@ -2679,14 +2444,13 @@ tree_transform (Node_Id gnat_node) /* If this is a generic object or if it has been eliminated, ignore it. */ - if (Ekind (gnat_subprog_id) == E_Generic_Procedure || Ekind (gnat_subprog_id) == E_Generic_Function || Is_Eliminated (gnat_subprog_id)) - break; + return alloc_stmt_list (); - /* If debug information is suppressed for the subprogram, - turn debug mode off for the duration of processing. */ + /* If debug information is suppressed for the subprogram, turn debug + mode off for the duration of processing. */ if (!Needs_Debug_Info (gnat_subprog_id)) { write_symbols = NO_DEBUG; @@ -2695,11 +2459,11 @@ tree_transform (Node_Id gnat_node) /* If this subprogram acts as its own spec, define it. Otherwise, just get the already-elaborated tree node. However, if this - subprogram had its elaboration deferred, we will already have - made a tree node for it. So treat it as not being defined in - that case. Such a subprogram cannot have an address clause or - a freeze node, so this test is safe, though it does disable - some otherwise-useful error checking. */ + subprogram had its elaboration deferred, we will already have made + a tree node for it. So treat it as not being defined in that + case. Such a subprogram cannot have an address clause or a freeze + node, so this test is safe, though it does disable some + otherwise-useful error checking. */ gnu_subprog_decl = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, Acts_As_Spec (gnat_node) @@ -2707,51 +2471,43 @@ tree_transform (Node_Id gnat_node) gnu_subprog_type = TREE_TYPE (gnu_subprog_decl); + /* We handle pending sizes via the elaboration of types, so we don't + need to save them. This causes them to be marked as part of the + outer function and then discarded. */ + get_pending_sizes (); + /* ??? Temporarily do this to avoid GC throwing away outer stuff. */ ggc_push_context (); /* Set the line number in the decl to correspond to that of the body so that the line number notes are written correctly. */ - set_lineno (gnat_node, 0); - DECL_SOURCE_LOCATION (gnu_subprog_decl) = input_location; + Sloc_to_locus (Sloc (gnat_node), + &DECL_SOURCE_LOCATION (gnu_subprog_decl)); - begin_subprog_body (gnu_subprog_decl); - - /* There used to be a second call to set_lineno here, with - write_note_p set, but begin_subprog_body actually already emits the - note we want (via init_function_start). - - Emitting a second note here was necessary for -ftest-coverage with - GCC 2.8.1, as the first one was skipped by branch_prob. This is no - longer the case with GCC 3.x, so emitting a second note here would - result in having the first line of the subprogram counted twice by - gcov. */ + current_function_decl = gnu_subprog_decl; + announce_function (gnu_subprog_decl); + /* Enter a new binding level and show that all the parameters belong to + this function. */ gnat_pushlevel (); - gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); - expand_start_bindings (0); - start_block_stmt (); - + for (gnu_expr = DECL_ARGUMENTS (gnu_subprog_decl); gnu_expr; + gnu_expr = TREE_CHAIN (gnu_expr)) + DECL_CONTEXT (gnu_expr) = gnu_subprog_decl; + + make_decl_rtl (gnu_subprog_decl, NULL); gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); - /* If there are OUT parameters, we need to ensure that the - return statement properly copies them out. We do this by - making a new block and converting any inner return into a goto - to a label at the end of the block. */ + /* If there are OUT parameters, we need to ensure that the return + statement properly copies them out. We do this by making a new + block and converting any inner return into a goto to a label at + the end of the block. */ + push_stack (&gnu_return_label_stack, NULL_TREE, + gnu_cico_list ? create_artificial_label () : NULL_TREE); - if (gnu_cico_list != 0) - { - gnu_return_label_stack - = tree_cons (NULL_TREE, - build_decl (LABEL_DECL, NULL_TREE, NULL_TREE), - gnu_return_label_stack); - gnat_pushlevel (); - expand_start_bindings (0); - } - else - gnu_return_label_stack - = tree_cons (NULL_TREE, NULL_TREE, gnu_return_label_stack); + /* Get a tree corresponding to the code for the subprogram. */ + start_stmt_group (); + gnat_pushlevel (); /* See if there are any parameters for which we don't yet have GCC entities. These must be for OUT parameters for which we @@ -2759,7 +2515,6 @@ tree_transform (Node_Id gnat_node) TYPE_CI_CO_LIST, which must contain the empty entry as well. We can match up the entries because TYPE_CI_CO_LIST is in the order of the parameters. */ - for (gnat_param = First_Formal (gnat_subprog_id); Present (gnat_param); gnat_param = Next_Formal_With_Extras (gnat_param)) @@ -2777,47 +2532,55 @@ tree_transform (Node_Id gnat_node) gnat_to_gnu_entity (gnat_param, NULL_TREE, 1)); } - gnat_expand_stmt (end_block_stmt (false)); - start_block_stmt (); process_decls (Declarations (gnat_node), Empty, Empty, 1, 1); - gnat_expand_stmt (end_block_stmt (false)); /* Generate the code of the subprogram itself. A return statement will be present and any OUT parameters will be handled there. */ - gnat_to_code (Handled_Statement_Sequence (gnat_node)); - - expand_end_bindings (NULL_TREE, block_has_vars (), -1); + add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node))); gnat_poplevel (); - gnu_block_stack = TREE_CHAIN (gnu_block_stack); + gnu_result = end_stmt_group (); + /* If we made a special return label, we need to make a block that + contains the definition of that label and the copying to the + return value. That block first contains the function, then + the label and copy statement. */ if (TREE_VALUE (gnu_return_label_stack) != 0) { tree gnu_retval; - expand_end_bindings (NULL_TREE, block_has_vars (), -1); - gnat_poplevel (); - expand_label (TREE_VALUE (gnu_return_label_stack)); + start_stmt_group (); + gnat_pushlevel (); + add_stmt (gnu_result); + add_stmt (build1 (LABEL_EXPR, void_type_node, + TREE_VALUE (gnu_return_label_stack))); gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); - set_lineno (gnat_node, 1); 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 + = gnat_build_constructor (TREE_TYPE (gnu_subprog_type), + gnu_cico_list); if (DECL_P (gnu_retval) && DECL_BY_REF_P (gnu_retval)) gnu_retval = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval); - expand_return - (build_binary_op (MODIFY_EXPR, NULL_TREE, - DECL_RESULT (current_function_decl), - gnu_retval)); - + add_stmt_with_node + (build1 (RETURN_EXPR, void_type_node, + build (MODIFY_EXPR, TREE_TYPE (gnu_retval), + DECL_RESULT (current_function_decl), + gnu_retval)), + gnat_node); + gnat_poplevel (); + gnu_result = end_stmt_group (); } - gnu_return_label_stack = TREE_CHAIN (gnu_return_label_stack); + pop_stack (&gnu_return_label_stack); + if (!type_annotate_only) + add_decl_stmt (current_function_decl, gnat_node); + + end_subprog_body (gnu_result); /* Disconnect the trees for parameters that we made variables for from the GNAT entities since these will become unusable after @@ -2828,11 +2591,11 @@ tree_transform (Node_Id gnat_node) if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL) save_gnu_tree (gnat_param, NULL_TREE, 0); - end_subprog_body (); mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node))); write_symbols = save_write_symbols; debug_hooks = save_debug_hooks; ggc_pop_context (); + gnu_result = alloc_stmt_list (); } break; @@ -2878,7 +2641,7 @@ tree_transform (Node_Id gnat_node) for (gnat_actual = First_Actual (gnat_node); Present (gnat_actual); gnat_actual = Next_Actual (gnat_actual)) - expand_expr_stmt (gnat_to_gnu (gnat_actual)); + add_stmt (gnat_to_gnu (gnat_actual)); if (Nkind (gnat_node) == N_Function_Call) { @@ -2888,9 +2651,7 @@ tree_transform (Node_Id gnat_node) build_call_raise (PE_Stubbed_Subprogram_Called)); } else - gnu_result - = build_nt (EXPR_STMT, - build_call_raise (PE_Stubbed_Subprogram_Called)); + gnu_result = build_call_raise (PE_Stubbed_Subprogram_Called); break; } @@ -2982,15 +2743,10 @@ tree_transform (Node_Id gnat_node) } /* Set up to move the copy back to the original. */ - gnu_temp - = build_nt (EXPR_STMT, - build (MODIFY_EXPR, TREE_TYPE (gnu_copy), - gnu_copy, gnu_actual)); - - TREE_TYPE (gnu_temp) = void_type_node; - TREE_SLOC (gnu_temp) = Sloc (gnat_actual); - TREE_CHAIN (gnu_temp) = gnu_after_list; - gnu_after_list = gnu_temp; + gnu_temp = build (MODIFY_EXPR, TREE_TYPE (gnu_copy), + gnu_copy, gnu_actual); + annotate_with_node (gnu_temp, gnat_actual); + append_to_statement_list (gnu_temp, &gnu_after_list); } } @@ -3286,29 +3042,22 @@ tree_transform (Node_Id gnat_node) gnu_result); } - gnu_result - = build_nt (EXPR_STMT, - build_binary_op (MODIFY_EXPR, NULL_TREE, - gnu_actual, gnu_result)); - TREE_TYPE (gnu_result) = void_type_node; - TREE_SLOC (gnu_result) = Sloc (gnat_actual); - TREE_CHAIN (gnu_result) = gnu_before_list; - gnu_before_list = gnu_result; + gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE, + gnu_actual, gnu_result); + annotate_with_node (gnu_result, gnat_actual); + append_to_statement_list (gnu_result, &gnu_before_list); scalar_return_list = TREE_CHAIN (scalar_return_list); gnu_name_list = TREE_CHAIN (gnu_name_list); } } else { - gnu_before_list = build_nt (EXPR_STMT, gnu_subprog_call); - TREE_TYPE (gnu_before_list) = void_type_node; - TREE_SLOC (gnu_before_list) = Sloc (gnat_node); + annotate_with_node (gnu_subprog_call, gnat_node); + append_to_statement_list (gnu_subprog_call, &gnu_before_list); } - gnu_result = chainon (nreverse (gnu_before_list), - nreverse (gnu_after_list)); - if (TREE_CHAIN (gnu_result)) - gnu_result = build_nt (BLOCK_STMT, gnu_result, NULL_TREE); + append_to_statement_list (gnu_after_list, &gnu_before_list); + gnu_result = gnu_before_list; } break; @@ -3317,33 +3066,33 @@ tree_transform (Node_Id gnat_node) /*************************/ case N_Package_Declaration: - gnat_to_code (Specification (gnat_node)); + gnu_result = gnat_to_gnu (Specification (gnat_node)); break; case N_Package_Specification: - start_block_stmt (); + start_stmt_group (); process_decls (Visible_Declarations (gnat_node), Private_Declarations (gnat_node), Empty, 1, 1); - gnat_expand_stmt (end_block_stmt (false)); + gnu_result = end_stmt_group (); break; case N_Package_Body: /* If this is the body of a generic package - do nothing */ if (Ekind (Corresponding_Spec (gnat_node)) == E_Generic_Package) - break; + { + gnu_result = alloc_stmt_list (); + break; + } - start_block_stmt (); + start_stmt_group (); process_decls (Declarations (gnat_node), Empty, Empty, 1, 1); - gnat_expand_stmt (end_block_stmt (false)); if (Present (Handled_Statement_Sequence (gnat_node))) - { - gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); - gnat_to_code (Handled_Statement_Sequence (gnat_node)); - gnu_block_stack = TREE_CHAIN (gnu_block_stack); - } + add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node))); + + gnu_result = end_stmt_group (); break; /*********************************/ @@ -3353,6 +3102,7 @@ tree_transform (Node_Id gnat_node) case N_Use_Package_Clause: case N_Use_Type_Clause: /* Nothing to do here - but these may appear in list of declarations */ + gnu_result = alloc_stmt_list (); break; /***********************/ @@ -3360,10 +3110,12 @@ tree_transform (Node_Id gnat_node) /***********************/ case N_Protected_Type_Declaration: + gnu_result = alloc_stmt_list (); break; case N_Single_Task_Declaration: gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1); + gnu_result = alloc_stmt_list (); break; /***********************************************************/ @@ -3372,11 +3124,13 @@ tree_transform (Node_Id gnat_node) case N_Compilation_Unit: + start_stmt_group (); + /* For a body, first process the spec if there is one. */ if (Nkind (Unit (gnat_node)) == N_Package_Body || (Nkind (Unit (gnat_node)) == N_Subprogram_Body && ! Acts_As_Spec (gnat_node))) - gnat_to_code (Library_Unit (gnat_node)); + add_stmt (gnat_to_gnu (Library_Unit (gnat_node))); process_inlined_subprograms (gnat_node); @@ -3387,39 +3141,20 @@ tree_transform (Node_Id gnat_node) if (Nkind (Unit (gnat_node)) == N_Subprogram_Declaration || Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration || Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration) - break; - }; + { + gnu_result = end_stmt_group (); + break; + } + } - start_block_stmt(); process_decls (Declarations (Aux_Decls_Node (gnat_node)), Empty, Empty, 1, 1); - gnat_expand_stmt (end_block_stmt (false)); - - gnat_to_code (Unit (gnat_node)); - - /* Process any pragmas following the unit. */ - if (Present (Pragmas_After (Aux_Decls_Node (gnat_node)))) - for (gnat_temp = First (Pragmas_After (Aux_Decls_Node (gnat_node))); - gnat_temp; gnat_temp = Next (gnat_temp)) - gnat_to_code (gnat_temp); - - /* Put all the Actions into the elaboration routine if we already had - elaborations. This will happen anyway if they are statements, but we - want to force declarations there too due to order-of-elaboration - issues. Most should have Is_Statically_Allocated set. If we - have had no elaborations, we have no order-of-elaboration issue and - don't want to create elaborations here. */ - if (Is_Non_Empty_List (Actions (Aux_Decls_Node (gnat_node)))) - for (gnat_temp = First (Actions (Aux_Decls_Node (gnat_node))); - Present (gnat_temp); gnat_temp = Next (gnat_temp)) - { - if (pending_elaborations_p ()) - add_pending_elaborations (NULL_TREE, - make_transform_expr (gnat_temp)); - else - gnat_to_code (gnat_temp); - } + add_stmt (gnat_to_gnu (Unit (gnat_node))); + /* Process any pragmas and actions following the unit. */ + add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node))); + add_stmt_list (Actions (Aux_Decls_Node (gnat_node))); + /* Generate elaboration code for this unit, if necessary, and say whether we did or not. */ Set_Has_No_Elaboration_Code @@ -3430,6 +3165,7 @@ tree_transform (Node_Id gnat_node) || Nkind (Unit (gnat_node)) == N_Subprogram_Body, get_pending_elaborations ())); + gnu_result = end_stmt_group (); break; case N_Subprogram_Body_Stub: @@ -3437,11 +3173,11 @@ tree_transform (Node_Id gnat_node) case N_Protected_Body_Stub: case N_Task_Body_Stub: /* Simply process whatever unit is being inserted. */ - gnat_to_code (Unit (Library_Unit (gnat_node))); + gnu_result = gnat_to_gnu (Unit (Library_Unit (gnat_node))); break; case N_Subunit: - gnat_to_code (Proper_Body (gnat_node)); + gnu_result = gnat_to_gnu (Proper_Body (gnat_node)); break; /***************************/ @@ -3474,211 +3210,193 @@ tree_transform (Node_Id gnat_node) generalize the condition to make it not ZCX specific. */ /* If there is an At_End procedure attached to this node, and the eh - mechanism is GNAT oriented (SJLJ or ZCX with front end tables), we - must have at least a corresponding At_End handler, unless the - No_Exception_Handlers restriction is set. */ + mechanism is SJLJ, we must have at least a corresponding At_End + handler, unless the No_Exception_Handlers restriction is set. */ if (! type_annotate_only - && Exception_Mechanism != GCC_ZCX + && Exception_Mechanism == Setjmp_Longjmp && Present (At_End_Proc (gnat_node)) && ! Present (Exception_Handlers (gnat_node)) && ! No_Exception_Handlers_Set()) gigi_abort (335); { - /* Need a binding level that we can exit for this sequence if there is - at least one exception handler for this block (since each handler - needs an identified exit point) or there is an At_End procedure - attached to this node (in order to have an attachment point for a - GCC cleanup). */ - bool exitable_binding_for_block - = (! type_annotate_only - && (Present (Exception_Handlers (gnat_node)) - || Present (At_End_Proc (gnat_node)))); - - /* Make a binding level that we can exit if we need one. */ - if (exitable_binding_for_block) + tree gnu_jmpsave_decl = NULL_TREE; + tree gnu_jmpbuf_decl = NULL_TREE; + /* If just annotating, ignore all EH and cleanups. */ + bool gcc_zcx + = (!type_annotate_only && Present (Exception_Handlers (gnat_node)) + && Exception_Mechanism == GCC_ZCX); + bool setjmp_longjmp + = (!type_annotate_only && Present (Exception_Handlers (gnat_node)) + && Exception_Mechanism == Setjmp_Longjmp); + bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node)); + bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp); + /* The statement(s) for the block itself. */ + tree gnu_inner_block; + + /* If there are any exceptions or cleanup processing involved, we need + an outer statement group (for Setjmp_Longjmp) and binding level. */ + if (binding_for_block) { + start_stmt_group (); gnat_pushlevel (); - expand_start_bindings (1); } - /* If we are to call a function when exiting this block, expand a GCC - cleanup to take care. We have made a binding level for this cleanup - above. */ - if (Present (At_End_Proc (gnat_node))) + /* If we are to call a function when exiting this block add a cleanup + to the binding level we made above. */ + if (at_end) + add_cleanup (build_call_0_expr + (gnat_to_gnu (At_End_Proc (gnat_node)))); + + /* If using setjmp_longjmp, make the variables for the setjmp + buffer and save area for address of previous buffer. Do this + first since we need to have the setjmp buf known for any decls + in this block. */ + if (setjmp_longjmp) { - tree gnu_cleanup_call - = build_call_0_expr (gnat_to_gnu (At_End_Proc (gnat_node))); - - tree gnu_cleanup_decl - = create_var_decl (get_identifier ("CLEANUP"), NULL_TREE, - integer_type_node, NULL_TREE, 0, 0, 0, 0, - 0); - - start_block_stmt (); - add_decl_stmt (gnu_cleanup_decl, gnat_node); - gnat_expand_stmt (end_block_stmt (false)); - expand_decl_cleanup (gnu_cleanup_decl, gnu_cleanup_call); - } - - /* Now we generate the code for this block, with a different layout - for GNAT SJLJ and for GCC or front end ZCX. The handlers come first - in the GNAT SJLJ case, while they come after the handled sequence - in the other cases. */ - - /* First deal with possible handlers for the GNAT SJLJ scheme. */ - if (! type_annotate_only - && Exception_Mechanism == Setjmp_Longjmp - && Present (Exception_Handlers (gnat_node))) - { - /* We already have a fresh binding level at hand. Declare a - variable to save the old __gnat_jmpbuf value and a variable for - our jmpbuf. Call setjmp and handle each of the possible - exceptions if it returns one. */ - - tree gnu_jmpsave_decl + gnu_jmpsave_decl = create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE, jmpbuf_ptr_type, build_call_0_expr (get_jmpbuf_decl), 0, 0, 0, 0, 0); - - tree gnu_jmpbuf_decl + gnu_jmpbuf_decl = create_var_decl (get_identifier ("JMP_BUF"), NULL_TREE, jmpbuf_type, - NULL_TREE, 0, 0, 0, 0, - 0); + NULL_TREE, 0, 0, 0, 0, 0); - start_block_stmt (); add_decl_stmt (gnu_jmpsave_decl, gnat_node); add_decl_stmt (gnu_jmpbuf_decl, gnat_node); - gnat_expand_stmt (end_block_stmt (false)); - - TREE_VALUE (gnu_block_stack) = gnu_jmpbuf_decl; + set_block_jmpbuf_decl (gnu_jmpbuf_decl); /* When we exit this block, restore the saved value. */ - expand_decl_cleanup (gnu_jmpsave_decl, - build_call_1_expr (set_jmpbuf_decl, - gnu_jmpsave_decl)); - - /* Call setjmp and handle exceptions if it returns one. */ - set_lineno (gnat_node, 1); - expand_start_cond - (build_call_1_expr (setjmp_decl, - build_unary_op (ADDR_EXPR, NULL_TREE, - gnu_jmpbuf_decl)), - 0); + add_cleanup (build_call_1_expr (set_jmpbuf_decl, + gnu_jmpsave_decl)); + } + + /* Now build the tree for the declarations and statements inside this + block. If this is SJLJ, set our jmp_buf as the current buffer. */ + start_stmt_group (); + + if (setjmp_longjmp) + add_stmt (build_call_1_expr + (set_jmpbuf_decl, + build_unary_op (ADDR_EXPR, NULL_TREE, gnu_jmpbuf_decl))); - /* Restore our incoming longjmp value before we do anything. */ - expand_expr_stmt - (build_call_1_expr (set_jmpbuf_decl, gnu_jmpsave_decl)); + + if (Present (First_Real_Statement (gnat_node))) + process_decls (Statements (gnat_node), Empty, + First_Real_Statement (gnat_node), 1, 1); + + /* Generate code for each statement in the block. */ + for (gnat_temp = (Present (First_Real_Statement (gnat_node)) + ? First_Real_Statement (gnat_node) + : First (Statements (gnat_node))); + Present (gnat_temp); gnat_temp = Next (gnat_temp)) + add_stmt (gnat_to_gnu (gnat_temp)); + gnu_inner_block = end_stmt_group (); + + /* Now generate code for the two exception models, if either is + relevant for this block. */ + if (setjmp_longjmp) + { + tree *gnu_else_ptr = 0; + tree gnu_handler; /* Make a binding level for the exception handling declarations - and code. Don't assign it an exit label, since this is the - outer block we want to exit at the end of each handler. */ + and code and set up gnu_except_ptr_stack for the handlers + to use. */ + start_stmt_group (); gnat_pushlevel (); - expand_start_bindings (0); - gnu_except_ptr_stack - = tree_cons (NULL_TREE, - create_var_decl - (get_identifier ("EXCEPT_PTR"), NULL_TREE, - build_pointer_type (except_type_node), - build_call_0_expr (get_excptr_decl), - 0, 0, 0, 0, 0), - gnu_except_ptr_stack); - start_block_stmt (); + push_stack (&gnu_except_ptr_stack, NULL_TREE, + create_var_decl (get_identifier ("EXCEPT_PTR"), + NULL_TREE, + build_pointer_type (except_type_node), + build_call_0_expr (get_excptr_decl), + 0, 0, 0, 0, 0)); add_decl_stmt (TREE_VALUE (gnu_except_ptr_stack), gnat_node); - gnat_expand_stmt (end_block_stmt (false)); /* Generate code for each handler. The N_Exception_Handler case - below does the real work. We ignore the dummy exception handler - for the identifier case, as this is used only by the front - end. */ + below does the real work and returns a COND_EXPR for each + handler, which we chain together here. */ for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node)); Present (gnat_temp); gnat_temp = Next_Non_Pragma (gnat_temp)) - gnat_to_code (gnat_temp); - - /* If none of the exception handlers did anything, re-raise - but do not defer abortion. */ - set_lineno (gnat_node, 1); - expand_expr_stmt - (build_call_1_expr (raise_nodefer_decl, - TREE_VALUE (gnu_except_ptr_stack))); + { + gnu_expr = gnat_to_gnu (gnat_temp); + + /* If this is the first one, set it as the outer one. + Otherwise, point the "else" part of the previous handler + to us. Then point to our "else" part. */ + if (!gnu_else_ptr) + add_stmt (gnu_expr); + else + *gnu_else_ptr = gnu_expr; - gnu_except_ptr_stack = TREE_CHAIN (gnu_except_ptr_stack); + gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr); + } - /* End the binding level dedicated to the exception handlers. */ - expand_end_bindings (NULL_TREE, block_has_vars (), -1); - gnat_poplevel (); + /* If none of the exception handlers did anything, re-raise but + do not defer abortion. */ + gnu_expr = build_call_1_expr (raise_nodefer_decl, + TREE_VALUE (gnu_except_ptr_stack)); + annotate_with_node (gnu_expr, gnat_node); - /* End the "if" on setjmp. Note that we have arranged things so - control never returns here. */ - expand_end_cond (); + if (gnu_else_ptr) + *gnu_else_ptr = gnu_expr; + else + add_stmt (gnu_expr); - /* This is now immediately before the body proper. Set our jmp_buf - as the current buffer. */ - expand_expr_stmt - (build_call_1_expr (set_jmpbuf_decl, + /* End the binding level dedicated to the exception handlers + and get the whole statement group. */ + pop_stack (&gnu_except_ptr_stack); + gnat_poplevel (); + gnu_handler = end_stmt_group (); + + /* If the setjmp returns 1, we restore our incoming longjmp value + and then check the handlers. */ + start_stmt_group (); + add_stmt_with_node (build_call_1_expr (set_jmpbuf_decl, + gnu_jmpsave_decl), + gnat_node); + add_stmt (gnu_handler); + gnu_handler = end_stmt_group (); + + /* This block is now "if (setjmp) ... else ". */ + gnu_result = build (COND_EXPR, void_type_node, + (build_call_1_expr + (setjmp_decl, build_unary_op (ADDR_EXPR, NULL_TREE, - gnu_jmpbuf_decl))); + gnu_jmpbuf_decl))), + gnu_handler, gnu_inner_block); } - - /* Now comes the processing for the sequence body. */ - - /* If we use the back-end eh support, tell the back-end we are - starting a new exception region. */ - if (! type_annotate_only - && Exception_Mechanism == GCC_ZCX - && Present (Exception_Handlers (gnat_node))) - expand_eh_region_start (); - - /* Generate code and declarations for the prefix of this block, - if any. */ - start_block_stmt (); - if (Present (First_Real_Statement (gnat_node))) - process_decls (Statements (gnat_node), Empty, - First_Real_Statement (gnat_node), 1, 1); - gnat_expand_stmt (end_block_stmt (false)); - - /* Generate code for each statement in the block. */ - for (gnat_temp = (Present (First_Real_Statement (gnat_node)) - ? First_Real_Statement (gnat_node) - : First (Statements (gnat_node))); - Present (gnat_temp); - gnat_temp = Next (gnat_temp)) - gnat_to_code (gnat_temp); - - /* Exit the binding level we made, if any. */ - if (exitable_binding_for_block) - expand_exit_something (); - - /* Compile the handlers for front end ZCX or back-end supported - exceptions. */ - if (! type_annotate_only - && Exception_Mechanism != Setjmp_Longjmp - && Present (Exception_Handlers (gnat_node))) + else if (gcc_zcx) { - if (Exception_Mechanism == GCC_ZCX) - expand_start_all_catch (); + tree gnu_handlers; + /* First make a block containing the handlers. */ + start_stmt_group (); for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node)); Present (gnat_temp); gnat_temp = Next_Non_Pragma (gnat_temp)) - gnat_to_code (gnat_temp); + add_stmt (gnat_to_gnu (gnat_temp)); + gnu_handlers = end_stmt_group (); - if (Exception_Mechanism == GCC_ZCX) - expand_end_all_catch (); + /* Now make the TRY_CATCH_EXPR for the block. */ + gnu_result = build (TRY_CATCH_EXPR, void_type_node, + gnu_inner_block, gnu_handlers); } + else + gnu_result = gnu_inner_block; - /* Close the binding level we made, if any. */ - if (exitable_binding_for_block) + /* Now close our outer block, if we had to make one. */ + if (binding_for_block) { - expand_end_bindings (NULL_TREE, block_has_vars (), -1); + add_stmt (gnu_result); gnat_poplevel (); + gnu_result = end_stmt_group (); } } - break; case N_Exception_Handler: @@ -3690,6 +3408,7 @@ tree_transform (Node_Id gnat_node) Handled_By_Others is nonzero unless the All_Others flag is set. For "Non-ada", accept an exception if "Lang" is 'V'. */ tree gnu_choice = integer_zero_node; + tree gnu_body = build_stmt_group (Statements (gnat_node), false); for (gnat_temp = First (Exception_Choices (gnat_node)); gnat_temp; gnat_temp = Next (gnat_temp)) @@ -3718,14 +3437,8 @@ tree_transform (Node_Id gnat_node) else if (Nkind (gnat_temp) == N_Identifier || Nkind (gnat_temp) == N_Expanded_Name) { - Entity_Id gnat_ex_id = Entity (gnat_temp); - - /* Exception may be a renaming. Recover original exception - which is the one elaborated and registered. */ - if (Present (Renamed_Object (gnat_ex_id))) - gnat_ex_id = Renamed_Object (gnat_ex_id); - - gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0); + gnu_expr + = gnat_to_gnu_entity (Entity (gnat_temp), NULL_TREE, 0); this_choice = build_binary_op @@ -3764,13 +3477,12 @@ tree_transform (Node_Id gnat_node) gnu_choice, this_choice); } - set_lineno (gnat_node, 1); - - expand_start_cond (gnu_choice, 0); + gnu_result = build (COND_EXPR, void_type_node, gnu_choice, gnu_body, + NULL_TREE); } /* Tell the back end that we start an exception handler if necessary. */ - if (Exception_Mechanism == GCC_ZCX) + else if (Exception_Mechanism == GCC_ZCX) { /* We build a TREE_LIST of nodes representing what exception types this handler is able to catch, with special cases @@ -3791,8 +3503,10 @@ tree_transform (Node_Id gnat_node) such clauses is rendered in some way. lang_eh_type_covers is doing the trick currently. */ - tree gnu_expr, gnu_etype; tree gnu_etypes_list = NULL_TREE; + tree gnu_etype; + tree gnu_current_exc_ptr; + tree gnu_incoming_exc_ptr; for (gnat_temp = First (Exception_Choices (gnat_node)); gnat_temp; gnat_temp = Next (gnat_temp)) @@ -3832,70 +3546,50 @@ tree_transform (Node_Id gnat_node) caught beyond a catch all from GCC's point of view. */ gnu_etypes_list = tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list); - } - expand_start_catch (gnu_etypes_list); - + start_stmt_group (); gnat_pushlevel (); - expand_start_bindings (0); - - { - /* Expand a call to the begin_handler hook at the beginning of the - handler, and arrange for a call to the end_handler hook to - occur on every possible exit path. - - The hooks expect a pointer to the low level occurrence. This - is required for our stack management scheme because a raise - inside the handler pushes a new occurrence on top of the - stack, which means that this top does not necessarily match - the occurrence this handler was dealing with. - - The EXC_PTR_EXPR object references the exception occurrence - beeing propagated. Upon handler entry, this is the exception - for which the handler is triggered. This might not be the case - upon handler exit, however, as we might have a new occurrence - propagated by the handler's body, and the end_handler hook - called as a cleanup in this context. - - We use a local variable to retrieve the incoming value at - handler entry time, and reuse it to feed the end_handler - hook's argument at exit time. */ - tree gnu_current_exc_ptr - = build (EXC_PTR_EXPR, ptr_type_node); - tree gnu_incoming_exc_ptr - = create_var_decl (get_identifier ("EXPTR"), NULL_TREE, - ptr_type_node, gnu_current_exc_ptr, - 0, 0, 0, 0, 0); - - start_block_stmt (); - add_decl_stmt (gnu_incoming_exc_ptr, gnat_node); - gnat_expand_stmt (end_block_stmt (false)); - expand_expr_stmt - (build_call_1_expr (begin_handler_decl, gnu_incoming_exc_ptr)); - expand_decl_cleanup - (0, build_call_1_expr (end_handler_decl, gnu_incoming_exc_ptr)); - } - } - for (gnat_temp = First (Statements (gnat_node)); - gnat_temp; gnat_temp = Next (gnat_temp)) - gnat_to_code (gnat_temp); - - if (Exception_Mechanism == GCC_ZCX) - { - /* Tell the back end that we're done with the current handler. */ - expand_end_bindings (NULL_TREE, block_has_vars (), -1); + /* Expand a call to the begin_handler hook at the beginning of the + handler, and arrange for a call to the end_handler hook to occur + on every possible exit path. + + The hooks expect a pointer to the low level occurrence. This is + required for our stack management scheme because a raise inside + the handler pushes a new occurrence on top of the stack, which + means that this top does not necessarily match the occurrence + this handler was dealing with. + + The EXC_PTR_EXPR object references the exception occurrence + beeing propagated. Upon handler entry, this is the exception for + which the handler is triggered. This might not be the case upon + handler exit, however, as we might have a new occurrence + propagated by the handler's body, and the end_handler hook + called as a cleanup in this context. + + We use a local variable to retrieve the incoming value at + handler entry time, and reuse it to feed the end_handler hook's + argument at exit time. */ + gnu_current_exc_ptr = build (EXC_PTR_EXPR, ptr_type_node); + gnu_incoming_exc_ptr + = create_var_decl (get_identifier ("EXPTR"), NULL_TREE, + ptr_type_node, gnu_current_exc_ptr, + 0, 0, 0, 0, 0); + + add_decl_stmt (gnu_incoming_exc_ptr, gnat_node); + add_stmt_with_node (build_call_1_expr (begin_handler_decl, + gnu_incoming_exc_ptr), + gnat_node); + add_cleanup (build_call_1_expr (end_handler_decl, + gnu_incoming_exc_ptr)); + add_stmt_list (Statements (gnat_node)); gnat_poplevel (); - expand_end_catch (); + gnu_result = build (CATCH_EXPR, void_type_node, + gnu_etypes_list, end_stmt_group ()); } else - /* At the end of the handler, exit the block. We made this block in - N_Handled_Sequence_Of_Statements. */ - expand_exit_something (); - - if (Exception_Mechanism == Setjmp_Longjmp) - expand_end_cond (); + abort (); break; @@ -3913,6 +3607,7 @@ tree_transform (Node_Id gnat_node) case N_Function_Instantiation: /* These nodes can appear on a declaration list but there is nothing to to be done with them. */ + gnu_result = alloc_stmt_list (); break; /***************************************************/ @@ -3922,6 +3617,8 @@ tree_transform (Node_Id gnat_node) case N_Attribute_Definition_Clause: + gnu_result = alloc_stmt_list (); + /* The only one we need deal with is for 'Address. For the others, SEM puts the information elsewhere. We need only deal with 'Address if the object has a Freeze_Node (which it never will currently). */ @@ -3932,21 +3629,22 @@ tree_transform (Node_Id gnat_node) /* Get the value to use as the address and save it as the equivalent for GNAT_TEMP. When the object is frozen, gnat_to_gnu_entity will do the right thing. */ - gnu_expr = gnat_to_gnu (Expression (gnat_node)); - save_gnu_tree (Entity (Name (gnat_node)), gnu_expr, 1); + save_gnu_tree (Entity (Name (gnat_node)), + gnat_to_gnu (Expression (gnat_node)), 1); break; case N_Enumeration_Representation_Clause: case N_Record_Representation_Clause: case N_At_Clause: /* We do nothing with these. SEM puts the information elsewhere. */ + gnu_result = alloc_stmt_list (); break; case N_Code_Statement: if (! type_annotate_only) { tree gnu_template = gnat_to_gnu (Asm_Template (gnat_node)); - tree gnu_input_list = 0, gnu_output_list = 0, gnu_orig_out_list = 0; + tree gnu_input_list = 0, gnu_output_list = 0; tree gnu_clobber_list = 0; char *clobber; @@ -3970,8 +3668,6 @@ tree_transform (Node_Id gnat_node) tree gnu_constr = build_tree_list (NULL_TREE, gnat_to_gnu (Asm_Output_Constraint ())); - gnu_orig_out_list - = tree_cons (gnu_constr, gnu_value, gnu_orig_out_list); gnu_output_list = tree_cons (gnu_constr, gnu_value, gnu_output_list); Next_Asm_Output (); @@ -3986,12 +3682,14 @@ tree_transform (Node_Id gnat_node) gnu_input_list = nreverse (gnu_input_list); gnu_output_list = nreverse (gnu_output_list); - gnu_orig_out_list = nreverse (gnu_orig_out_list); - gnu_result = build_nt (ASM_STMT, gnu_template, gnu_output_list, - gnu_orig_out_list, gnu_input_list, - gnu_clobber_list); - TREE_THIS_VOLATILE (gnu_result) = Is_Asm_Volatile (gnat_node); + gnu_result = build (ASM_EXPR, void_type_node, + gnu_template, gnu_output_list, + gnu_input_list, gnu_clobber_list); + ASM_VOLATILE_P (gnu_result) = Is_Asm_Volatile (gnat_node); } + else + gnu_result = alloc_stmt_list (); + break; /***************************************************/ @@ -3999,15 +3697,17 @@ tree_transform (Node_Id gnat_node) /***************************************************/ case N_Freeze_Entity: + start_stmt_group (); process_freeze_entity (gnat_node); - start_block_stmt (); process_decls (Actions (gnat_node), Empty, Empty, 1, 1); - gnat_expand_stmt (end_block_stmt (false)); + gnu_result = end_stmt_group (); break; case N_Itype_Reference: if (! present_gnu_tree (Itype (gnat_node))) process_type (Itype (gnat_node)); + + gnu_result = alloc_stmt_list (); break; case N_Free_Statement: @@ -4056,21 +3756,21 @@ tree_transform (Node_Id gnat_node) gnu_ptr, gnu_byte_offset); } - gnu_result - = build_nt (EXPR_STMT, - build_call_alloc_dealloc - (gnu_ptr, gnu_obj_size, align, - Procedure_To_Call (gnat_node), - Storage_Pool (gnat_node), gnat_node)); + gnu_result = build_call_alloc_dealloc (gnu_ptr, gnu_obj_size, align, + Procedure_To_Call (gnat_node), + Storage_Pool (gnat_node), + gnat_node); } break; case N_Raise_Constraint_Error: case N_Raise_Program_Error: case N_Raise_Storage_Error: - if (type_annotate_only) - break; + { + gnu_result = alloc_stmt_list (); + break; + } gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_result = build_call_raise (UI_To_Int (Reason (gnat_node))); @@ -4080,14 +3780,12 @@ tree_transform (Node_Id gnat_node) is one. */ if (TREE_CODE (gnu_result_type) == VOID_TYPE) { - gnu_result = build_nt (EXPR_STMT, gnu_result); - TREE_TYPE (gnu_result) = void_type_node; - TREE_SLOC (gnu_result) = Sloc (gnat_node); + annotate_with_node (gnu_result, gnat_node); if (Present (Condition (gnat_node))) - gnu_result = build_nt (IF_STMT, - gnat_to_gnu (Condition (gnat_node)), - gnu_result, NULL_TREE, NULL_TREE); + gnu_result = build (COND_EXPR, void_type_node, + gnat_to_gnu (Condition (gnat_node)), + gnu_result, alloc_stmt_list ()); } else gnu_result = build1 (NULL_EXPR, gnu_result_type, gnu_result); @@ -4122,6 +3820,7 @@ tree_transform (Node_Id gnat_node) gnat_node, Target_Type (gnat_node)); } } + gnu_result = alloc_stmt_list (); break; case N_Raise_Statement: @@ -4133,17 +3832,19 @@ tree_transform (Node_Id gnat_node) default: if (! type_annotate_only) gigi_abort (321); - } - /* If the result is a statement, set needed flags and return it. */ - if (IS_STMT (gnu_result)) - { - TREE_TYPE (gnu_result) = void_type_node; - TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1; - TREE_SLOC (gnu_result) = Sloc (gnat_node); - return gnu_result; + gnu_result = alloc_stmt_list (); } + /* Set the location information into the result. If we're supposed to + return something of void_type, it means we have something we're + elaborating for effect, so just return. */ + if (IS_EXPR_CODE_CLASS (TREE_CODE_CLASS (TREE_CODE (gnu_result)))) + annotate_with_node (gnu_result, gnat_node); + + if (TREE_CODE (gnu_result_type) == VOID_TYPE) + return gnu_result; + /* If the result is a constant that overflows, raise constraint error. */ else if (TREE_CODE (gnu_result) == INTEGER_CST && TREE_CONSTANT_OVERFLOW (gnu_result)) @@ -4257,68 +3958,56 @@ tree_transform (Node_Id gnat_node) return gnu_result; } -/* INSN is a list of insns. Return the first rtl in the list that isn't - an INSN_NOTE_DELETED. */ +/* Record the current code position in GNAT_NODE. */ -static rtx -first_nondeleted_insn (rtx insns) +static void +record_code_position (Node_Id gnat_node) { - for (; insns && GET_CODE (insns) == NOTE - && NOTE_LINE_NUMBER (insns) == NOTE_INSN_DELETED; - insns = NEXT_INSN (insns)) - ; + tree stmt_stmt = build (STMT_STMT, void_type_node, NULL_TREE); - return insns; + add_stmt_with_node (stmt_stmt, gnat_node); + save_gnu_tree (gnat_node, stmt_stmt, 1); +} + +/* Insert the code for GNAT_NODE at the position saved for that node. */ + +static void +insert_code_for (Node_Id gnat_node) +{ + STMT_STMT_STMT (get_gnu_tree (gnat_node)) = gnat_to_gnu (gnat_node); + save_gnu_tree (gnat_node, NULL_TREE, 1); } -/* Push the BLOCK_STMT stack and allocate a new BLOCK_STMT. */ +/* Start a new statement group chained to the previous group. */ -static tree -start_block_stmt () +static void +start_stmt_group () { - tree gnu_block_stmt; + struct stmt_group *group = stmt_group_free_list; /* First see if we can get one from the free list. */ - if (gnu_block_stmt_free_list) - { - gnu_block_stmt = gnu_block_stmt_free_list; - gnu_block_stmt_free_list = TREE_CHAIN (gnu_block_stmt_free_list); - } + if (group) + stmt_group_free_list = group->previous; else - { - gnu_block_stmt = make_node (BLOCK_STMT); - TREE_TYPE (gnu_block_stmt) = void_type_node; - } - - BLOCK_STMT_LIST (gnu_block_stmt) = NULL_TREE; - BLOCK_STMT_BLOCK (gnu_block_stmt) = NULL_TREE; - TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_node; - gnu_block_stmt_node = gnu_block_stmt; + group = (struct stmt_group *) ggc_alloc (sizeof (struct stmt_group)); - return gnu_block_stmt; + group->previous = current_stmt_group; + group->stmt_list = group->block = group->cleanups = NULL_TREE; + current_stmt_group = group; } -/* Add GNU_STMT to the current BLOCK_STMT node. We add them backwards - order and the reverse in end_block_stmt. */ +/* Add GNU_STMT to the current statement group. */ void add_stmt (tree gnu_stmt) { - if (TREE_CODE_CLASS (TREE_CODE (gnu_stmt)) != 's') - gigi_abort (340); + append_to_statement_list (gnu_stmt, ¤t_stmt_group->stmt_list); - if (TREE_CODE (gnu_stmt) != NULL_STMT) - { - TREE_CHAIN (gnu_stmt) = BLOCK_STMT_LIST (gnu_block_stmt_node); - BLOCK_STMT_LIST (gnu_block_stmt_node) = gnu_stmt; - TREE_TYPE (gnu_stmt) = void_type_node; - } - - /* If this is a DECL_STMT for a variable with DECL_INIT_BY_ASSIGN_P set, + /* If this is a DECL_STMT for a variable with DECL_INITIAL set, generate the assignment statement too. */ if (TREE_CODE (gnu_stmt) == DECL_STMT && TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == VAR_DECL - && DECL_INIT_BY_ASSIGN_P (DECL_STMT_VAR (gnu_stmt))) + && DECL_INITIAL (DECL_STMT_VAR (gnu_stmt))) { tree gnu_decl = DECL_STMT_VAR (gnu_stmt); tree gnu_lhs = gnu_decl; @@ -4332,117 +4021,152 @@ add_stmt (tree gnu_stmt) = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_lhs))), gnu_lhs); gnu_assign_stmt - = build_nt (EXPR_STMT, - build_binary_op (MODIFY_EXPR, NULL_TREE, - gnu_lhs, DECL_INITIAL (gnu_decl))); + = build_binary_op (MODIFY_EXPR, NULL_TREE, + gnu_lhs, DECL_INITIAL (gnu_decl)); DECL_INITIAL (gnu_decl) = 0; - DECL_INIT_BY_ASSIGN_P (gnu_decl) = 0; - TREE_SLOC (gnu_assign_stmt) = TREE_SLOC (gnu_stmt); - TREE_TYPE (gnu_assign_stmt) = void_type_node; + SET_EXPR_LOCUS (gnu_assign_stmt, &DECL_SOURCE_LOCATION (gnu_decl)); add_stmt (gnu_assign_stmt); } } -/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node. +/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */ + +void +add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node) +{ + annotate_with_node (gnu_stmt, gnat_node); + add_stmt (gnu_stmt); +} + +/* Add a declaration statement for GNU_DECL to the current statement group. Get SLOC from Entity_Id. */ void add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity) { - tree gnu_stmt; - /* If this is a variable that Gigi is to ignore, we may have been given an ERROR_MARK. So test for it. We also might have been given a reference for a renaming. So only do something for a decl. */ if (!DECL_P (gnu_decl)) return; - gnu_stmt = build_nt (DECL_STMT, gnu_decl); - TREE_TYPE (gnu_stmt) = void_type_node; - TREE_SLOC (gnu_stmt) = Sloc (gnat_entity); - add_stmt (gnu_stmt); + add_stmt_with_node (build (DECL_STMT, void_type_node, gnu_decl), + gnat_entity); } -/* Return the BLOCK_STMT that corresponds to the statement that add_stmt - has been emitting or just a single statement if only one. If FORCE - is true, then always emit the BLOCK_STMT. */ +/* Add GNU_CLEANUP, a cleanup action, to the current code group. */ + +static void +add_cleanup (tree gnu_cleanup) +{ + append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups); +} + +/* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */ + +void +set_block_for_group (tree gnu_block) +{ + if (current_stmt_group->block) + abort (); + + current_stmt_group->block = gnu_block; +} + +/* Return code corresponding to the current code group. It is normally + a STATEMENT_LIST, but may also be a BIND_EXPR or TRY_FINALLY_EXPR if + BLOCK or cleanups were set. */ static tree -end_block_stmt (bool force) +end_stmt_group () { - tree gnu_block_stmt = gnu_block_stmt_node; - tree gnu_retval = gnu_block_stmt; + struct stmt_group *group = current_stmt_group; + tree gnu_retval = group->stmt_list; - gnu_block_stmt_node = TREE_CHAIN (gnu_block_stmt); - TREE_CHAIN (gnu_block_stmt) = 0; + /* If this is a null list, allocate a new STATEMENT_LIST. Then, if there + are cleanups, make a TRY_FINALLY_EXPR. Last, if there is a BLOCK, + make a BIND_EXPR. Note that we nest in that because the cleanup may + reference variables in the block. */ + if (gnu_retval == NULL_TREE) + gnu_retval = alloc_stmt_list (); - /* If we have only one statement, return it and free this node. Otherwise, - finish setting up this node and return it. If we have no statements, - return a NULL_STMT. */ - if (!force && BLOCK_STMT_LIST (gnu_block_stmt) == 0) - { - gnu_retval = build_nt (NULL_STMT); - TREE_TYPE (gnu_retval) = void_type_node; - } - else if (!force && TREE_CHAIN (BLOCK_STMT_LIST (gnu_block_stmt)) == 0) - gnu_retval = BLOCK_STMT_LIST (gnu_block_stmt); - else - { - BLOCK_STMT_LIST (gnu_block_stmt) - = nreverse (BLOCK_STMT_LIST (gnu_block_stmt)); - TREE_SLOC (gnu_block_stmt) - = TREE_SLOC (BLOCK_STMT_LIST (gnu_block_stmt)); - } + if (group->cleanups) + gnu_retval = build (TRY_FINALLY_EXPR, void_type_node, gnu_retval, + group->cleanups); - if (gnu_retval != gnu_block_stmt) - { - TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_free_list; - gnu_block_stmt_free_list = gnu_block_stmt; - } + if (current_stmt_group->block) + gnu_retval = build (BIND_EXPR, void_type_node, BLOCK_VARS (group->block), + gnu_retval, group->block); + + /* Remove this group from the stack and add it to the free list. */ + current_stmt_group = group->previous; + group->previous = stmt_group_free_list; + stmt_group_free_list = group; return gnu_retval; } -/* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements. */ +/* Add a list of statements from GNAT_LIST, a possibly-empty list of + statements.*/ -static tree -build_block_stmt (List_Id gnat_list) +static void +add_stmt_list (List_Id gnat_list) { - tree gnu_result = NULL_TREE; Node_Id gnat_node; - if (No (gnat_list) || Is_Empty_List (gnat_list)) - return NULL_TREE; + if (Present (gnat_list)) + for (gnat_node = First (gnat_list); Present (gnat_node); + gnat_node = Next (gnat_node)) + add_stmt (gnat_to_gnu (gnat_node)); +} - start_block_stmt (); +/* Build a tree from GNAT_LIST, a possibly-empty list of statements. + If BINDING_P is true, push and pop a binding level around the list. */ - for (gnat_node = First (gnat_list); - Present (gnat_node); - gnat_node = Next (gnat_node)) - add_stmt (gnat_to_gnu (gnat_node)); +static tree +build_stmt_group (List_Id gnat_list, bool binding_p) +{ + start_stmt_group (); + if (binding_p) + gnat_pushlevel (); - gnu_result = end_block_stmt (false); - return TREE_CODE (gnu_result) == NULL_STMT ? NULL_TREE : gnu_result; -} + add_stmt_list (gnat_list); + if (binding_p) + gnat_poplevel (); -/* Build an EXPR_STMT to evaluate INSNS. Use Sloc from GNAT_NODE. */ + return end_stmt_group (); +} + +/* Push and pop routines for stacks. We keep a free list around so we + don't waste tree nodes. */ -static tree -make_expr_stmt_from_rtl (rtx insns, Node_Id gnat_node) +static void +push_stack (tree *gnu_stack_ptr, tree gnu_purpose, tree gnu_value) { - tree gnu_result = make_node (RTL_EXPR); + tree gnu_node = gnu_stack_free_list; - TREE_TYPE (gnu_result) = void_type_node; - RTL_EXPR_RTL (gnu_result) = RTL_EXPR_ALT_RTL (gnu_result) = const0_rtx; - RTL_EXPR_SEQUENCE (gnu_result) = insns; - rtl_expr_chain = tree_cons (NULL_TREE, gnu_result, rtl_expr_chain); + if (gnu_node) + { + gnu_stack_free_list = TREE_CHAIN (gnu_node); + TREE_CHAIN (gnu_node) = *gnu_stack_ptr; + TREE_PURPOSE (gnu_node) = gnu_purpose; + TREE_VALUE (gnu_node) = gnu_value; + } + else + gnu_node = tree_cons (gnu_purpose, gnu_value, *gnu_stack_ptr); - gnu_result = build_nt (EXPR_STMT, gnu_result); - TREE_SLOC (gnu_result) = Sloc (gnat_node); - TREE_TYPE (gnu_result) = void_type_node; + *gnu_stack_ptr = gnu_node; +} - return gnu_result; +static void +pop_stack (tree *gnu_stack_ptr) +{ + tree gnu_node = *gnu_stack_ptr; + + *gnu_stack_ptr = TREE_CHAIN (gnu_node); + TREE_CHAIN (gnu_node) = gnu_stack_free_list; + gnu_stack_free_list = gnu_node; } /* GNU_STMT is a statement. We generate code for that statement. */ @@ -4450,122 +4174,251 @@ make_expr_stmt_from_rtl (rtx insns, Node_Id gnat_node) void gnat_expand_stmt (tree gnu_stmt) { +#if 0 tree gnu_elmt, gnu_elmt_2; - - if (TREE_SLOC (gnu_stmt)) - set_lineno_from_sloc (TREE_SLOC (gnu_stmt), 1); +#endif switch (TREE_CODE (gnu_stmt)) { - case EXPR_STMT: - expand_expr_stmt (EXPR_STMT_EXPR (gnu_stmt)); - break; +#if 0 + case USE_STMT: + /* First write a volatile ASM_INPUT to prevent anything from being + moved. */ + gnu_elmt = gen_rtx_ASM_INPUT (VOIDmode, ""); + MEM_VOLATILE_P (gnu_elmt) = 1; + emit_insn (gnu_elmt); + + gnu_elmt = expand_expr (TREE_OPERAND (gnu_stmt, 0), NULL_RTX, VOIDmode, + modifier); + emit_insn (gen_rtx_USE (VOIDmode, )); + return target; +#endif - case NULL_STMT: - break; + default: + abort (); + } +} + +/* Generate GIMPLE in place for the expression at *EXPR_P. */ - case DECL_STMT: - if (TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == TYPE_DECL) - force_type_save_exprs (TREE_TYPE (DECL_STMT_VAR (gnu_stmt))); +int +gnat_gimplify_expr (tree *expr_p, tree *pre_p ATTRIBUTE_UNUSED, tree *post_p) +{ + tree expr = *expr_p; + + if (IS_ADA_STMT (expr)) + return gnat_gimplify_stmt (expr_p); + + switch (TREE_CODE (expr)) + { + case NULL_EXPR: + /* If this is for a scalar, just make a VAR_DECL for it. If for + an aggregate, get a null pointer of the appropriate type and + dereference it. */ + if (AGGREGATE_TYPE_P (TREE_TYPE (expr))) + *expr_p = build1 (INDIRECT_REF, TREE_TYPE (expr), + convert (build_pointer_type (TREE_TYPE (expr)), + integer_zero_node)); else - { - expand_decl (DECL_STMT_VAR (gnu_stmt)); - if (DECL_CONTEXT (DECL_STMT_VAR (gnu_stmt))) - expand_decl_init (DECL_STMT_VAR (gnu_stmt)); + *expr_p = create_tmp_var (TREE_TYPE (expr), NULL); - if (TREE_ADDRESSABLE (DECL_STMT_VAR (gnu_stmt))) - { - put_var_into_stack (DECL_STMT_VAR (gnu_stmt), true); - flush_addressof (DECL_STMT_VAR (gnu_stmt)); - } - } - break; + append_to_statement_list (TREE_OPERAND (expr, 0), post_p); + return GS_OK; - case BLOCK_STMT: - if (BLOCK_STMT_BLOCK (gnu_stmt)) - expand_start_bindings_and_block (0, BLOCK_STMT_BLOCK (gnu_stmt)); + case UNCONSTRAINED_ARRAY_REF: + /* We should only do this if we are just elaborating for side-effects, + but we can't know that yet. */ + *expr_p = TREE_OPERAND (*expr_p, 0); + return GS_OK; - for (gnu_elmt = BLOCK_STMT_LIST (gnu_stmt); gnu_elmt; - gnu_elmt = TREE_CHAIN (gnu_elmt)) - gnat_expand_stmt (gnu_elmt); + default: + return GS_UNHANDLED; + } +} - if (BLOCK_STMT_BLOCK (gnu_stmt)) - expand_end_bindings (NULL_TREE, 1, -1); - break; +/* Generate GIMPLE in place for the statement at *STMT_P. */ - case IF_STMT: - expand_start_cond (IF_STMT_COND (gnu_stmt), 0); +static enum gimplify_status +gnat_gimplify_stmt (tree *stmt_p) +{ + tree stmt = *stmt_p; - if (IF_STMT_TRUE (gnu_stmt)) - gnat_expand_stmt (IF_STMT_TRUE (gnu_stmt)); + switch (TREE_CODE (stmt)) + { + case STMT_STMT: + *stmt_p = STMT_STMT_STMT (stmt); + return GS_OK; - for (gnu_elmt = IF_STMT_ELSEIF (gnu_stmt); gnu_elmt; - gnu_elmt = TREE_CHAIN (gnu_elmt)) - { - expand_start_else (); - set_lineno_from_sloc (TREE_SLOC (gnu_elmt), 1); - expand_elseif (IF_STMT_COND (gnu_elmt)); - if (IF_STMT_TRUE (gnu_elmt)) - gnat_expand_stmt (IF_STMT_TRUE (gnu_elmt)); - } + case USE_STMT: + *stmt_p = build_empty_stmt (); + return GS_ALL_DONE; - if (IF_STMT_ELSE (gnu_stmt)) - { - expand_start_else (); - gnat_expand_stmt (IF_STMT_ELSE (gnu_stmt)); - } + 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; - expand_end_cond (); - break; + case LOOP_STMT: + { + tree gnu_start_label = create_artificial_label (); + tree gnu_end_label = create_artificial_label (); + + /* Save the end label for EXIT_STMT and set to emit the statements + of the loop. */ + LOOP_STMT_LABEL (stmt) = gnu_end_label; + *stmt_p = NULL_TREE; + + /* We first emit the start label and then a conditional jump to + the end label if there's a top condition, then the body of the + loop, then a conditional branch to the end label, then the update, + if any, and finally a jump to the start label and the definition + of the end label. */ + append_to_statement_list (build1 (LABEL_EXPR, void_type_node, + gnu_start_label), + stmt_p); + + if (LOOP_STMT_TOP_COND (stmt)) + append_to_statement_list (build (COND_EXPR, void_type_node, + LOOP_STMT_TOP_COND (stmt), + alloc_stmt_list (), + build1 (GOTO_EXPR, + void_type_node, + gnu_end_label)), + stmt_p); + + append_to_statement_list (LOOP_STMT_BODY (stmt), stmt_p); + + if (LOOP_STMT_BOT_COND (stmt)) + append_to_statement_list (build (COND_EXPR, void_type_node, + LOOP_STMT_BOT_COND (stmt), + alloc_stmt_list (), + build1 (GOTO_EXPR, + void_type_node, + gnu_end_label)), + stmt_p); + + if (LOOP_STMT_UPDATE (stmt)) + append_to_statement_list (LOOP_STMT_UPDATE (stmt), stmt_p); + + append_to_statement_list (build1 (GOTO_EXPR, void_type_node, + gnu_start_label), + stmt_p); + append_to_statement_list (build1 (LABEL_EXPR, void_type_node, + gnu_end_label), + stmt_p); + return GS_OK; + } - case GOTO_STMT: - TREE_USED (GOTO_STMT_LABEL (gnu_stmt)) = 1; - expand_goto (GOTO_STMT_LABEL (gnu_stmt)); - break; + 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))); + if (EXIT_STMT_COND (stmt)) + *stmt_p = build (COND_EXPR, void_type_node, + EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ()); + return GS_OK; - case LABEL_STMT: - expand_label (LABEL_STMT_LABEL (gnu_stmt)); - break; + default: + abort (); + } +} - case RETURN_STMT: - if (RETURN_STMT_EXPR (gnu_stmt)) - expand_return (build_binary_op (MODIFY_EXPR, NULL_TREE, - DECL_RESULT (current_function_decl), - RETURN_STMT_EXPR (gnu_stmt))); - else - expand_null_return (); - break; +/* Look through GNU_TYPE for variable-sized objects and gimplify each such + size that we find. Return a STATEMENT_LIST containing the result. */ - case ASM_STMT: - expand_asm_operands (ASM_STMT_TEMPLATE (gnu_stmt), - ASM_STMT_OUTPUT (gnu_stmt), - ASM_STMT_INPUT (gnu_stmt), - ASM_STMT_CLOBBER (gnu_stmt), - TREE_THIS_VOLATILE (gnu_stmt), input_location); - - /* Copy all the intermediate outputs into the specified outputs. */ - for ((gnu_elmt = ASM_STMT_OUTPUT (gnu_stmt), - gnu_elmt_2 = ASM_STMT_ORIG_OUT (gnu_stmt)); - gnu_elmt; - (gnu_elmt = TREE_CHAIN (gnu_elmt), - gnu_elmt_2 = TREE_CHAIN (gnu_elmt_2))) - if (TREE_VALUE (gnu_elmt) != TREE_VALUE (gnu_elmt_2)) - { - expand_expr_stmt - (build_binary_op (MODIFY_EXPR, NULL_TREE, - TREE_VALUE (gnu_elmt_2), - TREE_VALUE (gnu_elmt))); - free_temp_slots (); - } +static tree +gnat_gimplify_type_sizes (tree gnu_type) +{ + tree gnu_stmts = NULL_TREE; + tree gnu_field; + + switch (TREE_CODE (gnu_type)) + { + case ERROR_MARK: + case UNCONSTRAINED_ARRAY_TYPE: + return alloc_stmt_list (); + + case INTEGER_TYPE: + case ENUMERAL_TYPE: + case BOOLEAN_TYPE: + case CHAR_TYPE: + case REAL_TYPE: + gnat_gimplify_one_sizepos (&TYPE_MIN_VALUE (gnu_type), &gnu_stmts); + gnat_gimplify_one_sizepos (&TYPE_MAX_VALUE (gnu_type), &gnu_stmts); break; - case BREAK_STMT: - expand_exit_something (); + case RECORD_TYPE: + case UNION_TYPE: + case QUAL_UNION_TYPE: + for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field; + gnu_field = TREE_CHAIN (gnu_field)) + if (TREE_CODE (gnu_field) == FIELD_DECL) + gnat_gimplify_one_sizepos (&DECL_FIELD_OFFSET (gnu_field), + &gnu_stmts); break; default: - abort (); + break; } + + gnat_gimplify_one_sizepos (&TYPE_SIZE (gnu_type), &gnu_stmts); + gnat_gimplify_one_sizepos (&TYPE_SIZE_UNIT (gnu_type), &gnu_stmts); + + if (!gnu_stmts) + gnu_stmts = alloc_stmt_list (); + + return gnu_stmts; +} + +/* Subroutine of the above to gimplify one size or position, *GNU_EXPR_P. + We add any required statements to GNU_STMT_P. */ + +static void +gnat_gimplify_one_sizepos (tree *gnu_expr_p, tree *gnu_stmt_p) +{ + tree gnu_pre = NULL_TREE, gnu_post = NULL_TREE; + + /* We don't do anything if the value isn't there, is constant, or + contains a PLACEHOLDER_EXPR. */ + if (*gnu_expr_p == NULL_TREE + || TREE_CONSTANT (*gnu_expr_p) + || CONTAINS_PLACEHOLDER_P (*gnu_expr_p)) + return; + + gimplify_expr (gnu_expr_p, &gnu_pre, &gnu_post, is_gimple_val, fb_rvalue); + + if (gnu_pre) + append_to_statement_list (gnu_pre, gnu_stmt_p); + if (gnu_post) + append_to_statement_list (gnu_post, gnu_stmt_p); +} + +/* Generate the RTL for the body of GNU_DECL. If NESTED_P is nonzero, + then we are already in the process of generating RTL for another + function. */ + +static void +gnat_expand_body_1 (tree gnu_decl, bool nested_p) +{ + if (nested_p) + push_function_context (); + + tree_rest_of_compilation (gnu_decl, nested_p); + + if (nested_p) + pop_function_context (); +} + +/* Expand the body of GNU_DECL, which is not a nested function. */ + +void +gnat_expand_body (tree gnu_decl) +{ + if (DECL_INITIAL (gnu_decl) && DECL_INITIAL (gnu_decl) != error_mark_node) + gnat_expand_body_1 (gnu_decl, false); } /* Force references to each of the entities in packages GNAT_NODE with's @@ -4790,7 +4643,7 @@ process_inlined_subprograms (Node_Id gnat_node) if (Present (gnat_body)) { gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); - gnat_to_code (gnat_body); + add_stmt (gnat_to_gnu (gnat_body)); } } } @@ -4824,8 +4677,6 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, for (gnat_decl = First (gnat_decl_array[i]); gnat_decl != gnat_end_list; gnat_decl = Next (gnat_decl)) { - set_lineno (gnat_decl, 0); - /* For package specs, we recurse inside the declarations, thus taking the two pass approach inside the boundary. */ if (Nkind (gnat_decl) == N_Package_Declaration @@ -4839,9 +4690,7 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, freeze node. */ else if (Nkind (gnat_decl) == N_Freeze_Entity) { - start_block_stmt (); process_freeze_entity (gnat_decl); - gnat_expand_stmt (end_block_stmt (false)); process_decls (Actions (gnat_decl), Empty, Empty, 1, 0); } @@ -4893,11 +4742,7 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, || Nkind (gnat_decl) == N_Protected_Body_Stub) ; else - { - start_block_stmt (); - gnat_to_code (gnat_decl); - gnat_expand_stmt (end_block_stmt (false)); - } + add_stmt (gnat_to_gnu (gnat_decl)); } /* Here we elaborate everything we deferred above except for package bodies, @@ -4913,7 +4758,7 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, || Nkind (gnat_decl) == N_Subprogram_Body_Stub || Nkind (gnat_decl) == N_Task_Body_Stub || Nkind (gnat_decl) == N_Protected_Body_Stub) - gnat_to_code (gnat_decl); + add_stmt (gnat_to_gnu (gnat_decl)); else if (Nkind (gnat_decl) == N_Package_Declaration && (Nkind (Specification (gnat_decl) @@ -5323,7 +5168,6 @@ process_type (Entity_Id gnat_entity) } /* Now fully elaborate the type. */ - start_block_stmt (); gnu_new = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 1); if (TREE_CODE (gnu_new) != TYPE_DECL) gigi_abort (324); @@ -5354,8 +5198,6 @@ process_type (Entity_Id gnat_entity) update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_task_old)), TREE_TYPE (gnu_new)); } - - gnat_expand_stmt (end_block_stmt (false)); } /* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate. @@ -5742,9 +5584,7 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) DECL_ELABORATION_PROC_P (gnu_decl) = 1; begin_subprog_body (gnu_decl); - set_lineno (gnat_unit, 1); gnat_pushlevel (); - gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); expand_start_bindings (0); /* Emit the assignments for the elaborations we have to do. If there @@ -5788,8 +5628,7 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) expand_end_bindings (NULL_TREE, block_has_vars (), -1); gnat_poplevel (); - gnu_block_stack = TREE_CHAIN (gnu_block_stack); - end_subprog_body (); + end_subprog_body (alloc_stmt_list ()); /* We are finished with the elaboration list it can now be discarded. */ gnu_pending_elaboration_lists = TREE_CHAIN (gnu_pending_elaboration_lists); @@ -5801,50 +5640,52 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) extern char *__gnat_to_canonical_file_spec (char *); -/* Determine the input_filename and the input_line from the source location - (Sloc) of GNAT_NODE node. Set the global variable input_filename and - input_line. If WRITE_NOTE_P is true, emit a line number note. */ - -void -set_lineno (Node_Id gnat_node, int write_note_p) -{ - Source_Ptr source_location = Sloc (gnat_node); - - set_lineno_from_sloc (source_location, write_note_p); -} - -/* Likewise, but passed a Sloc. */ +/* Convert Sloc into *LOCUS (a location_t). Return true if this Sloc + corresponds to a source code location and false if it doesn't. In the + latter case, we don't update *LOCUS. We also set the Gigi global variable + REF_FILENAME to the reference file name as given by sinput (i.e no + directory). */ -void -set_lineno_from_sloc (Source_Ptr source_location, int write_note_p) +bool +Sloc_to_locus (Source_Ptr Sloc, location_t *locus) { /* If node not from source code, ignore. */ - if (source_location < 0) - return; + if (Sloc < 0) + return false; /* Use the identifier table to make a hashed, permanent copy of the filename, since the name table gets reallocated after Gigi returns but before all the debugging information is output. The __gnat_to_canonical_file_spec call translates filenames from pragmas Source_Reference that contain host style syntax not understood by gdb. */ - input_filename + locus->file = IDENTIFIER_POINTER (get_identifier (__gnat_to_canonical_file_spec - (Get_Name_String - (Full_Debug_Name (Get_Source_File_Index (source_location)))))); + (Get_Name_String (Full_Debug_Name (Get_Source_File_Index (Sloc)))))); + + locus->line = Get_Logical_Line_Number (Sloc); - /* ref_filename is the reference file name as given by sinput (i.e no - directory) */ ref_filename = IDENTIFIER_POINTER (get_identifier - (Get_Name_String - (Debug_Source_Name (Get_Source_File_Index (source_location)))));; - input_line = Get_Logical_Line_Number (source_location); + (Get_Name_String (Debug_Source_Name (Get_Source_File_Index (Sloc)))));; + + return true; +} + +/* Similar to annotate_with_locus, but start with the Sloc of GNAT_NODE and + don't do anything if it doesn't correspond to a source location. */ + +static void +annotate_with_node (tree node, Node_Id gnat_node) +{ + location_t locus; + + if (!Sloc_to_locus (Sloc (gnat_node), &locus)) + return; - if (! global_bindings_p () && write_note_p) - emit_line_note (input_location); + annotate_with_locus (node, locus); } /* Post an error message. MSG is the error message, properly annotated. diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index c30494f2162..1b50b71313e 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -38,6 +38,10 @@ #include "convert.h" #include "target.h" #include "function.h" +#include "cgraph.h" +#include "tree-inline.h" +#include "tree-gimple.h" +#include "tree-dump.h" #include "ada.h" #include "types.h" @@ -101,14 +105,8 @@ static GTY(()) tree signed_and_unsigned_types[2 * MAX_BITS_PER_WORD + 1][2]; /* Likewise for float types, but record these by mode. */ static GTY(()) tree float_types[NUM_MACHINE_MODES]; -/* For each binding contour we allocate a binding_level structure which records - the entities defined or declared in that contour. Contours include: - - the global one - one for each subprogram definition - one for each compound statement (declare block) - - Binding contours are used to create GCC tree BLOCK nodes. */ +/* For each binding contour we allocate a binding_level structure to indicate + the binding depth. */ struct ada_binding_level GTY((chain_next ("%h.chain"))) { @@ -116,6 +114,9 @@ struct ada_binding_level GTY((chain_next ("%h.chain"))) struct ada_binding_level *chain; /* The BLOCK node for this level. */ tree block; + /* If nonzero, the setjmp buffer that needs to be updated for any + variable-sized definition within this context. */ + tree jmpbuf_decl; }; /* The binding level currently in effect. */ @@ -132,10 +133,14 @@ struct language_function GTY(()) int unused; }; +static void gnat_define_builtin (const char *, tree, int, const char *, bool); +static void gnat_install_builtins (void); static tree merge_sizes (tree, tree, tree, int, int); static tree compute_related_constant (tree, tree); static tree split_plus (tree, tree *); static int value_zerop (tree); +static void gnat_gimplify_function (tree); +static void gnat_finalize (tree); static tree float_type_for_precision (int, enum machine_mode); static tree convert_to_fat_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree); @@ -254,36 +259,37 @@ gnat_pushlevel () /* Add this level to the front of the chain (stack) of levels that are active. */ newlevel->chain = current_binding_level; + newlevel->jmpbuf_decl = NULL_TREE; current_binding_level = newlevel; } -/* Exit a binding level. Return the BLOCK node, if any. */ +/* Set the jmpbuf_decl for the current binding level to DECL. */ + +void +set_block_jmpbuf_decl (tree decl) +{ + current_binding_level->jmpbuf_decl = decl; +} + +/* Get the jmpbuf_decl, if any, for the current binding level. */ tree +get_block_jmpbuf_decl () +{ + return current_binding_level->jmpbuf_decl; +} + +/* Exit a binding level. Set any BLOCK into the current code group. */ + +void gnat_poplevel () { struct ada_binding_level *level = current_binding_level; tree block = level->block; - tree decl; BLOCK_VARS (block) = nreverse (BLOCK_VARS (block)); BLOCK_SUBBLOCKS (block) = nreverse (BLOCK_SUBBLOCKS (block)); - /* Output any nested inline functions within this block which must be - compiled because their address is needed. */ - for (decl = BLOCK_VARS (block); decl; decl = TREE_CHAIN (decl)) - if (TREE_CODE (decl) == FUNCTION_DECL - && ! TREE_ASM_WRITTEN (decl) && TREE_ADDRESSABLE (decl) - && DECL_INITIAL (decl) != 0) - { - push_function_context (); - /* ??? This is temporary. */ - ggc_push_context (); - output_inline_function (decl); - ggc_pop_context (); - pop_function_context (); - } - /* If this is a function-level BLOCK don't do anything. Otherwise, if there are no variables free the block and merge its subblocks into those of its parent block. Otherwise, add it to the list of its parent. */ @@ -296,20 +302,19 @@ gnat_poplevel () BLOCK_SUBBLOCKS (level->chain->block)); TREE_CHAIN (block) = free_block_chain; free_block_chain = block; - block = NULL_TREE; } else { TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block); BLOCK_SUBBLOCKS (level->chain->block) = block; TREE_USED (block) = 1; + set_block_for_group (block); } /* Free this binding structure. */ current_binding_level = level->chain; level->chain = free_binding_level; free_binding_level = level; - return block; } /* Insert BLOCK at the end of the list of subblocks of the @@ -400,7 +405,8 @@ gnat_init_decl_processing (void) Pmode differ, C will use the width of ptr_mode as sizetype. But we get far better code using the width of Pmode. Make this here since we need this before we can expand the GNAT types. */ - set_sizetype (gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0)); + size_type_node = gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0); + set_sizetype (size_type_node); build_common_tree_nodes_2 (0); pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype)); @@ -414,8 +420,96 @@ gnat_init_decl_processing (void) ptr_void_type_node = build_pointer_type (void_type_node); + gnat_install_builtins (); +} + +/* Define a builtin function. This is temporary and is just being done + to initialize implicit_built_in_decls for the middle-end. We'll want + to do full builtin processing soon. */ + +static void +gnat_define_builtin (const char *name, tree type, + int function_code, const char *library_name, bool const_p) +{ + tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); + + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + if (library_name) + SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name)); + make_decl_rtl (decl, NULL); + pushdecl (decl); + DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL; + DECL_FUNCTION_CODE (decl) = function_code; + TREE_READONLY (decl) = const_p; + + implicit_built_in_decls[function_code] = decl; } +/* Install the builtin functions the middle-end needs. */ + +static void +gnat_install_builtins () +{ + tree ftype; + tree tmp; + + tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node); + tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp); + ftype = build_function_type (long_integer_type_node, tmp); + gnat_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT, + "__builtin_expect", true); + + 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 (ptr_void_type_node, tmp); + gnat_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY, + "memcpy", 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); + + tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gnat_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, "clzl", true); + + tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gnat_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, "clzll", + true); + + tmp = tree_cons (NULL_TREE, ptr_void_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 (void_type_node, tmp); + gnat_define_builtin ("__builtin_init_trampoline", ftype, + BUILT_IN_INIT_TRAMPOLINE, "init_trampoline", false); + + tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node); + ftype = build_function_type (ptr_void_type_node, tmp); + gnat_define_builtin ("__builtin_adjust_trampoline", ftype, + BUILT_IN_ADJUST_TRAMPOLINE, "adjust_trampoline", true); + + tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node); + tmp = tree_cons (NULL_TREE, size_type_node, void_list_node); + ftype = build_function_type (ptr_void_type_node, tmp); + gnat_define_builtin ("__builtin_stack_alloc", ftype, BUILT_IN_STACK_ALLOC, + "stack_alloc", false); + + /* The stack_save and stack_restore builtins aren't used directly. They + are inserted during gimplification to implement stack_alloc calls. */ + ftype = build_function_type (ptr_void_type_node, void_list_node); + gnat_define_builtin ("__builtin_stack_save", ftype, BUILT_IN_STACK_SAVE, + "stack_save", false); + tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node); + ftype = build_function_type (void_type_node, tmp); + gnat_define_builtin ("__builtin_stack_restore", ftype, + BUILT_IN_STACK_RESTORE, "stack_restore", false); +} + + /* Create the predefined scalar types such as `integer_type_node' needed in the gcc back-end and initialize the global binding level. */ @@ -1229,13 +1323,11 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, ? CONST_DECL : VAR_DECL, var_name, type); /* If this is external, throw away any initializations unless this is a - CONST_DECL (meaning we have a constant); they will be done elsewhere. If - we are defining a global here, leave a constant initialization and save - any variable elaborations for the elaboration routine. Otherwise, if - the initializing expression is not the same as TYPE, generate the - initialization with an assignment statement, since it knows how - to do the required adjustents. If we are just annotating types, - throw away the initialization if it isn't a constant. */ + CONST_DECL (meaning we have a constant); they will be done elsewhere. + If we are defining a global here, leave a constant initialization and + save any variable elaborations for the elaboration routine. If we are + just annotating types, throw away the initialization if it isn't a + constant. */ if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL) || (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init))) @@ -1247,12 +1339,6 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, var_init = 0; } - else if (var_init != 0 - && ((TYPE_MAIN_VARIANT (TREE_TYPE (var_init)) - != TYPE_MAIN_VARIANT (type)) - || (static_flag && ! init_const))) - DECL_INIT_BY_ASSIGN_P (var_decl) = 1; - DECL_INITIAL (var_decl) = var_init; TREE_READONLY (var_decl) = const_flag; DECL_EXTERNAL (var_decl) = extern_flag; @@ -1703,13 +1789,16 @@ create_subprog_decl (tree subprog_name, DECL_EXTERNAL (subprog_decl) = extern_flag; TREE_PUBLIC (subprog_decl) = public_flag; - DECL_INLINE (subprog_decl) = inline_flag; + TREE_STATIC (subprog_decl) = 1; TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type); TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type); TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type); DECL_ARGUMENTS (subprog_decl) = param_decl_list; DECL_RESULT (subprog_decl) = build_decl (RESULT_DECL, 0, return_type); + if (inline_flag) + DECL_DECLARED_INLINE_P (subprog_decl) = 1; + if (asm_name != 0) SET_DECL_ASSEMBLER_NAME (subprog_decl, asm_name); @@ -1763,95 +1852,93 @@ begin_subprog_body (tree subprog_decl) init_function_start (subprog_decl); expand_function_start (subprog_decl, 0); - - /* If this function is `main', emit a call to `__main' - to run global initializers, etc. */ - if (DECL_ASSEMBLER_NAME (subprog_decl) != 0 - && MAIN_NAME_P (DECL_ASSEMBLER_NAME (subprog_decl)) - && DECL_CONTEXT (subprog_decl) == NULL_TREE) - expand_main_function (); } /* Finish the definition of the current subprogram and compile it all the way - to assembler language output. */ + to assembler language output. BODY is the tree corresponding to + the subprogram. */ void -end_subprog_body (void) +end_subprog_body (tree body) { - tree decl; - tree cico_list; + tree fndecl = current_function_decl; /* Mark the BLOCK for this level as being for this function and pop the level. Since the vars in it are the parameters, clear them. */ BLOCK_VARS (current_binding_level->block) = 0; - BLOCK_SUPERCONTEXT (current_binding_level->block) = current_function_decl; - DECL_INITIAL (current_function_decl) = current_binding_level->block; + BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl; + DECL_INITIAL (fndecl) = current_binding_level->block; gnat_poplevel (); + /* Deal with inline. If declared inline or we should default to inline, + set the flag in the decl. */ + DECL_INLINE (fndecl) + = DECL_DECLARED_INLINE_P (fndecl) || flag_inline_trees == 2; + + /* Initialize the RTL code for the function. */ + allocate_struct_function (fndecl); + + /* We handle pending sizes via the elaboration of types, so we don't + need to save them. */ + get_pending_sizes (); + /* Mark the RESULT_DECL as being in this subprogram. */ - DECL_CONTEXT (DECL_RESULT (current_function_decl)) = current_function_decl; + DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl; - expand_function_end (); + DECL_SAVED_TREE (fndecl) = body; - /* If this is a nested function, push a new GC context. That will keep - local variables on the stack from being collected while we're doing - the compilation of this function. */ - if (function_nesting_depth > 1) - ggc_push_context (); + current_function_decl = DECL_CONTEXT (fndecl); - /* If we're only annotating types, don't actually compile this - function. */ - if (!type_annotate_only) + /* If we're only annotating types, don't actually compile this function. */ + if (type_annotate_only) + return; + + /* We do different things for nested and non-nested functions. + ??? This should be in cgraph. */ + if (!DECL_CONTEXT (fndecl)) { - rest_of_compilation (current_function_decl); - if (! DECL_DEFER_OUTPUT (current_function_decl)) - { - free_after_compilation (cfun); - DECL_STRUCT_FUNCTION (current_function_decl) = 0; - } - cfun = 0; + gnat_gimplify_function (fndecl); + lower_nested_functions (fndecl); + gnat_finalize (fndecl); } + else + /* Register this function with cgraph just far enough to get it + added to our parent's nested function list. */ + (void) cgraph_node (fndecl); +} - if (function_nesting_depth > 1) - ggc_pop_context (); - - /* Throw away any VAR_DECLs we made for OUT parameters; they must - not be seen when we call this function and will be in - unallocated memory anyway. */ - for (cico_list = TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl)); - cico_list != 0; cico_list = TREE_CHAIN (cico_list)) - TREE_VALUE (cico_list) = 0; +/* Convert FNDECL's code to GIMPLE and handle any nested functions. */ - if (DECL_STRUCT_FUNCTION (current_function_decl) == 0) - { - /* Throw away DECL_RTL in any PARM_DECLs unless this function - was saved for inline, in which case the DECL_RTLs are in - preserved memory. */ - for (decl = DECL_ARGUMENTS (current_function_decl); - decl != 0; decl = TREE_CHAIN (decl)) - { - SET_DECL_RTL (decl, 0); - DECL_INCOMING_RTL (decl) = 0; - } +static void +gnat_gimplify_function (tree fndecl) +{ + struct cgraph_node *cgn; + + dump_function (TDI_original, fndecl); + gimplify_function_tree (fndecl); + dump_function (TDI_generic, fndecl); + + /* Convert all nested functions to GIMPLE now. We do things in this order + so that items like VLA sizes are expanded properly in the context of the + correct function. */ + cgn = cgraph_node (fndecl); + for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested) + gnat_gimplify_function (cgn->decl); +} - /* Similarly, discard DECL_RTL of the return value. */ - SET_DECL_RTL (DECL_RESULT (current_function_decl), 0); +/* Give FNDECL and all its nested functions to cgraph for compilation. */ - /* But DECL_INITIAL must remain nonzero so we know this - was an actual function definition unless toplev.c decided not - to inline it. */ - if (DECL_INITIAL (current_function_decl) != 0) - DECL_INITIAL (current_function_decl) = error_mark_node; +static void +gnat_finalize (tree fndecl) +{ + struct cgraph_node *cgn; - DECL_ARGUMENTS (current_function_decl) = 0; - } + /* Finalize all nested functions now. */ + cgn = cgraph_node (fndecl); + for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested) + gnat_finalize (cgn->decl); - /* If we are not at the bottom of the function nesting stack, pop up to - the containing function. Otherwise show we aren't in any function. */ - if (--function_nesting_depth != 0) - pop_function_context (); - else - current_function_decl = 0; + cgraph_finalize_function (fndecl, false); } /* Return a definition for a builtin function named NAME and whose data type @@ -2824,7 +2911,7 @@ convert (tree type, tree expr) /* If the input is a biased type, adjust first. */ if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype)) return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype), - fold (build1 (GNAT_NOP_EXPR, + fold (build1 (NOP_EXPR, TREE_TYPE (etype), expr)), TYPE_MIN_VALUE (etype)))); @@ -2864,7 +2951,6 @@ convert (tree type, tree expr) case ERROR_MARK: return expr; - case TRANSFORM_EXPR: case NULL_EXPR: /* Just set its type here. For TRANSFORM_EXPR, we will do the actual conversion in gnat_expand_expr. NULL_EXPR does not represent @@ -2959,6 +3045,9 @@ convert (tree type, tree expr) case VOID_TYPE: return build1 (CONVERT_EXPR, type, expr); + case BOOLEAN_TYPE: + return fold (build1 (NOP_EXPR, type, gnat_truthvalue_conversion (expr))); + case INTEGER_TYPE: if (TYPE_HAS_ACTUAL_BOUNDS_P (type) && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE @@ -3106,7 +3195,7 @@ remove_conversions (tree exp, int true_address) break; case VIEW_CONVERT_EXPR: case NON_LVALUE_EXPR: - case NOP_EXPR: case CONVERT_EXPR: case GNAT_NOP_EXPR: + case NOP_EXPR: case CONVERT_EXPR: return remove_conversions (TREE_OPERAND (exp, 0), true_address); default: @@ -3209,7 +3298,7 @@ unchecked_convert (tree type, tree expr, int notrunc_p) TYPE_BIASED_REPRESENTATION_P (ntype) = 0; TYPE_MAIN_VARIANT (ntype) = ntype; - expr = build1 (GNAT_NOP_EXPR, ntype, expr); + expr = build1 (NOP_EXPR, ntype, expr); } if (TREE_CODE (type) == INTEGER_TYPE @@ -3222,7 +3311,7 @@ unchecked_convert (tree type, tree expr, int notrunc_p) expr = convert (rtype, expr); if (type != rtype) - expr = build1 (GNAT_NOP_EXPR, type, expr); + expr = build1 (NOP_EXPR, type, expr); } /* If we are converting TO an integral type whose precision is not the diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index cafbf7d8fb0..ed9953103c0 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -29,6 +29,7 @@ #include "coretypes.h" #include "tm.h" #include "tree.h" +#include "rtl.h" #include "flags.h" #include "output.h" #include "ada.h" @@ -1345,23 +1346,20 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand) /* Similar, but for COND_EXPR. */ tree -build_cond_expr (tree result_type, - tree condition_operand, - tree true_operand, - tree false_operand) +build_cond_expr (tree result_type, tree condition_operand, + tree true_operand, tree false_operand) { tree result; int addr_p = 0; - /* Front-end verifies that result, true and false operands have same base - type. Convert everything to the result type. */ + /* The front-end verifies that result, true and false operands have same base + type. Convert everything to the result type. */ true_operand = convert (result_type, true_operand); false_operand = convert (result_type, false_operand); /* If the result type is unconstrained, take the address of the operands and then dereference our result. */ - if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type))) { @@ -1450,7 +1448,7 @@ tree build_call_raise (int msg) { tree fndecl = gnat_raise_decls[msg]; - const char *str = discard_file_names ? "" : ref_filename; + const char *str = Debug_Flag_NN ? "" : ref_filename; int len = strlen (str) + 1; tree filename = build_string (len, str); @@ -1743,7 +1741,11 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align, else if (gnu_obj) return build_call_1_expr (free_decl, gnu_obj); - else if (gnat_pool == -1) + + /* ??? For now, disable variable-sized allocators in the stack since + we can't yet gimplify an ALLOCATE_EXPR. */ + else if (gnat_pool == -1 + && TREE_CODE (gnu_size) == INTEGER_CST && !flag_stack_check) { /* If the size is a constant, we can put it in the fixed portion of the stack frame to avoid the need to adjust the stack pointer. */ @@ -1760,7 +1762,10 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align, build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl)); } else + abort (); +#if 0 return build (ALLOCATE_EXPR, ptr_void_type_node, gnu_size, gnu_align); +#endif } else { @@ -1977,7 +1982,6 @@ gnat_mark_addressable (tree expr_node) case VIEW_CONVERT_EXPR: case CONVERT_EXPR: case NON_LVALUE_EXPR: - case GNAT_NOP_EXPR: case NOP_EXPR: expr_node = TREE_OPERAND (expr_node, 0); break; @@ -1989,7 +1993,19 @@ gnat_mark_addressable (tree expr_node) case VAR_DECL: case PARM_DECL: case RESULT_DECL: - put_var_into_stack (expr_node, true); + /* If we have already made a REG for this decl, we must put it + directly into the stack. Likewise for a MEM whose address is a + pseudo. Otherwise, set a flag to mark us to do it later. */ + if (DECL_RTL_SET_P (expr_node) + && (GET_CODE (DECL_RTL (expr_node)) == REG + || (GET_CODE (DECL_RTL (expr_node)) == MEM + && GET_CODE (XEXP (DECL_RTL (expr_node), 0)) == REG + && (REGNO (XEXP (DECL_RTL (expr_node), 0)) + > LAST_VIRTUAL_REGISTER)))) + put_var_into_stack (expr_node, 1); + else + TREE_ADDRESSABLE (expr_node) = 1; + return true; case FUNCTION_DECL: -- 2.30.2