static void add_expr_to_chain (tree* chain, tree expr, bool front) { if (expr == NULL_TREE || IS_EMPTY_STMT (expr)) return; if (*chain) { if (TREE_CODE (*chain) != STATEMENT_LIST) { tree tmp; tmp = *chain; *chain = NULL_TREE; append_to_statement_list (tmp, chain); } if (front) { tree_stmt_iterator i; i = tsi_start (*chain); tsi_link_before (&i, expr, TSI_CONTINUE_LINKING); } else append_to_statement_list (expr, chain); } else *chain = expr; }
static void gimplify_expr_stmt (tree *stmt_p) { tree stmt = EXPR_STMT_EXPR (*stmt_p); if (stmt == error_mark_node) stmt = NULL; /* Gimplification of a statement expression will nullify the statement if all its side effects are moved to *PRE_P and *POST_P. In this case we will not want to emit the gimplified statement. However, we may still want to emit a warning, so we do that before gimplification. */ if (stmt && (extra_warnings || warn_unused_value)) { if (!TREE_SIDE_EFFECTS (stmt)) { if (!IS_EMPTY_STMT (stmt) && !VOID_TYPE_P (TREE_TYPE (stmt)) && !TREE_NO_WARNING (stmt)) warning (0, "statement with no effect"); } else if (warn_unused_value) warn_if_unused_value (stmt, input_location); } if (stmt == NULL_TREE) stmt = alloc_stmt_list (); *stmt_p = stmt; }
static tree gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses) { stmtblock_t block, body; tree omp_clauses, stmt; bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL; gfc_start_block (&block); omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc); gfc_init_block (&body); for (code = code->block; code; code = code->block) { /* Last section is special because of lastprivate, so even if it is empty, chain it in. */ stmt = gfc_trans_omp_code (code->next, has_lastprivate && code->block == NULL); if (! IS_EMPTY_STMT (stmt)) { stmt = build1_v (OMP_SECTION, stmt); gfc_add_expr_to_block (&body, stmt); } } stmt = gfc_finish_block (&body); stmt = build2_v (OMP_SECTIONS, stmt, omp_clauses); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); }
static tree gfc_trans_omp_master (gfc_code *code) { tree stmt = gfc_trans_code (code->block->next); if (IS_EMPTY_STMT (stmt)) return stmt; return build1_v (OMP_MASTER, stmt); }
bool is_gimple_stmt (tree t) { enum tree_code code = TREE_CODE (t); switch (code) { case NOP_EXPR: /* The only valid NOP_EXPR is the empty statement. */ return IS_EMPTY_STMT (t); case BIND_EXPR: case COND_EXPR: /* These are only valid if they're void. */ return TREE_TYPE (t) == NULL || VOID_TYPE_P (TREE_TYPE (t)); case SWITCH_EXPR: case GOTO_EXPR: case RETURN_EXPR: case LABEL_EXPR: case CASE_LABEL_EXPR: case TRY_CATCH_EXPR: case TRY_FINALLY_EXPR: case EH_FILTER_EXPR: case CATCH_EXPR: case ASM_EXPR: case RESX_EXPR: case PHI_NODE: case STATEMENT_LIST: case OMP_PARALLEL: case OMP_FOR: case OMP_SECTIONS: case OMP_SECTION: case OMP_SINGLE: case OMP_MASTER: case OMP_ORDERED: case OMP_CRITICAL: case OMP_RETURN: case OMP_CONTINUE: /* These are always void. */ return true; case CALL_EXPR: case MODIFY_EXPR: /* These are valid regardless of their type. */ return true; default: return false; } }
/* Return TRUE if block BB has no executable statements, otherwise return FALSE. */ bool empty_block_p (basic_block bb) { block_stmt_iterator bsi; /* BB must have no executable statements. */ bsi = bsi_start (bb); while (!bsi_end_p (bsi) && (TREE_CODE (bsi_stmt (bsi)) == LABEL_EXPR || IS_EMPTY_STMT (bsi_stmt (bsi)))) bsi_next (&bsi); if (!bsi_end_p (bsi)) return false; return true; }
static tree gfc_trans_omp_code (gfc_code *code, bool force_empty) { tree stmt; pushlevel (0); stmt = gfc_trans_code (code); if (TREE_CODE (stmt) != BIND_EXPR) { if (!IS_EMPTY_STMT (stmt) || force_empty) { tree block = poplevel (1, 0, 0); stmt = build3_v (BIND_EXPR, NULL, stmt, block); } else poplevel (0, 0, 0); } else poplevel (0, 0, 0); return stmt; }
bool is_gimple_stmt (tree t) { enum tree_code code = TREE_CODE (t); if (IS_EMPTY_STMT (t)) return 1; switch (code) { case BIND_EXPR: case COND_EXPR: /* These are only valid if they're void. */ return TREE_TYPE (t) == NULL || VOID_TYPE_P (TREE_TYPE (t)); case SWITCH_EXPR: case GOTO_EXPR: case RETURN_EXPR: case LABEL_EXPR: case CASE_LABEL_EXPR: case TRY_CATCH_EXPR: case TRY_FINALLY_EXPR: case EH_FILTER_EXPR: case CATCH_EXPR: case ASM_EXPR: case RESX_EXPR: case PHI_NODE: case STATEMENT_LIST: /* These are always void. */ return true; case CALL_EXPR: case MODIFY_EXPR: /* These are valid regardless of their type. */ return true; default: return false; } }
void gfc_add_expr_to_block (stmtblock_t * block, tree expr) { gcc_assert (block); if (expr == NULL_TREE || IS_EMPTY_STMT (expr)) return; if (block->head) { if (TREE_CODE (block->head) != STATEMENT_LIST) { tree tmp; tmp = block->head; block->head = NULL_TREE; append_to_statement_list (tmp, &block->head); } append_to_statement_list (expr, &block->head); } else /* Don't bother creating a list if we only have a single statement. */ block->head = expr; }
static bool verify_use (basic_block bb, basic_block def_bb, use_operand_p use_p, tree stmt, bool check_abnormal, bool is_virtual, bitmap names_defined_in_bb) { bool err = false; tree ssa_name = USE_FROM_PTR (use_p); err = verify_ssa_name (ssa_name, is_virtual); if (!TREE_VISITED (ssa_name)) if (verify_imm_links (stderr, ssa_name)) err = true; TREE_VISITED (ssa_name) = 1; if (IS_EMPTY_STMT (SSA_NAME_DEF_STMT (ssa_name)) && default_def (SSA_NAME_VAR (ssa_name)) == ssa_name) ; /* Default definitions have empty statements. Nothing to do. */ else if (!def_bb) { error ("missing definition"); err = true; } else if (bb != def_bb && !dominated_by_p (CDI_DOMINATORS, bb, def_bb)) { error ("definition in block %i does not dominate use in block %i", def_bb->index, bb->index); err = true; } else if (bb == def_bb && names_defined_in_bb != NULL && !bitmap_bit_p (names_defined_in_bb, SSA_NAME_VERSION (ssa_name))) { error ("definition in block %i follows the use", def_bb->index); err = true; } if (check_abnormal && !SSA_NAME_OCCURS_IN_ABNORMAL_PHI (ssa_name)) { error ("SSA_NAME_OCCURS_IN_ABNORMAL_PHI should be set"); err = true; } /* Make sure the use is in an appropriate list by checking the previous element to make sure it's the same. */ if (use_p->prev == NULL) { error ("no immediate_use list"); err = true; } else { tree listvar ; if (use_p->prev->use == NULL) listvar = use_p->prev->stmt; else listvar = USE_FROM_PTR (use_p->prev); if (listvar != ssa_name) { error ("wrong immediate use list"); err = true; } } if (err) { fprintf (stderr, "for SSA_NAME: "); print_generic_expr (stderr, ssa_name, TDF_VOPS); fprintf (stderr, " in statement:\n"); print_generic_stmt (stderr, stmt, TDF_VOPS); } return err; }
tree gfc_trans_code (gfc_code * code) { stmtblock_t block; tree res; if (!code) return build_empty_stmt (); gfc_start_block (&block); /* Translate statements one by one to GIMPLE trees until we reach the end of this gfc_code branch. */ for (; code; code = code->next) { if (code->here != 0) { res = gfc_trans_label_here (code); gfc_add_expr_to_block (&block, res); } switch (code->op) { case EXEC_NOP: res = NULL_TREE; break; case EXEC_ASSIGN: res = gfc_trans_assign (code); break; case EXEC_LABEL_ASSIGN: res = gfc_trans_label_assign (code); break; case EXEC_POINTER_ASSIGN: res = gfc_trans_pointer_assign (code); break; case EXEC_INIT_ASSIGN: res = gfc_trans_init_assign (code); break; case EXEC_CONTINUE: res = NULL_TREE; break; case EXEC_CYCLE: res = gfc_trans_cycle (code); break; case EXEC_EXIT: res = gfc_trans_exit (code); break; case EXEC_GOTO: res = gfc_trans_goto (code); break; case EXEC_ENTRY: res = gfc_trans_entry (code); break; case EXEC_PAUSE: res = gfc_trans_pause (code); break; case EXEC_STOP: res = gfc_trans_stop (code); break; case EXEC_CALL: res = gfc_trans_call (code, false); break; case EXEC_ASSIGN_CALL: res = gfc_trans_call (code, true); break; case EXEC_RETURN: res = gfc_trans_return (code); break; case EXEC_IF: res = gfc_trans_if (code); break; case EXEC_ARITHMETIC_IF: res = gfc_trans_arithmetic_if (code); break; case EXEC_DO: res = gfc_trans_do (code); break; case EXEC_DO_WHILE: res = gfc_trans_do_while (code); break; case EXEC_SELECT: res = gfc_trans_select (code); break; case EXEC_FLUSH: res = gfc_trans_flush (code); break; case EXEC_FORALL: res = gfc_trans_forall (code); break; case EXEC_WHERE: res = gfc_trans_where (code); break; case EXEC_ALLOCATE: res = gfc_trans_allocate (code); break; case EXEC_DEALLOCATE: res = gfc_trans_deallocate (code); break; case EXEC_OPEN: res = gfc_trans_open (code); break; case EXEC_CLOSE: res = gfc_trans_close (code); break; case EXEC_READ: res = gfc_trans_read (code); break; case EXEC_WRITE: res = gfc_trans_write (code); break; case EXEC_IOLENGTH: res = gfc_trans_iolength (code); break; case EXEC_BACKSPACE: res = gfc_trans_backspace (code); break; case EXEC_ENDFILE: res = gfc_trans_endfile (code); break; case EXEC_INQUIRE: res = gfc_trans_inquire (code); break; case EXEC_REWIND: res = gfc_trans_rewind (code); break; case EXEC_TRANSFER: res = gfc_trans_transfer (code); break; case EXEC_DT_END: res = gfc_trans_dt_end (code); break; case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_DO: case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: res = gfc_trans_omp_directive (code); break; default: internal_error ("gfc_trans_code(): Bad statement code"); } gfc_set_backend_locus (&code->loc); if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { if (TREE_CODE (res) == STATEMENT_LIST) annotate_all_with_locus (&res, input_location); else SET_EXPR_LOCATION (res, input_location); /* Add the new statement to the block. */ gfc_add_expr_to_block (&block, res); } } /* Return the finished block. */ return gfc_finish_block (&block); }
static tree trans_code (gfc_code * code, tree cond) { stmtblock_t block; tree res; if (!code) return build_empty_stmt (input_location); gfc_start_block (&block); /* Translate statements one by one into GENERIC trees until we reach the end of this gfc_code branch. */ for (; code; code = code->next) { if (code->here != 0) { res = gfc_trans_label_here (code); gfc_add_expr_to_block (&block, res); } gfc_set_backend_locus (&code->loc); switch (code->op) { case EXEC_NOP: case EXEC_END_BLOCK: case EXEC_END_NESTED_BLOCK: case EXEC_END_PROCEDURE: res = NULL_TREE; break; case EXEC_ASSIGN: if (code->expr1->ts.type == BT_CLASS) res = gfc_trans_class_assign (code->expr1, code->expr2, code->op); else res = gfc_trans_assign (code); break; case EXEC_LABEL_ASSIGN: res = gfc_trans_label_assign (code); break; case EXEC_POINTER_ASSIGN: if (code->expr1->ts.type == BT_CLASS) res = gfc_trans_class_assign (code->expr1, code->expr2, code->op); else res = gfc_trans_pointer_assign (code); break; case EXEC_INIT_ASSIGN: if (code->expr1->ts.type == BT_CLASS) res = gfc_trans_class_init_assign (code); else res = gfc_trans_init_assign (code); break; case EXEC_CONTINUE: res = NULL_TREE; break; case EXEC_CRITICAL: res = gfc_trans_critical (code); break; case EXEC_CYCLE: res = gfc_trans_cycle (code); break; case EXEC_EXIT: res = gfc_trans_exit (code); break; case EXEC_GOTO: res = gfc_trans_goto (code); break; case EXEC_ENTRY: res = gfc_trans_entry (code); break; case EXEC_PAUSE: res = gfc_trans_pause (code); break; case EXEC_STOP: case EXEC_ERROR_STOP: res = gfc_trans_stop (code, code->op == EXEC_ERROR_STOP); break; case EXEC_CALL: /* For MVBITS we've got the special exception that we need a dependency check, too. */ { bool is_mvbits = false; if (code->resolved_isym) { res = gfc_conv_intrinsic_subroutine (code); if (res != NULL_TREE) break; } if (code->resolved_isym && code->resolved_isym->id == GFC_ISYM_MVBITS) is_mvbits = true; res = gfc_trans_call (code, is_mvbits, NULL_TREE, NULL_TREE, false); } break; case EXEC_CALL_PPC: res = gfc_trans_call (code, false, NULL_TREE, NULL_TREE, false); break; case EXEC_ASSIGN_CALL: res = gfc_trans_call (code, true, NULL_TREE, NULL_TREE, false); break; case EXEC_RETURN: res = gfc_trans_return (code); break; case EXEC_IF: res = gfc_trans_if (code); break; case EXEC_ARITHMETIC_IF: res = gfc_trans_arithmetic_if (code); break; case EXEC_BLOCK: res = gfc_trans_block_construct (code); break; case EXEC_DO: res = gfc_trans_do (code, cond); break; case EXEC_DO_CONCURRENT: res = gfc_trans_do_concurrent (code); break; case EXEC_DO_WHILE: res = gfc_trans_do_while (code); break; case EXEC_SELECT: res = gfc_trans_select (code); break; case EXEC_SELECT_TYPE: /* Do nothing. SELECT TYPE statements should be transformed into an ordinary SELECT CASE at resolution stage. TODO: Add an error message here once this is done. */ res = NULL_TREE; break; case EXEC_FLUSH: res = gfc_trans_flush (code); break; case EXEC_SYNC_ALL: case EXEC_SYNC_IMAGES: case EXEC_SYNC_MEMORY: res = gfc_trans_sync (code, code->op); break; case EXEC_LOCK: case EXEC_UNLOCK: res = gfc_trans_lock_unlock (code, code->op); break; case EXEC_FORALL: res = gfc_trans_forall (code); break; case EXEC_WHERE: res = gfc_trans_where (code); break; case EXEC_ALLOCATE: res = gfc_trans_allocate (code); break; case EXEC_DEALLOCATE: res = gfc_trans_deallocate (code); break; case EXEC_OPEN: res = gfc_trans_open (code); break; case EXEC_CLOSE: res = gfc_trans_close (code); break; case EXEC_READ: res = gfc_trans_read (code); break; case EXEC_WRITE: res = gfc_trans_write (code); break; case EXEC_IOLENGTH: res = gfc_trans_iolength (code); break; case EXEC_BACKSPACE: res = gfc_trans_backspace (code); break; case EXEC_ENDFILE: res = gfc_trans_endfile (code); break; case EXEC_INQUIRE: res = gfc_trans_inquire (code); break; case EXEC_WAIT: res = gfc_trans_wait (code); break; case EXEC_REWIND: res = gfc_trans_rewind (code); break; case EXEC_TRANSFER: res = gfc_trans_transfer (code); break; case EXEC_DT_END: res = gfc_trans_dt_end (code); break; case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_DO: case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: res = gfc_trans_omp_directive (code); break; default: internal_error ("gfc_trans_code(): Bad statement code"); } gfc_set_backend_locus (&code->loc); if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { if (TREE_CODE (res) != STATEMENT_LIST) SET_EXPR_LOCATION (res, input_location); /* Add the new statement to the block. */ gfc_add_expr_to_block (&block, res); } } /* Return the finished block. */ return gfc_finish_block (&block); }
static basic_block expand_gimple_cond_expr (basic_block bb, tree stmt) { basic_block new_bb, dest; edge new_edge; edge true_edge; edge false_edge; tree pred = COND_EXPR_COND (stmt); tree then_exp = COND_EXPR_THEN (stmt); tree else_exp = COND_EXPR_ELSE (stmt); rtx last2, last; last2 = last = get_last_insn (); extract_true_false_edges_from_block (bb, &true_edge, &false_edge); if (EXPR_LOCUS (stmt)) { emit_line_note (*(EXPR_LOCUS (stmt))); record_block_change (TREE_BLOCK (stmt)); } /* These flags have no purpose in RTL land. */ true_edge->flags &= ~EDGE_TRUE_VALUE; false_edge->flags &= ~EDGE_FALSE_VALUE; /* We can either have a pure conditional jump with one fallthru edge or two-way jump that needs to be decomposed into two basic blocks. */ if (TREE_CODE (then_exp) == GOTO_EXPR && IS_EMPTY_STMT (else_exp)) { jumpif (pred, label_rtx (GOTO_DESTINATION (then_exp))); add_reg_br_prob_note (dump_file, last, true_edge->probability); maybe_dump_rtl_for_tree_stmt (stmt, last); if (EXPR_LOCUS (then_exp)) emit_line_note (*(EXPR_LOCUS (then_exp))); return NULL; } if (TREE_CODE (else_exp) == GOTO_EXPR && IS_EMPTY_STMT (then_exp)) { jumpifnot (pred, label_rtx (GOTO_DESTINATION (else_exp))); add_reg_br_prob_note (dump_file, last, false_edge->probability); maybe_dump_rtl_for_tree_stmt (stmt, last); if (EXPR_LOCUS (else_exp)) emit_line_note (*(EXPR_LOCUS (else_exp))); return NULL; } gcc_assert (TREE_CODE (then_exp) == GOTO_EXPR && TREE_CODE (else_exp) == GOTO_EXPR); jumpif (pred, label_rtx (GOTO_DESTINATION (then_exp))); add_reg_br_prob_note (dump_file, last, true_edge->probability); last = get_last_insn (); expand_expr (else_exp, const0_rtx, VOIDmode, 0); BB_END (bb) = last; if (BARRIER_P (BB_END (bb))) BB_END (bb) = PREV_INSN (BB_END (bb)); update_bb_for_insn (bb); new_bb = create_basic_block (NEXT_INSN (last), get_last_insn (), bb); dest = false_edge->dest; redirect_edge_succ (false_edge, new_bb); false_edge->flags |= EDGE_FALLTHRU; new_bb->count = false_edge->count; new_bb->frequency = EDGE_FREQUENCY (false_edge); new_edge = make_edge (new_bb, dest, 0); new_edge->probability = REG_BR_PROB_BASE; new_edge->count = new_bb->count; if (BARRIER_P (BB_END (new_bb))) BB_END (new_bb) = PREV_INSN (BB_END (new_bb)); update_bb_for_insn (new_bb); maybe_dump_rtl_for_tree_stmt (stmt, last2); if (EXPR_LOCUS (else_exp)) emit_line_note (*(EXPR_LOCUS (else_exp))); return new_bb; }
static void check_init (tree exp, words before) { tree tmp; again: switch (TREE_CODE (exp)) { case VAR_DECL: case PARM_DECL: if (! FIELD_STATIC (exp) && DECL_NAME (exp) != NULL_TREE && DECL_NAME (exp) != this_identifier_node) { int index = DECL_BIT_INDEX (exp); /* We don't want to report and mark as non-initialized class initialization flags. */ if (! LOCAL_CLASS_INITIALIZATION_FLAG_P (exp) && index >= 0 && ! ASSIGNED_P (before, index)) { parse_error_context (wfl, "Variable %qs may not have been initialized", IDENTIFIER_POINTER (DECL_NAME (exp))); /* Suppress further errors. */ DECL_BIT_INDEX (exp) = -2; } } break; case COMPONENT_REF: check_init (TREE_OPERAND (exp, 0), before); if ((tmp = get_variable_decl (exp)) != NULL_TREE) { int index = DECL_BIT_INDEX (tmp); if (index >= 0 && ! ASSIGNED_P (before, index)) { parse_error_context (wfl, "variable %qs may not have been initialized", IDENTIFIER_POINTER (DECL_NAME (tmp))); /* Suppress further errors. */ DECL_BIT_INDEX (tmp) = -2; } } break; case MODIFY_EXPR: tmp = TREE_OPERAND (exp, 0); /* We're interested in variable declaration and parameter declaration when they're declared with the `final' modifier. */ if ((tmp = get_variable_decl (tmp)) != NULL_TREE) { int index; check_init (TREE_OPERAND (exp, 1), before); check_final_reassigned (tmp, before); index = DECL_BIT_INDEX (tmp); if (index >= 0) { SET_ASSIGNED (before, index); CLEAR_UNASSIGNED (before, index); } /* Minor optimization. See comment for start_current_locals. If we're optimizing for class initialization, we keep this information to check whether the variable is definitely assigned when once we checked the whole function. */ if (! STATIC_CLASS_INIT_OPT_P () /* FIXME */ && ! DECL_FINAL (tmp) && index >= start_current_locals && index == num_current_locals - 1) { num_current_locals--; DECL_BIT_INDEX (tmp) = -1; } break; } else if (TREE_CODE (tmp = TREE_OPERAND (exp, 0)) == COMPONENT_REF) { tree decl; check_init (tmp, before); check_init (TREE_OPERAND (exp, 1), before); decl = TREE_OPERAND (tmp, 1); if (DECL_FINAL (decl)) final_assign_error (DECL_NAME (decl)); break; } else if (TREE_CODE (tmp) == COMPONENT_REF && IS_ARRAY_LENGTH_ACCESS (tmp)) { /* We can't emit a more specific message here, because when compiling to bytecodes we don't get here. */ final_assign_error (length_identifier_node); } else goto binop; case BLOCK: if (BLOCK_EXPR_BODY (exp)) { tree decl = BLOCK_EXPR_DECLS (exp); int words_needed; word* tmp; int i; int save_start_current_locals = start_current_locals; int save_num_current_words = num_current_words; start_current_locals = num_current_locals; for (; decl != NULL_TREE; decl = TREE_CHAIN (decl)) { DECL_BIT_INDEX (decl) = num_current_locals++; } words_needed = WORDS_NEEDED (2 * num_current_locals); if (words_needed > num_current_words) { tmp = ALLOC_WORDS (words_needed); COPY (tmp, before); num_current_words = words_needed; } else tmp = before; for (i = start_current_locals; i < num_current_locals; i++) { CLEAR_ASSIGNED (tmp, i); SET_UNASSIGNED (tmp, i); } check_init (BLOCK_EXPR_BODY (exp), tmp); /* Re-set DECL_BIT_INDEX since it is also DECL_POINTER_ALIAS_SET. */ for (decl = BLOCK_EXPR_DECLS (exp); decl != NULL_TREE; decl = TREE_CHAIN (decl)) { if (LOCAL_CLASS_INITIALIZATION_FLAG_P (decl)) { int index = DECL_BIT_INDEX (decl); tree fndecl = DECL_CONTEXT (decl); if (fndecl && METHOD_STATIC (fndecl) && (DECL_INITIAL (decl) == boolean_true_node || (index >= 0 && ASSIGNED_P (tmp, index)))) *(htab_find_slot (DECL_FUNCTION_INITIALIZED_CLASS_TABLE (fndecl), DECL_FUNCTION_INIT_TEST_CLASS (decl), INSERT)) = DECL_FUNCTION_INIT_TEST_CLASS (decl); } DECL_BIT_INDEX (decl) = -1; } num_current_locals = start_current_locals; start_current_locals = save_start_current_locals; if (tmp != before) { num_current_words = save_num_current_words; COPY (before, tmp); FREE_WORDS (tmp); } } break; case LOOP_EXPR: { /* The JLS 2nd edition discusses a complication determining definite unassignment of loop statements. They define a "hypothetical" analysis model. We do something much simpler: We just disallow assignments inside loops to final variables declared outside the loop. This means we may disallow some contrived assignments that the JLS allows, but I can't see how anything except a very contrived testcase (a do-while whose condition is false?) would care. */ struct alternatives alt; int save_loop_current_locals = loop_current_locals; int save_start_current_locals = start_current_locals; loop_current_locals = num_current_locals; start_current_locals = num_current_locals; BEGIN_ALTERNATIVES (before, alt); alt.block = exp; check_init (TREE_OPERAND (exp, 0), before); END_ALTERNATIVES (before, alt); loop_current_locals = save_loop_current_locals; start_current_locals = save_start_current_locals; return; } case EXIT_EXPR: { struct alternatives *alt = alternatives; DECLARE_BUFFERS(when_true, 2); words when_false = when_true + num_current_words; #ifdef ENABLE_JC1_CHECKING if (TREE_CODE (alt->block) != LOOP_EXPR) abort (); #endif check_bool_init (TREE_OPERAND (exp, 0), before, when_false, when_true); done_alternative (when_true, alt); COPY (before, when_false); RELEASE_BUFFERS(when_true); return; } case LABELED_BLOCK_EXPR: { struct alternatives alt; BEGIN_ALTERNATIVES (before, alt); alt.block = exp; if (LABELED_BLOCK_BODY (exp)) check_init (LABELED_BLOCK_BODY (exp), before); done_alternative (before, &alt); END_ALTERNATIVES (before, alt); return; } case EXIT_BLOCK_EXPR: { tree block = TREE_OPERAND (exp, 0); struct alternatives *alt = alternatives; while (alt->block != block) alt = alt->outer; done_alternative (before, alt); SET_ALL (before); return; } case SWITCH_EXPR: { struct alternatives alt; word buf[2]; check_init (TREE_OPERAND (exp, 0), before); BEGIN_ALTERNATIVES (before, alt); alt.saved = ALLOC_BUFFER(buf, num_current_words); COPY (alt.saved, before); alt.block = exp; check_init (TREE_OPERAND (exp, 1), before); done_alternative (before, &alt); if (! SWITCH_HAS_DEFAULT (exp)) done_alternative (alt.saved, &alt); FREE_BUFFER(alt.saved, buf); END_ALTERNATIVES (before, alt); return; } case CASE_EXPR: case DEFAULT_EXPR: { int i; struct alternatives *alt = alternatives; while (TREE_CODE (alt->block) != SWITCH_EXPR) alt = alt->outer; COPYN (before, alt->saved, WORDS_NEEDED (2 * alt->num_locals)); for (i = alt->num_locals; i < num_current_locals; i++) CLEAR_ASSIGNED (before, i); break; } case TRY_EXPR: { tree try_clause = TREE_OPERAND (exp, 0); tree clause = TREE_OPERAND (exp, 1); word buf[2*2]; words tmp = (num_current_words <= 2 ? buf : ALLOC_WORDS (2 * num_current_words)); words save = tmp + num_current_words; struct alternatives alt; BEGIN_ALTERNATIVES (before, alt); COPY (save, before); COPY (tmp, save); check_init (try_clause, tmp); done_alternative (tmp, &alt); for ( ; clause != NULL_TREE; clause = TREE_CHAIN (clause)) { tree catch_clause = TREE_OPERAND (clause, 0); COPY (tmp, save); check_init (catch_clause, tmp); done_alternative (tmp, &alt); } if (tmp != buf) { FREE_WORDS (tmp); } END_ALTERNATIVES (before, alt); } return; case TRY_FINALLY_EXPR: { DECLARE_BUFFERS(tmp, 1); COPY (tmp, before); check_init (TREE_OPERAND (exp, 0), before); check_init (TREE_OPERAND (exp, 1), tmp); UNION (before, before, tmp); RELEASE_BUFFERS(tmp); } return; case RETURN_EXPR: case THROW_EXPR: if (TREE_OPERAND (exp, 0)) check_init (TREE_OPERAND (exp, 0), before); goto never_continues; case ERROR_MARK: never_continues: SET_ALL (before); return; case COND_EXPR: case TRUTH_ANDIF_EXPR: case TRUTH_ORIF_EXPR: { DECLARE_BUFFERS(when_true, 2); words when_false = when_true + num_current_words; check_bool_init (exp, before, when_false, when_true); INTERSECT (before, when_false, when_true); RELEASE_BUFFERS(when_true); } break; case NOP_EXPR: if (IS_EMPTY_STMT (exp)) break; /* ... else fall through ... */ case UNARY_PLUS_EXPR: case NEGATE_EXPR: case TRUTH_AND_EXPR: case TRUTH_OR_EXPR: case TRUTH_XOR_EXPR: case TRUTH_NOT_EXPR: case BIT_NOT_EXPR: case CONVERT_EXPR: case BIT_FIELD_REF: case FLOAT_EXPR: case FIX_TRUNC_EXPR: case INDIRECT_REF: case ADDR_EXPR: case NON_LVALUE_EXPR: case INSTANCEOF_EXPR: case FIX_CEIL_EXPR: case FIX_FLOOR_EXPR: case FIX_ROUND_EXPR: case ABS_EXPR: /* Avoid needless recursion. */ exp = TREE_OPERAND (exp, 0); goto again; case PREDECREMENT_EXPR: case PREINCREMENT_EXPR: case POSTDECREMENT_EXPR: case POSTINCREMENT_EXPR: tmp = get_variable_decl (TREE_OPERAND (exp, 0)); if (tmp != NULL_TREE && DECL_FINAL (tmp)) final_assign_error (DECL_NAME (tmp)); /* Avoid needless recursion. */ exp = TREE_OPERAND (exp, 0); goto again; case SAVE_EXPR: if (IS_INIT_CHECKED (exp)) return; IS_INIT_CHECKED (exp) = 1; exp = TREE_OPERAND (exp, 0); goto again; case COMPOUND_EXPR: case PLUS_EXPR: case MINUS_EXPR: case MULT_EXPR: case TRUNC_DIV_EXPR: case TRUNC_MOD_EXPR: case RDIV_EXPR: case LSHIFT_EXPR: case RSHIFT_EXPR: case URSHIFT_EXPR: case BIT_AND_EXPR: case BIT_XOR_EXPR: case BIT_IOR_EXPR: case EQ_EXPR: case NE_EXPR: case GT_EXPR: case GE_EXPR: case LT_EXPR: case LE_EXPR: case MAX_EXPR: case MIN_EXPR: case ARRAY_REF: case LROTATE_EXPR: case RROTATE_EXPR: case CEIL_DIV_EXPR: case FLOOR_DIV_EXPR: case ROUND_DIV_EXPR: case CEIL_MOD_EXPR: case FLOOR_MOD_EXPR: case ROUND_MOD_EXPR: case EXACT_DIV_EXPR: case UNLT_EXPR: case UNLE_EXPR: case UNGT_EXPR: case UNGE_EXPR: case UNEQ_EXPR: case LTGT_EXPR: binop: check_init (TREE_OPERAND (exp, 0), before); /* Avoid needless recursion, especially for COMPOUND_EXPR. */ exp = TREE_OPERAND (exp, 1); goto again; case RESULT_DECL: case FUNCTION_DECL: case INTEGER_CST: case REAL_CST: case STRING_CST: case JAVA_EXC_OBJ_EXPR: break; case NEW_CLASS_EXPR: case CALL_EXPR: { tree func = TREE_OPERAND (exp, 0); tree x = TREE_OPERAND (exp, 1); if (TREE_CODE (func) == ADDR_EXPR) func = TREE_OPERAND (func, 0); check_init (func, before); for ( ; x != NULL_TREE; x = TREE_CHAIN (x)) check_init (TREE_VALUE (x), before); if (func == throw_node) goto never_continues; } break; case NEW_ARRAY_INIT: { tree x = CONSTRUCTOR_ELTS (TREE_OPERAND (exp, 0)); for ( ; x != NULL_TREE; x = TREE_CHAIN (x)) check_init (TREE_VALUE (x), before); } break; case EXPR_WITH_FILE_LOCATION: { location_t saved_location = input_location; tree saved_wfl = wfl; tree body = EXPR_WFL_NODE (exp); if (IS_EMPTY_STMT (body)) break; wfl = exp; #ifdef USE_MAPPED_LOCATION input_location = EXPR_LOCATION (exp); #else input_filename = EXPR_WFL_FILENAME (exp); input_line = EXPR_WFL_LINENO (exp); #endif check_init (body, before); input_location = saved_location; wfl = saved_wfl; } break; default: internal_error ("internal error in check-init: tree code not implemented: %s", tree_code_name [(int) TREE_CODE (exp)]); } }
static tree gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) { tree res, tmp, stmt; stmtblock_t block, *pblock = NULL; stmtblock_t singleblock; int saved_ompws_flags; bool singleblock_in_progress = false; /* True if previous gfc_code in workshare construct is not workshared. */ bool prev_singleunit; code = code->block->next; pushlevel (0); if (!code) return build_empty_stmt (input_location); gfc_start_block (&block); pblock = █ ompws_flags = OMPWS_WORKSHARE_FLAG; prev_singleunit = false; /* Translate statements one by one to trees until we reach the end of the workshare construct. Adjacent gfc_codes that are a single unit of work are clustered and encapsulated in a single OMP_SINGLE construct. */ for (; code; code = code->next) { if (code->here != 0) { res = gfc_trans_label_here (code); gfc_add_expr_to_block (pblock, res); } /* No dependence analysis, use for clauses with wait. If this is the last gfc_code, use default omp_clauses. */ if (code->next == NULL && clauses->nowait) ompws_flags |= OMPWS_NOWAIT; /* By default, every gfc_code is a single unit of work. */ ompws_flags |= OMPWS_CURR_SINGLEUNIT; ompws_flags &= ~OMPWS_SCALARIZER_WS; switch (code->op) { case EXEC_NOP: res = NULL_TREE; break; case EXEC_ASSIGN: res = gfc_trans_assign (code); break; case EXEC_POINTER_ASSIGN: res = gfc_trans_pointer_assign (code); break; case EXEC_INIT_ASSIGN: res = gfc_trans_init_assign (code); break; case EXEC_FORALL: res = gfc_trans_forall (code); break; case EXEC_WHERE: res = gfc_trans_where (code); break; case EXEC_OMP_ATOMIC: res = gfc_trans_omp_directive (code); break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_CRITICAL: saved_ompws_flags = ompws_flags; ompws_flags = 0; res = gfc_trans_omp_directive (code); ompws_flags = saved_ompws_flags; break; default: internal_error ("gfc_trans_omp_workshare(): Bad statement code"); } gfc_set_backend_locus (&code->loc); if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { if (prev_singleunit) { if (ompws_flags & OMPWS_CURR_SINGLEUNIT) /* Add current gfc_code to single block. */ gfc_add_expr_to_block (&singleblock, res); else { /* Finish single block and add it to pblock. */ tmp = gfc_finish_block (&singleblock); tmp = build2 (OMP_SINGLE, void_type_node, tmp, NULL_TREE); gfc_add_expr_to_block (pblock, tmp); /* Add current gfc_code to pblock. */ gfc_add_expr_to_block (pblock, res); singleblock_in_progress = false; } } else { if (ompws_flags & OMPWS_CURR_SINGLEUNIT) { /* Start single block. */ gfc_init_block (&singleblock); gfc_add_expr_to_block (&singleblock, res); singleblock_in_progress = true; } else /* Add the new statement to the block. */ gfc_add_expr_to_block (pblock, res); } prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0; } } /* Finish remaining SINGLE block, if we were in the middle of one. */ if (singleblock_in_progress) { /* Finish single block and add it to pblock. */ tmp = gfc_finish_block (&singleblock); tmp = build2 (OMP_SINGLE, void_type_node, tmp, clauses->nowait ? build_omp_clause (input_location, OMP_CLAUSE_NOWAIT) : NULL_TREE); gfc_add_expr_to_block (pblock, tmp); } stmt = gfc_finish_block (pblock); if (TREE_CODE (stmt) != BIND_EXPR) { if (!IS_EMPTY_STMT (stmt)) { tree bindblock = poplevel (1, 0, 0); stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock); } else poplevel (0, 0, 0); } else poplevel (0, 0, 0); ompws_flags = 0; return stmt; }