static void
append_stmt (tree stmt)
{
/* Set location (if not done). */
if (!EXPR_HAS_LOCATION (stmt))
SET_EXPR_LOCATION (stmt, input_location);
TREE_SIDE_EFFECTS (stmt) = true;
append_to_statement_list (stmt, &cur_stmts);
}
tree
c_finish_omp_critical (location_t loc, tree body, tree name)
{
tree stmt = make_node (OMP_CRITICAL);
TREE_TYPE (stmt) = void_type_node;
OMP_CRITICAL_BODY (stmt) = body;
OMP_CRITICAL_NAME (stmt) = name;
SET_EXPR_LOCATION (stmt, loc);
return add_stmt (stmt);
}
tree
build_array_notation_ref (location_t loc, tree array, tree start, tree length,
tree stride, tree type)
{
tree array_ntn_expr = NULL_TREE;
/* If we enter the then-case of the if-statement below, we have hit a case
like this: ARRAY [:]. */
if (!start && !length)
{
if (TREE_CODE (type) != ARRAY_TYPE)
{
error_at (loc, "start-index and length fields necessary for "
"using array notation in pointers or records");
return error_mark_node;
}
tree domain = TYPE_DOMAIN (type);
if (!domain)
{
error_at (loc, "start-index and length fields necessary for "
"using array notation with array of unknown bound");
return error_mark_node;
}
start = cp_fold_convert (ptrdiff_type_node, TYPE_MINVAL (domain));
length = size_binop (PLUS_EXPR, TYPE_MAXVAL (domain), size_one_node);
length = cp_fold_convert (ptrdiff_type_node, length);
}
if (!stride)
stride = build_one_cst (ptrdiff_type_node);
/* When dealing with templates, triplet type-checking will be done in pt.c
after type substitution. */
if (processing_template_decl
&& (type_dependent_expression_p (array)
|| type_dependent_expression_p (length)
|| type_dependent_expression_p (start)
|| type_dependent_expression_p (stride)))
array_ntn_expr = build_min_nt_loc (loc, ARRAY_NOTATION_REF, array, start,
length, stride, NULL_TREE);
else
{
if (!cilkplus_an_triplet_types_ok_p (loc, start, length, stride, type))
return error_mark_node;
array_ntn_expr = build4 (ARRAY_NOTATION_REF, NULL_TREE, array, start,
length, stride);
}
if (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == POINTER_TYPE)
TREE_TYPE (array_ntn_expr) = TREE_TYPE (type);
else
gcc_unreachable ();
SET_EXPR_LOCATION (array_ntn_expr, loc);
return array_ntn_expr;
}
static void
mf_decl_cache_locals (void)
{
tree t, shift_init_stmts, mask_init_stmts;
tree_stmt_iterator tsi;
/* Build the cache vars. */
mf_cache_shift_decl_l
= mf_mark (create_tmp_var (TREE_TYPE (mf_cache_shift_decl),
"__mf_lookup_shift_l"));
mf_cache_mask_decl_l
= mf_mark (create_tmp_var (TREE_TYPE (mf_cache_mask_decl),
"__mf_lookup_mask_l"));
/* Build initialization nodes for the cache vars. We just load the
globals into the cache variables. */
t = build2 (MODIFY_EXPR, TREE_TYPE (mf_cache_shift_decl_l),
mf_cache_shift_decl_l, mf_cache_shift_decl);
SET_EXPR_LOCATION (t, DECL_SOURCE_LOCATION (current_function_decl));
gimplify_to_stmt_list (&t);
shift_init_stmts = t;
t = build2 (MODIFY_EXPR, TREE_TYPE (mf_cache_mask_decl_l),
mf_cache_mask_decl_l, mf_cache_mask_decl);
SET_EXPR_LOCATION (t, DECL_SOURCE_LOCATION (current_function_decl));
gimplify_to_stmt_list (&t);
mask_init_stmts = t;
/* Anticipating multiple entry points, we insert the cache vars
initializers in each successor of the ENTRY_BLOCK_PTR. */
for (tsi = tsi_start (shift_init_stmts);
! tsi_end_p (tsi);
tsi_next (&tsi))
insert_edge_copies (tsi_stmt (tsi), ENTRY_BLOCK_PTR);
for (tsi = tsi_start (mask_init_stmts);
! tsi_end_p (tsi);
tsi_next (&tsi))
insert_edge_copies (tsi_stmt (tsi), ENTRY_BLOCK_PTR);
bsi_commit_edge_inserts ();
}
static void
lto_input_ts_exp_tree_pointers (struct lto_input_block *ib,
struct data_in *data_in, tree expr)
{
int i, length;
location_t loc;
length = streamer_read_hwi (ib);
gcc_assert (length == TREE_OPERAND_LENGTH (expr));
for (i = 0; i < length; i++)
TREE_OPERAND (expr, i) = stream_read_tree (ib, data_in);
loc = lto_input_location (ib, data_in);
SET_EXPR_LOCATION (expr, loc);
TREE_BLOCK (expr) = stream_read_tree (ib, data_in);
}
static void
gimplify_switch_stmt (tree *stmt_p)
{
tree stmt = *stmt_p;
tree break_block, body;
location_t stmt_locus = input_location;
break_block = begin_bc_block (bc_break);
body = SWITCH_STMT_BODY (stmt);
if (!body)
body = build_empty_stmt ();
*stmt_p = build3 (SWITCH_EXPR, SWITCH_STMT_TYPE (stmt),
SWITCH_STMT_COND (stmt), body, NULL_TREE);
SET_EXPR_LOCATION (*stmt_p, stmt_locus);
gimplify_stmt (stmt_p);
*stmt_p = finish_bc_block (bc_break, break_block, *stmt_p);
}
static void
gimplify_switch_stmt (tree *stmt_p, gimple_seq *pre_p)
{
tree stmt = *stmt_p;
tree break_block, body, t;
location_t stmt_locus = input_location;
gimple_seq seq = NULL;
break_block = begin_bc_block (bc_break);
body = SWITCH_STMT_BODY (stmt);
if (!body)
body = build_empty_stmt ();
t = build3 (SWITCH_EXPR, SWITCH_STMT_TYPE (stmt),
SWITCH_STMT_COND (stmt), body, NULL_TREE);
SET_EXPR_LOCATION (t, stmt_locus);
gimplify_and_add (t, &seq);
seq = finish_bc_block (bc_break, break_block, seq);
gimple_seq_add_seq (pre_p, seq);
*stmt_p = NULL_TREE;
}
tree
build_stmt (location_t loc, enum tree_code code, ...)
{
tree ret;
int length, i;
va_list p;
bool side_effects;
/* This function cannot be used to construct variably-sized nodes. */
gcc_assert (TREE_CODE_CLASS (code) != tcc_vl_exp);
va_start (p, code);
ret = make_node (code);
TREE_TYPE (ret) = void_type_node;
length = TREE_CODE_LENGTH (code);
SET_EXPR_LOCATION (ret, loc);
/* TREE_SIDE_EFFECTS will already be set for statements with
implicit side effects. Here we make sure it is set for other
expressions by checking whether the parameters have side
effects. */
side_effects = false;
for (i = 0; i < length; i++)
{
tree t = va_arg (p, tree);
if (t && !TYPE_P (t))
side_effects |= TREE_SIDE_EFFECTS (t);
TREE_OPERAND (ret, i) = t;
}
TREE_SIDE_EFFECTS (ret) |= side_effects;
va_end (p);
return ret;
}
tree
c_finish_omp_for (location_t locus, tree decl, tree init, tree cond,
tree incr, tree body, tree pre_body)
{
location_t elocus = locus;
bool fail = false;
if (EXPR_HAS_LOCATION (init))
elocus = EXPR_LOCATION (init);
/* Validate the iteration variable. */
if (!INTEGRAL_TYPE_P (TREE_TYPE (decl)))
{
error ("%Hinvalid type for iteration variable %qE", &elocus, decl);
fail = true;
}
if (TYPE_UNSIGNED (TREE_TYPE (decl)))
warning (0, "%Hiteration variable %qE is unsigned", &elocus, decl);
/* In the case of "for (int i = 0...)", init will be a decl. It should
have a DECL_INITIAL that we can turn into an assignment. */
if (init == decl)
{
elocus = DECL_SOURCE_LOCATION (decl);
init = DECL_INITIAL (decl);
if (init == NULL)
{
error ("%H%qE is not initialized", &elocus, decl);
init = integer_zero_node;
fail = true;
}
init = build_modify_expr (decl, NOP_EXPR, init);
SET_EXPR_LOCATION (init, elocus);
}
gcc_assert (TREE_CODE (init) == MODIFY_EXPR);
gcc_assert (TREE_OPERAND (init, 0) == decl);
if (cond == NULL_TREE)
{
error ("%Hmissing controlling predicate", &elocus);
fail = true;
}
else
{
bool cond_ok = false;
if (EXPR_HAS_LOCATION (cond))
elocus = EXPR_LOCATION (cond);
if (TREE_CODE (cond) == LT_EXPR
|| TREE_CODE (cond) == LE_EXPR
|| TREE_CODE (cond) == GT_EXPR
|| TREE_CODE (cond) == GE_EXPR)
{
tree op0 = TREE_OPERAND (cond, 0);
tree op1 = TREE_OPERAND (cond, 1);
/* 2.5.1. The comparison in the condition is computed in the type
of DECL, otherwise the behavior is undefined.
For example:
long n; int i;
i < n;
according to ISO will be evaluated as:
(long)i < n;
We want to force:
i < (int)n; */
if (TREE_CODE (op0) == NOP_EXPR
&& decl == TREE_OPERAND (op0, 0))
{
TREE_OPERAND (cond, 0) = TREE_OPERAND (op0, 0);
TREE_OPERAND (cond, 1) = fold_build1 (NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 1));
}
else if (TREE_CODE (op1) == NOP_EXPR
&& decl == TREE_OPERAND (op1, 0))
{
TREE_OPERAND (cond, 1) = TREE_OPERAND (op1, 0);
TREE_OPERAND (cond, 0) = fold_build1 (NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 0));
}
if (decl == TREE_OPERAND (cond, 0))
cond_ok = true;
else if (decl == TREE_OPERAND (cond, 1))
{
TREE_SET_CODE (cond, swap_tree_comparison (TREE_CODE (cond)));
TREE_OPERAND (cond, 1) = TREE_OPERAND (cond, 0);
TREE_OPERAND (cond, 0) = decl;
cond_ok = true;
}
}
if (!cond_ok)
{
error ("%Hinvalid controlling predicate", &elocus);
fail = true;
}
}
if (incr == NULL_TREE)
{
error ("%Hmissing increment expression", &elocus);
fail = true;
}
else
{
bool incr_ok = false;
if (EXPR_HAS_LOCATION (incr))
elocus = EXPR_LOCATION (incr);
/* Check all the valid increment expressions: v++, v--, ++v, --v,
v = v + incr, v = incr + v and v = v - incr. */
switch (TREE_CODE (incr))
{
case POSTINCREMENT_EXPR:
case PREINCREMENT_EXPR:
case POSTDECREMENT_EXPR:
case PREDECREMENT_EXPR:
incr_ok = (TREE_OPERAND (incr, 0) == decl);
break;
case MODIFY_EXPR:
if (TREE_OPERAND (incr, 0) != decl)
break;
if (TREE_OPERAND (incr, 1) == decl)
break;
if (TREE_CODE (TREE_OPERAND (incr, 1)) == PLUS_EXPR
&& (TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl
|| TREE_OPERAND (TREE_OPERAND (incr, 1), 1) == decl))
incr_ok = true;
else if (TREE_CODE (TREE_OPERAND (incr, 1)) == MINUS_EXPR
&& TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl)
incr_ok = true;
else
{
tree t = check_omp_for_incr_expr (TREE_OPERAND (incr, 1), decl);
if (t != error_mark_node)
{
incr_ok = true;
t = build2 (PLUS_EXPR, TREE_TYPE (decl), decl, t);
incr = build2 (MODIFY_EXPR, void_type_node, decl, t);
}
}
break;
default:
break;
}
if (!incr_ok)
{
error ("%Hinvalid increment expression", &elocus);
fail = true;
}
}
if (fail)
return NULL;
else
{
tree t = make_node (OMP_FOR);
TREE_TYPE (t) = void_type_node;
OMP_FOR_INIT (t) = init;
OMP_FOR_COND (t) = cond;
OMP_FOR_INCR (t) = incr;
OMP_FOR_BODY (t) = body;
OMP_FOR_PRE_BODY (t) = pre_body;
SET_EXPR_LOCATION (t, locus);
return add_stmt (t);
}
}
static void
lower_function_body (void)
{
struct lower_data data;
tree *body_p = &DECL_SAVED_TREE (current_function_decl);
tree bind = *body_p;
tree_stmt_iterator i;
tree t, x;
gcc_assert (TREE_CODE (bind) == BIND_EXPR);
data.block = DECL_INITIAL (current_function_decl);
BLOCK_SUBBLOCKS (data.block) = NULL_TREE;
BLOCK_CHAIN (data.block) = NULL_TREE;
TREE_ASM_WRITTEN (data.block) = 1;
data.return_statements = NULL_TREE;
*body_p = alloc_stmt_list ();
i = tsi_start (*body_p);
tsi_link_after (&i, bind, TSI_NEW_STMT);
lower_bind_expr (&i, &data);
i = tsi_last (*body_p);
/* If the function falls off the end, we need a null return statement.
If we've already got one in the return_statements list, we don't
need to do anything special. Otherwise build one by hand. */
if (block_may_fallthru (*body_p)
&& (data.return_statements == NULL
|| TREE_OPERAND (TREE_VALUE (data.return_statements), 0) != NULL))
{
x = build (RETURN_EXPR, void_type_node, NULL);
SET_EXPR_LOCATION (x, cfun->function_end_locus);
tsi_link_after (&i, x, TSI_CONTINUE_LINKING);
}
/* If we lowered any return statements, emit the representative
at the end of the function. */
for (t = data.return_statements ; t ; t = TREE_CHAIN (t))
{
x = build (LABEL_EXPR, void_type_node, TREE_PURPOSE (t));
tsi_link_after (&i, x, TSI_CONTINUE_LINKING);
/* Remove the line number from the representative return statement.
It now fills in for many such returns. Failure to remove this
will result in incorrect results for coverage analysis. */
x = TREE_VALUE (t);
#ifdef USE_MAPPED_LOCATION
SET_EXPR_LOCATION (x, UNKNOWN_LOCATION);
#else
SET_EXPR_LOCUS (x, NULL);
#endif
tsi_link_after (&i, x, TSI_CONTINUE_LINKING);
}
gcc_assert (data.block == DECL_INITIAL (current_function_decl));
BLOCK_SUBBLOCKS (data.block)
= blocks_nreverse (BLOCK_SUBBLOCKS (data.block));
clear_block_marks (data.block);
}
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 void
unpack_value_fields (struct data_in *data_in, struct bitpack_d *bp, tree expr)
{
enum tree_code code;
code = TREE_CODE (expr);
/* Note that all these functions are highly sensitive to changes in
the types and sizes of each of the fields being packed. */
unpack_ts_base_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_INT_CST))
unpack_ts_int_cst_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_REAL_CST))
unpack_ts_real_cst_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_FIXED_CST))
unpack_ts_fixed_cst_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_DECL_MINIMAL))
DECL_SOURCE_LOCATION (expr) = stream_input_location (bp, data_in);
if (CODE_CONTAINS_STRUCT (code, TS_DECL_COMMON))
unpack_ts_decl_common_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_DECL_WRTL))
unpack_ts_decl_wrtl_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_DECL_WITH_VIS))
unpack_ts_decl_with_vis_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_FUNCTION_DECL))
unpack_ts_function_decl_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_TYPE_COMMON))
unpack_ts_type_common_value_fields (bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_EXP))
{
SET_EXPR_LOCATION (expr, stream_input_location (bp, data_in));
if (code == MEM_REF
|| code == TARGET_MEM_REF)
{
MR_DEPENDENCE_CLIQUE (expr)
= (unsigned)bp_unpack_value (bp, sizeof (short) * 8);
if (MR_DEPENDENCE_CLIQUE (expr) != 0)
MR_DEPENDENCE_BASE (expr)
= (unsigned)bp_unpack_value (bp, sizeof (short) * 8);
}
}
if (CODE_CONTAINS_STRUCT (code, TS_BLOCK))
unpack_ts_block_value_fields (data_in, bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_TRANSLATION_UNIT_DECL))
unpack_ts_translation_unit_decl_value_fields (data_in, bp, expr);
if (CODE_CONTAINS_STRUCT (code, TS_OPTIMIZATION))
cl_optimization_stream_in (bp, TREE_OPTIMIZATION (expr));
if (CODE_CONTAINS_STRUCT (code, TS_BINFO))
{
unsigned HOST_WIDE_INT length = bp_unpack_var_len_unsigned (bp);
if (length > 0)
vec_safe_grow (BINFO_BASE_ACCESSES (expr), length);
}
if (CODE_CONTAINS_STRUCT (code, TS_CONSTRUCTOR))
{
unsigned HOST_WIDE_INT length = bp_unpack_var_len_unsigned (bp);
if (length > 0)
vec_safe_grow (CONSTRUCTOR_ELTS (expr), length);
}
#ifndef ACCEL_COMPILER
if (CODE_CONTAINS_STRUCT (code, TS_TARGET_OPTION))
cl_target_option_stream_in (data_in, bp, TREE_TARGET_OPTION (expr));
#endif
if (code == OMP_CLAUSE)
unpack_ts_omp_clause_value_fields (data_in, bp, expr);
}
tree
c_finish_omp_for (location_t locus, enum tree_code code, tree declv,
tree orig_declv, tree initv, tree condv, tree incrv,
tree body, tree pre_body)
{
location_t elocus;
bool fail = false;
int i;
if ((code == CILK_SIMD || code == CILK_FOR)
&& !c_check_cilk_loop (locus, TREE_VEC_ELT (declv, 0)))
fail = true;
gcc_assert (TREE_VEC_LENGTH (declv) == TREE_VEC_LENGTH (initv));
gcc_assert (TREE_VEC_LENGTH (declv) == TREE_VEC_LENGTH (condv));
gcc_assert (TREE_VEC_LENGTH (declv) == TREE_VEC_LENGTH (incrv));
for (i = 0; i < TREE_VEC_LENGTH (declv); i++)
{
tree decl = TREE_VEC_ELT (declv, i);
tree init = TREE_VEC_ELT (initv, i);
tree cond = TREE_VEC_ELT (condv, i);
tree incr = TREE_VEC_ELT (incrv, i);
elocus = locus;
if (EXPR_HAS_LOCATION (init))
elocus = EXPR_LOCATION (init);
/* Validate the iteration variable. */
if (!INTEGRAL_TYPE_P (TREE_TYPE (decl))
&& TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
{
error_at (elocus, "invalid type for iteration variable %qE", decl);
fail = true;
}
/* In the case of "for (int i = 0...)", init will be a decl. It should
have a DECL_INITIAL that we can turn into an assignment. */
if (init == decl)
{
elocus = DECL_SOURCE_LOCATION (decl);
init = DECL_INITIAL (decl);
if (init == NULL)
{
error_at (elocus, "%qE is not initialized", decl);
init = integer_zero_node;
fail = true;
}
DECL_INITIAL (decl) = NULL_TREE;
init = build_modify_expr (elocus, decl, NULL_TREE, NOP_EXPR,
/* FIXME diagnostics: This should
be the location of the INIT. */
elocus,
init,
NULL_TREE);
}
if (init != error_mark_node)
{
gcc_assert (TREE_CODE (init) == MODIFY_EXPR);
gcc_assert (TREE_OPERAND (init, 0) == decl);
}
if (cond == NULL_TREE)
{
error_at (elocus, "missing controlling predicate");
fail = true;
}
else
{
bool cond_ok = false;
if (EXPR_HAS_LOCATION (cond))
elocus = EXPR_LOCATION (cond);
if (TREE_CODE (cond) == LT_EXPR
|| TREE_CODE (cond) == LE_EXPR
|| TREE_CODE (cond) == GT_EXPR
|| TREE_CODE (cond) == GE_EXPR
|| TREE_CODE (cond) == NE_EXPR
|| TREE_CODE (cond) == EQ_EXPR)
{
tree op0 = TREE_OPERAND (cond, 0);
tree op1 = TREE_OPERAND (cond, 1);
/* 2.5.1. The comparison in the condition is computed in
the type of DECL, otherwise the behavior is undefined.
For example:
long n; int i;
i < n;
according to ISO will be evaluated as:
(long)i < n;
We want to force:
i < (int)n; */
if (TREE_CODE (op0) == NOP_EXPR
&& decl == TREE_OPERAND (op0, 0))
{
TREE_OPERAND (cond, 0) = TREE_OPERAND (op0, 0);
TREE_OPERAND (cond, 1)
= fold_build1_loc (elocus, NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 1));
}
else if (TREE_CODE (op1) == NOP_EXPR
&& decl == TREE_OPERAND (op1, 0))
{
TREE_OPERAND (cond, 1) = TREE_OPERAND (op1, 0);
TREE_OPERAND (cond, 0)
= fold_build1_loc (elocus, NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 0));
}
if (decl == TREE_OPERAND (cond, 0))
cond_ok = true;
else if (decl == TREE_OPERAND (cond, 1))
{
TREE_SET_CODE (cond,
swap_tree_comparison (TREE_CODE (cond)));
TREE_OPERAND (cond, 1) = TREE_OPERAND (cond, 0);
TREE_OPERAND (cond, 0) = decl;
cond_ok = true;
}
if (TREE_CODE (cond) == NE_EXPR
|| TREE_CODE (cond) == EQ_EXPR)
{
if (!INTEGRAL_TYPE_P (TREE_TYPE (decl)))
{
if (code != CILK_SIMD && code != CILK_FOR)
cond_ok = false;
}
else if (operand_equal_p (TREE_OPERAND (cond, 1),
TYPE_MIN_VALUE (TREE_TYPE (decl)),
0))
TREE_SET_CODE (cond, TREE_CODE (cond) == NE_EXPR
? GT_EXPR : LE_EXPR);
else if (operand_equal_p (TREE_OPERAND (cond, 1),
TYPE_MAX_VALUE (TREE_TYPE (decl)),
0))
TREE_SET_CODE (cond, TREE_CODE (cond) == NE_EXPR
? LT_EXPR : GE_EXPR);
else if (code != CILK_SIMD && code != CILK_FOR)
cond_ok = false;
}
}
if (!cond_ok)
{
error_at (elocus, "invalid controlling predicate");
fail = true;
}
}
if (incr == NULL_TREE)
{
error_at (elocus, "missing increment expression");
fail = true;
}
else
{
bool incr_ok = false;
if (EXPR_HAS_LOCATION (incr))
elocus = EXPR_LOCATION (incr);
/* Check all the valid increment expressions: v++, v--, ++v, --v,
v = v + incr, v = incr + v and v = v - incr. */
switch (TREE_CODE (incr))
{
case POSTINCREMENT_EXPR:
case PREINCREMENT_EXPR:
case POSTDECREMENT_EXPR:
case PREDECREMENT_EXPR:
if (TREE_OPERAND (incr, 0) != decl)
break;
incr_ok = true;
incr = c_omp_for_incr_canonicalize_ptr (elocus, decl, incr);
break;
case COMPOUND_EXPR:
if (TREE_CODE (TREE_OPERAND (incr, 0)) != SAVE_EXPR
|| TREE_CODE (TREE_OPERAND (incr, 1)) != MODIFY_EXPR)
break;
incr = TREE_OPERAND (incr, 1);
/* FALLTHRU */
case MODIFY_EXPR:
if (TREE_OPERAND (incr, 0) != decl)
break;
if (TREE_OPERAND (incr, 1) == decl)
break;
if (TREE_CODE (TREE_OPERAND (incr, 1)) == PLUS_EXPR
&& (TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl
|| TREE_OPERAND (TREE_OPERAND (incr, 1), 1) == decl))
incr_ok = true;
else if ((TREE_CODE (TREE_OPERAND (incr, 1)) == MINUS_EXPR
|| (TREE_CODE (TREE_OPERAND (incr, 1))
== POINTER_PLUS_EXPR))
&& TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl)
incr_ok = true;
else
{
tree t = check_omp_for_incr_expr (elocus,
TREE_OPERAND (incr, 1),
decl);
if (t != error_mark_node)
{
incr_ok = true;
t = build2 (PLUS_EXPR, TREE_TYPE (decl), decl, t);
incr = build2 (MODIFY_EXPR, void_type_node, decl, t);
}
}
break;
default:
break;
}
if (!incr_ok)
{
error_at (elocus, "invalid increment expression");
fail = true;
}
}
TREE_VEC_ELT (initv, i) = init;
TREE_VEC_ELT (incrv, i) = incr;
}
if (fail)
return NULL;
else
{
tree t = make_node (code);
TREE_TYPE (t) = void_type_node;
OMP_FOR_INIT (t) = initv;
OMP_FOR_COND (t) = condv;
OMP_FOR_INCR (t) = incrv;
OMP_FOR_BODY (t) = body;
OMP_FOR_PRE_BODY (t) = pre_body;
if (code == OMP_FOR)
OMP_FOR_ORIG_DECLS (t) = orig_declv;
SET_EXPR_LOCATION (t, locus);
return add_stmt (t);
}
}
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 void
genericize_cp_loop (tree *stmt_p, location_t start_locus, tree cond, tree body,
tree incr, bool cond_is_first, int *walk_subtrees,
void *data)
{
tree blab, clab;
tree entry = NULL, exit = NULL, t;
tree stmt_list = NULL;
blab = begin_bc_block (bc_break, start_locus);
clab = begin_bc_block (bc_continue, start_locus);
if (incr && EXPR_P (incr))
SET_EXPR_LOCATION (incr, start_locus);
cp_walk_tree (&cond, cp_genericize_r, data, NULL);
cp_walk_tree (&body, cp_genericize_r, data, NULL);
cp_walk_tree (&incr, cp_genericize_r, data, NULL);
*walk_subtrees = 0;
/* If condition is zero don't generate a loop construct. */
if (cond && integer_zerop (cond))
{
if (cond_is_first)
{
t = build1_loc (start_locus, GOTO_EXPR, void_type_node,
get_bc_label (bc_break));
append_to_statement_list (t, &stmt_list);
}
}
else
{
/* Expand to gotos, just like c_finish_loop. TODO: Use LOOP_EXPR. */
tree top = build1 (LABEL_EXPR, void_type_node,
create_artificial_label (start_locus));
/* If we have an exit condition, then we build an IF with gotos either
out of the loop, or to the top of it. If there's no exit condition,
then we just build a jump back to the top. */
exit = build1 (GOTO_EXPR, void_type_node, LABEL_EXPR_LABEL (top));
if (cond && !integer_nonzerop (cond))
{
/* Canonicalize the loop condition to the end. This means
generating a branch to the loop condition. Reuse the
continue label, if possible. */
if (cond_is_first)
{
if (incr)
{
entry = build1 (LABEL_EXPR, void_type_node,
create_artificial_label (start_locus));
t = build1_loc (start_locus, GOTO_EXPR, void_type_node,
LABEL_EXPR_LABEL (entry));
}
else
t = build1_loc (start_locus, GOTO_EXPR, void_type_node,
get_bc_label (bc_continue));
append_to_statement_list (t, &stmt_list);
}
t = build1 (GOTO_EXPR, void_type_node, get_bc_label (bc_break));
exit = fold_build3_loc (start_locus,
COND_EXPR, void_type_node, cond, exit, t);
}
append_to_statement_list (top, &stmt_list);
}
append_to_statement_list (body, &stmt_list);
finish_bc_block (&stmt_list, bc_continue, clab);
append_to_statement_list (incr, &stmt_list);
append_to_statement_list (entry, &stmt_list);
append_to_statement_list (exit, &stmt_list);
finish_bc_block (&stmt_list, bc_break, blab);
if (stmt_list == NULL_TREE)
stmt_list = build1 (NOP_EXPR, void_type_node, integer_zero_node);
*stmt_p = stmt_list;
}
tree
build_throw (tree exp)
{
if (exp == error_mark_node)
return exp;
if (processing_template_decl)
{
if (cfun)
current_function_returns_abnormally = 1;
exp = build_min (THROW_EXPR, void_type_node, exp);
SET_EXPR_LOCATION (exp, input_location);
return exp;
}
if (exp && null_node_p (exp))
warning (0, "throwing NULL, which has integral, not pointer type");
if (exp != NULL_TREE)
{
if (!is_admissible_throw_operand_or_catch_parameter (exp, true))
return error_mark_node;
}
if (! doing_eh ())
return error_mark_node;
if (exp)
{
tree throw_type;
tree temp_type;
tree cleanup;
tree object, ptr;
tree tmp;
tree allocate_expr;
/* The CLEANUP_TYPE is the internal type of a destructor. */
if (!cleanup_type)
{
tmp = build_function_type_list (void_type_node,
ptr_type_node, NULL_TREE);
cleanup_type = build_pointer_type (tmp);
}
if (!throw_fn)
{
tree name = get_identifier ("__cxa_throw");
throw_fn = get_global_binding (name);
if (!throw_fn)
{
/* Declare void __cxa_throw (void*, void*, void (*)(void*)). */
/* ??? Second argument is supposed to be "std::type_info*". */
tmp = build_function_type_list (void_type_node,
ptr_type_node, ptr_type_node,
cleanup_type, NULL_TREE);
throw_fn = push_throw_library_fn (name, tmp);
if (flag_tm)
{
tree itm_name = get_identifier ("_ITM_cxa_throw");
tree itm_fn = get_global_binding (itm_name);
if (!itm_fn)
itm_fn = push_throw_library_fn (itm_name, tmp);
apply_tm_attr (itm_fn, get_identifier ("transaction_pure"));
record_tm_replacement (throw_fn, itm_fn);
}
}
}
/* [except.throw]
A throw-expression initializes a temporary object, the type
of which is determined by removing any top-level
cv-qualifiers from the static type of the operand of throw
and adjusting the type from "array of T" or "function return
T" to "pointer to T" or "pointer to function returning T"
respectively. */
temp_type = is_bitfield_expr_with_lowered_type (exp);
if (!temp_type)
temp_type = cv_unqualified (type_decays_to (TREE_TYPE (exp)));
/* OK, this is kind of wacky. The standard says that we call
terminate when the exception handling mechanism, after
completing evaluation of the expression to be thrown but
before the exception is caught (_except.throw_), calls a
user function that exits via an uncaught exception.
So we have to protect the actual initialization of the
exception object with terminate(), but evaluate the
expression first. Since there could be temps in the
expression, we need to handle that, too. We also expand
the call to __cxa_allocate_exception first (which doesn't
matter, since it can't throw). */
/* Allocate the space for the exception. */
allocate_expr = do_allocate_exception (temp_type);
allocate_expr = get_target_expr (allocate_expr);
ptr = TARGET_EXPR_SLOT (allocate_expr);
TARGET_EXPR_CLEANUP (allocate_expr) = do_free_exception (ptr);
CLEANUP_EH_ONLY (allocate_expr) = 1;
object = build_nop (build_pointer_type (temp_type), ptr);
object = cp_build_fold_indirect_ref (object);
/* And initialize the exception object. */
if (CLASS_TYPE_P (temp_type))
{
int flags = LOOKUP_NORMAL | LOOKUP_ONLYCONVERTING;
vec<tree, va_gc> *exp_vec;
bool converted = false;
/* Under C++0x [12.8/16 class.copy], a thrown lvalue is sometimes
treated as an rvalue for the purposes of overload resolution
to favor move constructors over copy constructors. */
if (/* Must be a local, automatic variable. */
VAR_P (exp)
&& DECL_CONTEXT (exp) == current_function_decl
&& ! TREE_STATIC (exp)
/* The variable must not have the `volatile' qualifier. */
&& !(cp_type_quals (TREE_TYPE (exp)) & TYPE_QUAL_VOLATILE))
{
tree moved = move (exp);
exp_vec = make_tree_vector_single (moved);
moved = (build_special_member_call
(object, complete_ctor_identifier, &exp_vec,
TREE_TYPE (object), flags|LOOKUP_PREFER_RVALUE,
tf_none));
release_tree_vector (exp_vec);
if (moved != error_mark_node)
{
exp = moved;
converted = true;
}
}
/* Call the copy constructor. */
if (!converted)
{
exp_vec = make_tree_vector_single (exp);
exp = (build_special_member_call
(object, complete_ctor_identifier, &exp_vec,
TREE_TYPE (object), flags, tf_warning_or_error));
release_tree_vector (exp_vec);
}
if (exp == error_mark_node)
{
error (" in thrown expression");
return error_mark_node;
}
}
else
{
tmp = decay_conversion (exp, tf_warning_or_error);
if (tmp == error_mark_node)
return error_mark_node;
exp = build2 (INIT_EXPR, temp_type, object, tmp);
}
/* Mark any cleanups from the initialization as MUST_NOT_THROW, since
they are run after the exception object is initialized. */
cp_walk_tree_without_duplicates (&exp, wrap_cleanups_r, 0);
/* Prepend the allocation. */
exp = build2 (COMPOUND_EXPR, TREE_TYPE (exp), allocate_expr, exp);
/* Force all the cleanups to be evaluated here so that we don't have
to do them during unwinding. */
exp = build1 (CLEANUP_POINT_EXPR, void_type_node, exp);
throw_type = build_eh_type_type (prepare_eh_type (TREE_TYPE (object)));
cleanup = NULL_TREE;
if (type_build_dtor_call (TREE_TYPE (object)))
{
tree dtor_fn = lookup_fnfields (TYPE_BINFO (TREE_TYPE (object)),
complete_dtor_identifier, 0);
dtor_fn = BASELINK_FUNCTIONS (dtor_fn);
mark_used (dtor_fn);
if (TYPE_HAS_NONTRIVIAL_DESTRUCTOR (TREE_TYPE (object)))
{
cxx_mark_addressable (dtor_fn);
/* Pretend it's a normal function. */
cleanup = build1 (ADDR_EXPR, cleanup_type, dtor_fn);
}
}
if (cleanup == NULL_TREE)
cleanup = build_int_cst (cleanup_type, 0);
/* ??? Indicate that this function call throws throw_type. */
tmp = cp_build_function_call_nary (throw_fn, tf_warning_or_error,
ptr, throw_type, cleanup, NULL_TREE);
/* Tack on the initialization stuff. */
exp = build2 (COMPOUND_EXPR, TREE_TYPE (tmp), exp, tmp);
}
else
{
/* Rethrow current exception. */
if (!rethrow_fn)
{
tree name = get_identifier ("__cxa_rethrow");
rethrow_fn = get_global_binding (name);
if (!rethrow_fn)
/* Declare void __cxa_rethrow (void). */
rethrow_fn = push_throw_library_fn
(name, build_function_type_list (void_type_node, NULL_TREE));
if (flag_tm)
apply_tm_attr (rethrow_fn, get_identifier ("transaction_pure"));
}
/* ??? Indicate that this function call allows exceptions of the type
of the enclosing catch block (if known). */
exp = cp_build_function_call_vec (rethrow_fn, NULL, tf_warning_or_error);
}
exp = build1 (THROW_EXPR, void_type_node, exp);
SET_EXPR_LOCATION (exp, input_location);
return exp;
}
tree
c_finish_omp_atomic (location_t loc, enum tree_code code,
enum tree_code opcode, tree lhs, tree rhs,
tree v, tree lhs1, tree rhs1, bool swapped, bool seq_cst)
{
tree x, type, addr, pre = NULL_TREE;
if (lhs == error_mark_node || rhs == error_mark_node
|| v == error_mark_node || lhs1 == error_mark_node
|| rhs1 == error_mark_node)
return error_mark_node;
/* ??? According to one reading of the OpenMP spec, complex type are
supported, but there are no atomic stores for any architecture.
But at least icc 9.0 doesn't support complex types here either.
And lets not even talk about vector types... */
type = TREE_TYPE (lhs);
if (!INTEGRAL_TYPE_P (type)
&& !POINTER_TYPE_P (type)
&& !SCALAR_FLOAT_TYPE_P (type))
{
error_at (loc, "invalid expression type for %<#pragma omp atomic%>");
return error_mark_node;
}
if (opcode == RDIV_EXPR)
opcode = TRUNC_DIV_EXPR;
/* ??? Validate that rhs does not overlap lhs. */
/* Take and save the address of the lhs. From then on we'll reference it
via indirection. */
addr = build_unary_op (loc, ADDR_EXPR, lhs, 0);
if (addr == error_mark_node)
return error_mark_node;
addr = save_expr (addr);
if (TREE_CODE (addr) != SAVE_EXPR
&& (TREE_CODE (addr) != ADDR_EXPR
|| !VAR_P (TREE_OPERAND (addr, 0))))
{
/* Make sure LHS is simple enough so that goa_lhs_expr_p can recognize
it even after unsharing function body. */
tree var = create_tmp_var_raw (TREE_TYPE (addr));
DECL_CONTEXT (var) = current_function_decl;
addr = build4 (TARGET_EXPR, TREE_TYPE (addr), var, addr, NULL, NULL);
}
lhs = build_indirect_ref (loc, addr, RO_NULL);
if (code == OMP_ATOMIC_READ)
{
x = build1 (OMP_ATOMIC_READ, type, addr);
SET_EXPR_LOCATION (x, loc);
OMP_ATOMIC_SEQ_CST (x) = seq_cst;
return build_modify_expr (loc, v, NULL_TREE, NOP_EXPR,
loc, x, NULL_TREE);
}
/* There are lots of warnings, errors, and conversions that need to happen
in the course of interpreting a statement. Use the normal mechanisms
to do this, and then take it apart again. */
if (swapped)
{
rhs = build_binary_op (loc, opcode, rhs, lhs, 1);
opcode = NOP_EXPR;
}
bool save = in_late_binary_op;
in_late_binary_op = true;
x = build_modify_expr (loc, lhs, NULL_TREE, opcode, loc, rhs, NULL_TREE);
in_late_binary_op = save;
if (x == error_mark_node)
return error_mark_node;
if (TREE_CODE (x) == COMPOUND_EXPR)
{
pre = TREE_OPERAND (x, 0);
gcc_assert (TREE_CODE (pre) == SAVE_EXPR);
x = TREE_OPERAND (x, 1);
}
gcc_assert (TREE_CODE (x) == MODIFY_EXPR);
rhs = TREE_OPERAND (x, 1);
/* Punt the actual generation of atomic operations to common code. */
if (code == OMP_ATOMIC)
type = void_type_node;
x = build2 (code, type, addr, rhs);
SET_EXPR_LOCATION (x, loc);
OMP_ATOMIC_SEQ_CST (x) = seq_cst;
/* Generally it is hard to prove lhs1 and lhs are the same memory
location, just diagnose different variables. */
if (rhs1
&& VAR_P (rhs1)
&& VAR_P (lhs)
&& rhs1 != lhs)
{
if (code == OMP_ATOMIC)
error_at (loc, "%<#pragma omp atomic update%> uses two different variables for memory");
else
error_at (loc, "%<#pragma omp atomic capture%> uses two different variables for memory");
return error_mark_node;
}
if (code != OMP_ATOMIC)
{
/* Generally it is hard to prove lhs1 and lhs are the same memory
location, just diagnose different variables. */
if (lhs1 && VAR_P (lhs1) && VAR_P (lhs))
{
if (lhs1 != lhs)
{
error_at (loc, "%<#pragma omp atomic capture%> uses two different variables for memory");
return error_mark_node;
}
}
x = build_modify_expr (loc, v, NULL_TREE, NOP_EXPR,
loc, x, NULL_TREE);
if (rhs1 && rhs1 != lhs)
{
tree rhs1addr = build_unary_op (loc, ADDR_EXPR, rhs1, 0);
if (rhs1addr == error_mark_node)
return error_mark_node;
x = omit_one_operand_loc (loc, type, x, rhs1addr);
}
if (lhs1 && lhs1 != lhs)
{
tree lhs1addr = build_unary_op (loc, ADDR_EXPR, lhs1, 0);
if (lhs1addr == error_mark_node)
return error_mark_node;
if (code == OMP_ATOMIC_CAPTURE_OLD)
x = omit_one_operand_loc (loc, type, x, lhs1addr);
else
{
x = save_expr (x);
x = omit_two_operands_loc (loc, type, x, x, lhs1addr);
}
}
}
else if (rhs1 && rhs1 != lhs)
{
tree rhs1addr = build_unary_op (loc, ADDR_EXPR, rhs1, 0);
if (rhs1addr == error_mark_node)
return error_mark_node;
x = omit_one_operand_loc (loc, type, x, rhs1addr);
}
if (pre)
x = omit_one_operand_loc (loc, type, x, pre);
return x;
}
