diff options
Diffstat (limited to 'gcc/ada/trans.c')
| -rw-r--r-- | gcc/ada/trans.c | 286 |
1 files changed, 199 insertions, 87 deletions
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index efa99fe0169..8b24761c3a5 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -104,6 +104,9 @@ Node_Id error_gnat_node; static GTY(()) tree gnu_return_label_stack; static tree tree_transform (Node_Id); +static rtx first_nondeleted_insn (rtx); +static tree build_block_stmt (List_Id); +static tree make_expr_stmt_from_rtl (rtx, Node_Id); static void elaborate_all_entities (Node_Id); static void process_freeze_entity (Node_Id); static void process_inlined_subprograms (Node_Id); @@ -255,15 +258,60 @@ 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 ()) + { + start_sequence (); + emit_note (NOTE_INSN_DELETED); + made_sequence = true; + } /* Save node number in case error */ error_gnat_node = gnat_node; gnu_root = tree_transform (gnat_node); - /* If we got no code as a result, something is wrong. */ - if (gnu_root == error_mark_node && ! type_annotate_only) - gigi_abort (303); + if (gnu_root == error_mark_node) + { + if (!made_sequence) + { + if (type_annotate_only) + return gnu_root; + else + gigi_abort (303); + } + + gnu_root = make_expr_stmt_from_rtl (first_nondeleted_insn (get_insns ()), + gnat_node); + end_sequence (); + } + else if (made_sequence) + { + rtx 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); + TREE_TYPE (gnu_root) = void_type_node; + TREE_SLOC (gnu_root) = Sloc (gnat_node); + } + else + emit_insn (insns); + } + } return gnu_root; } @@ -290,6 +338,10 @@ tree_transform (Node_Id gnat_node) /* 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. */ @@ -1795,7 +1847,7 @@ tree_transform (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Etype (gnat_node)); - if (RTL_EXPR_SEQUENCE (gnu_rhs_side) != 0) + if (first_nondeleted_insn (RTL_EXPR_SEQUENCE (gnu_rhs_side))) gnu_rhs = build (COMPOUND_EXPR, gnu_result_type, gnu_rhs_side, gnu_rhs); @@ -2020,31 +2072,17 @@ tree_transform (Node_Id gnat_node) /***************************/ case N_Label: - if (! type_annotate_only) - { - tree gnu_label = gnat_to_gnu (Identifier (gnat_node)); - Node_Id gnat_parent = Parent (gnat_node); - - expand_label (gnu_label); - - /* If this is the first label of an exception handler, we must - mark that any CALL_INSN can jump to it. */ - if (Present (gnat_parent) - && Nkind (gnat_parent) == N_Exception_Handler - && First (Statements (gnat_parent)) == gnat_node) - nonlocal_goto_handler_labels - = gen_rtx_EXPR_LIST (VOIDmode, label_rtx (gnu_label), - nonlocal_goto_handler_labels); - } + gnu_result = build_nt (LABEL_STMT, gnat_to_gnu (Identifier (gnat_node))); + LABEL_STMT_FIRST_IN_EH (gnu_result) + = (Present (Parent (gnat_node)) + && Nkind (Parent (gnat_node)) == N_Exception_Handler + && First (Statements (Parent (gnat_node))) == gnat_node); break; case N_Null_Statement: break; case N_Assignment_Statement: - if (type_annotate_only) - break; - /* Get the LHS and RHS of the statement and convert any reference to an unconstrained array into a reference to the underlying array. */ gnu_lhs = maybe_unconstrained_array (gnat_to_gnu (Name (gnat_node))); @@ -2071,53 +2109,28 @@ tree_transform (Node_Id gnat_node) break; case N_If_Statement: - /* Start an IF statement giving the condition. */ - gnu_expr = gnat_to_gnu (Condition (gnat_node)); - set_lineno (gnat_node, 1); - expand_start_cond (gnu_expr, 0); - - /* Generate code for the statements to be executed if the condition - is true. */ + gnu_result = NULL_TREE; - for (gnat_temp = First (Then_Statements (gnat_node)); - Present (gnat_temp); - gnat_temp = Next (gnat_temp)) - gnat_to_code (gnat_temp); - - /* Generate each of the "else if" parts. */ + /* Make an IF_STMT for each of the "else if" parts. */ if (Present (Elsif_Parts (gnat_node))) - { - for (gnat_temp = First (Elsif_Parts (gnat_node)); - Present (gnat_temp); - gnat_temp = Next (gnat_temp)) - { - Node_Id gnat_statement; - - expand_start_else (); - - /* Set up the line numbers for each condition we test. */ - set_lineno (Condition (gnat_temp), 1); - expand_elseif (gnat_to_gnu (Condition (gnat_temp))); - - for (gnat_statement = First (Then_Statements (gnat_temp)); - Present (gnat_statement); - gnat_statement = Next (gnat_statement)) - gnat_to_code (gnat_statement); - } - } - - /* Finally, handle any statements in the "else" part. */ - if (Present (Else_Statements (gnat_node))) - { - expand_start_else (); - - for (gnat_temp = First (Else_Statements (gnat_node)); - Present (gnat_temp); - gnat_temp = Next (gnat_temp)) - gnat_to_code (gnat_temp); - } + for (gnat_temp = First (Elsif_Parts (gnat_node)); + Present (gnat_temp); gnat_temp = Next (gnat_temp)) + { + tree gnu_elseif + = build_nt (IF_STMT, gnat_to_gnu (Condition (gnat_temp)), + build_block_stmt (Then_Statements (gnat_temp)), + NULL_TREE, NULL_TREE); + + TREE_SLOC (gnu_elseif) = Sloc (Condition (gnat_temp)); + TREE_CHAIN (gnu_elseif) = gnu_result; + TREE_TYPE (gnu_elseif) = void_type_node; + gnu_result = gnu_elseif; + } - expand_end_cond (); + gnu_result = build_nt (IF_STMT, gnat_to_gnu (Condition (gnat_node)), + build_block_stmt (Then_Statements (gnat_node)), + nreverse (gnu_result), + build_block_stmt (Else_Statements (gnat_node))); break; case N_Case_Statement: @@ -2456,9 +2469,6 @@ tree_transform (Node_Id gnat_node) break; case N_Return_Statement: - if (type_annotate_only) - break; - { /* The gnu function type of the subprogram currently processed. */ tree gnu_subprog_type = TREE_TYPE (current_function_decl); @@ -2478,7 +2488,11 @@ tree_transform (Node_Id gnat_node) a branch to that label. */ if (TREE_VALUE (gnu_return_label_stack) != 0) - expand_goto (TREE_VALUE (gnu_return_label_stack)); + { + gnu_result = build_nt (GOTO_STMT, + TREE_VALUE (gnu_return_label_stack)); + break; + } else if (TYPE_CI_CO_LIST (gnu_subprog_type) != NULL_TREE) { @@ -2538,25 +2552,12 @@ tree_transform (Node_Id gnat_node) } } - set_lineno (gnat_node, 1); - if (gnu_ret_val) - expand_return (build_binary_op (MODIFY_EXPR, NULL_TREE, - DECL_RESULT (current_function_decl), - gnu_ret_val)); - else - expand_null_return (); - + gnu_result = build_nt (RETURN_STMT, gnu_ret_val); } break; case N_Goto_Statement: - if (type_annotate_only) - break; - - gnu_expr = gnat_to_gnu (Name (gnat_node)); - TREE_USED (gnu_expr) = 1; - set_lineno (gnat_node, 1); - expand_goto (gnu_expr); + gnu_result = build_nt (GOTO_STMT, gnat_to_gnu (Name (gnat_node))); break; /****************************/ @@ -4174,12 +4175,70 @@ 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. */ + +static rtx +first_nondeleted_insn (rtx insns) +{ + for (; insns && GET_CODE (insns) == NOTE + && NOTE_LINE_NUMBER (insns) == NOTE_INSN_DELETED; + insns = NEXT_INSN (insns)) + ; + + return insns; +} + +/* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements. */ + +static tree +build_block_stmt (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; + + for (gnat_node = First (gnat_list); + Present (gnat_node); + gnat_node = Next (gnat_node)) + gnu_result = chainon (gnat_to_gnu (gnat_node), gnu_result); + + gnu_result = build_nt (BLOCK_STMT, nreverse (gnu_result)); + TREE_SLOC (gnu_result) = TREE_SLOC (BLOCK_STMT_LIST (gnu_result)); + TREE_TYPE (gnu_result) = void_type_node; + return gnu_result; +} + +/* Build an EXPR_STMT to evaluate INSNS. Use Sloc from GNAT_NODE. */ + +static tree +make_expr_stmt_from_rtl (rtx insns, Node_Id gnat_node) +{ + tree gnu_result = make_node (RTL_EXPR); + + 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); + + gnu_result = build_nt (EXPR_STMT, gnu_result); + TREE_SLOC (gnu_result) = Sloc (gnat_node); + TREE_TYPE (gnu_result) = void_type_node; + + return gnu_result; +} + /* GNU_STMT is a statement. We generate code for that statement. */ void gnat_expand_stmt (tree gnu_stmt) { - set_lineno_from_sloc (TREE_SLOC (gnu_stmt), 1); + tree gnu_elmt; + + if (TREE_SLOC (gnu_stmt)) + set_lineno_from_sloc (TREE_SLOC (gnu_stmt), 1); switch (TREE_CODE (gnu_stmt)) { @@ -4187,6 +4246,59 @@ gnat_expand_stmt (tree gnu_stmt) expand_expr_stmt (EXPR_STMT_EXPR (gnu_stmt)); break; + case BLOCK_STMT: + for (gnu_elmt = BLOCK_STMT_LIST (gnu_stmt); gnu_elmt; + gnu_elmt = TREE_CHAIN (gnu_elmt)) + expand_expr_stmt (gnu_elmt); + break; + + case IF_STMT: + expand_start_cond (IF_STMT_COND (gnu_stmt), 0); + + if (IF_STMT_TRUE (gnu_stmt)) + expand_expr_stmt (IF_STMT_TRUE (gnu_stmt)); + + 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)); + expand_expr_stmt (IF_STMT_TRUE (gnu_elmt)); + } + + if (IF_STMT_ELSE (gnu_stmt)) + { + expand_start_else (); + expand_expr_stmt (IF_STMT_ELSE (gnu_stmt)); + } + + expand_end_cond (); + break; + + case GOTO_STMT: + TREE_USED (GOTO_STMT_LABEL (gnu_stmt)) = 1; + expand_goto (GOTO_STMT_LABEL (gnu_stmt)); + break; + + case LABEL_STMT: + expand_label (LABEL_STMT_LABEL (gnu_stmt)); + if (LABEL_STMT_FIRST_IN_EH (gnu_stmt)) + nonlocal_goto_handler_labels + = gen_rtx_EXPR_LIST (VOIDmode, + label_rtx (LABEL_STMT_LABEL (gnu_stmt)), + nonlocal_goto_handler_labels); + break; + + 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; + default: abort (); } |