#include "coretypes.h"
#include "tree.h"
#include "gimple.h" /* For create_tmp_var_raw. */
-#include "toplev.h" /* For internal_error. */
+#include "diagnostic-core.h" /* For internal_error. */
#include "gfortran.h"
#include "trans.h"
#include "trans-stmt.h"
gfc_add_modify (&cond_block, decl, outer);
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (decl, rank);
- size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_lbound_get (decl, rank));
- size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
- gfc_index_one_node);
+ size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_lbound_get (decl, rank));
+ size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (decl, rank));
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_stride_get (decl, rank));
esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
ptr = gfc_allocate_array_with_status (&cond_block,
build_int_cst (pvoid_type_node, 0),
gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node);
else_b = gfc_finish_block (&cond_block);
- cond = fold_build2 (NE_EXPR, boolean_type_node,
- fold_convert (pvoid_type_node,
- gfc_conv_descriptor_data_get (outer)),
- null_pointer_node);
- gfc_add_expr_to_block (&block, build3 (COND_EXPR, void_type_node,
- cond, then_b, else_b));
+ cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+ fold_convert (pvoid_type_node,
+ gfc_conv_descriptor_data_get (outer)),
+ null_pointer_node);
+ gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+ void_type_node, cond, then_b, else_b));
return gfc_finish_block (&block);
}
gfc_add_modify (&block, dest, src);
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (dest, rank);
- size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_lbound_get (dest, rank));
- size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
- gfc_index_one_node);
+ size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_lbound_get (dest, rank));
+ size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (dest, rank));
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_stride_get (dest, rank));
esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
ptr = gfc_allocate_array_with_status (&block,
build_int_cst (pvoid_type_node, 0),
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (dest, rank);
- size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_lbound_get (dest, rank));
- size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
- gfc_index_one_node);
+ size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_lbound_get (dest, rank));
+ size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (dest, rank));
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_stride_get (dest, rank));
esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
call = build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MEMCPY], 3,
gfc_add_modify (&block, decl, outer_sym.backend_decl);
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (decl, rank);
- size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_lbound_get (decl, rank));
- size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
- gfc_index_one_node);
+ size = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, size,
+ gfc_conv_descriptor_lbound_get (decl, rank));
+ size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (decl, rank));
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size,
+ gfc_conv_descriptor_stride_get (decl, rank));
esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
ptr = gfc_allocate_array_with_status (&block,
build_int_cst (pvoid_type_node, 0),
gfc_init_block (&rse.pre);
gfc_conv_expr (&rse, arg->expr);
gfc_add_block_to_block (&block, &rse.pre);
- x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr);
+ x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
+ accum, rse.expr);
gfc_add_modify (&block, accum, x);
}
lhsaddr));
if (var_on_left)
- x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);
+ x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
else
- x = fold_build2 (op, TREE_TYPE (rhs), rhs, x);
+ x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
&& TREE_CODE (type) != COMPLEX_TYPE)
- x = fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x);
+ x = fold_build1_loc (input_location, REALPART_EXPR,
+ TREE_TYPE (TREE_TYPE (rhs)), x);
x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
gfc_add_expr_to_block (&block, x);
if (code->ext.omp_name != NULL)
name = get_identifier (code->ext.omp_name);
stmt = gfc_trans_code (code->block->next);
- return build2 (OMP_CRITICAL, void_type_node, stmt, name);
+ return build2_loc (input_location, OMP_CRITICAL, void_type_node, stmt, name);
}
+typedef struct dovar_init_d {
+ tree var;
+ tree init;
+} dovar_init;
+
+DEF_VEC_O(dovar_init);
+DEF_VEC_ALLOC_O(dovar_init,heap);
+
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
gfc_omp_clauses *do_clauses, tree par_clauses)
stmtblock_t body;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
int i, collapse = clauses->collapse;
- tree dovar_init = NULL_TREE;
+ VEC(dovar_init,heap) *inits = NULL;
+ dovar_init *di;
+ unsigned ix;
if (collapse <= 0)
collapse = 1;
if (simple)
{
TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
- TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR,
- boolean_type_node, dovar, to);
- TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step);
- TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar,
- TREE_VEC_ELT (incr, i));
+ /* The condition should not be folded. */
+ TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
+ ? LE_EXPR : GE_EXPR,
+ boolean_type_node, dovar, to);
+ TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
+ type, dovar, step);
+ TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
+ MODIFY_EXPR,
+ type, dovar,
+ TREE_VEC_ELT (incr, i));
}
else
{
body;
cycle_label:;
} */
- tmp = fold_build2 (MINUS_EXPR, type, step, from);
- tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
- tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
+ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
+ step);
tmp = gfc_evaluate_now (tmp, pblock);
count = gfc_create_var (type, "count");
TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
build_int_cst (type, 0));
- TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node,
- count, tmp);
- TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count,
- build_int_cst (type, 1));
- TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type,
- count, TREE_VEC_ELT (incr, i));
+ /* The condition should not be folded. */
+ TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
+ boolean_type_node,
+ count, tmp);
+ TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
+ type, count,
+ build_int_cst (type, 1));
+ TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
+ MODIFY_EXPR, type, count,
+ TREE_VEC_ELT (incr, i));
/* Initialize DOVAR. */
- tmp = fold_build2 (MULT_EXPR, type, count, step);
- tmp = fold_build2 (PLUS_EXPR, type, from, tmp);
- dovar_init = tree_cons (dovar, tmp, dovar_init);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
+ di = VEC_safe_push (dovar_init, heap, inits, NULL);
+ di->var = dovar;
+ di->init = tmp;
}
if (!dovar_found)
will have the value on entry of the last loop, rather
than value after iterator increment. */
tmp = gfc_evaluate_now (step, pblock);
- tmp = fold_build2 (PLUS_EXPR, type, dovar, tmp);
- tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar,
+ tmp);
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
+ dovar, tmp);
for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
&& OMP_CLAUSE_DECL (c) == dovar_decl)
gfc_start_block (&body);
- dovar_init = nreverse (dovar_init);
- while (dovar_init)
- {
- gfc_add_modify (&body, TREE_PURPOSE (dovar_init),
- TREE_VALUE (dovar_init));
- dovar_init = TREE_CHAIN (dovar_init);
- }
+ FOR_EACH_VEC_ELT (dovar_init, inits, ix, di)
+ gfc_add_modify (&body, di->var, di->init);
+ VEC_free (dovar_init, heap, inits);
/* Cycle statement is implemented with a goto. Exit statement must not be
present for this loop. */
cycle_label = gfc_build_label_decl (NULL_TREE);
- /* Put these labels where they can be found later. We put the
- labels in a TREE_LIST node (because TREE_CHAIN is already
- used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
- label in TREE_VALUE (backend_decl). */
+ /* Put these labels where they can be found later. */
- code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
+ code->cycle_label = cycle_label;
+ code->exit_label = NULL_TREE;
/* Main loop body. */
tmp = gfc_trans_omp_code (code->block->next, true);
omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
code->loc);
stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+ omp_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
poplevel (0, 0, 0);
- stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+ omp_clauses);
OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
poplevel (0, 0, 0);
- stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+ omp_clauses);
OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
poplevel (0, 0, 0);
- stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+ omp_clauses);
OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
stmt = gfc_finish_block (&body);
- stmt = build2 (OMP_SECTIONS, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_SECTIONS, void_type_node, stmt,
+ omp_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
{
tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
tree stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2 (OMP_SINGLE, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_SINGLE, void_type_node, stmt,
+ omp_clauses);
return stmt;
}
omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
code->loc);
stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2 (OMP_TASK, void_type_node, stmt, omp_clauses);
+ stmt = build2_loc (input_location, OMP_TASK, void_type_node, stmt,
+ omp_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
{
/* Finish single block and add it to pblock. */
tmp = gfc_finish_block (&singleblock);
- tmp = build2 (OMP_SINGLE, void_type_node, tmp, NULL_TREE);
+ tmp = build2_loc (input_location, 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);
{
/* 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);
+ tmp = build2_loc (input_location, 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);
}