/* OpenMP directive translation -- generate GCC trees from gfc_code.
- Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
Contributed by Jakub Jelinek <jakub@redhat.com>
This file is part of GCC.
#include "system.h"
#include "coretypes.h"
#include "tree.h"
-#include "gimple.h"
-#include "ggc.h"
-#include "toplev.h"
-#include "real.h"
+#include "gimple.h" /* For create_tmp_var_raw. */
+#include "diagnostic-core.h" /* For internal_error. */
#include "gfortran.h"
#include "trans.h"
#include "trans-stmt.h"
if (GFC_POINTER_TYPE_P (type))
return false;
- if (!DECL_ARTIFICIAL (decl))
+ if (!DECL_ARTIFICIAL (decl)
+ && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
return true;
/* Some arrays are expanded as DECL_ARTIFICIAL pointers
enum omp_clause_default_kind
gfc_omp_predetermined_sharing (tree decl)
{
- if (DECL_ARTIFICIAL (decl) && ! GFC_DECL_RESULT (decl))
+ if (DECL_ARTIFICIAL (decl)
+ && ! GFC_DECL_RESULT (decl)
+ && ! (DECL_LANG_SPECIFIC (decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (decl)))
return OMP_CLAUSE_DEFAULT_SHARED;
/* Cray pointees shouldn't be listed in any clauses and should be
== NULL)
return OMP_CLAUSE_DEFAULT_SHARED;
+ /* Dummy procedures aren't considered variables by OpenMP, thus are
+ disallowed in OpenMP clauses. They are represented as PARM_DECLs
+ in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
+ to avoid complaining about their uses with default(none). */
+ if (TREE_CODE (decl) == PARM_DECL
+ && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
+ return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
+
/* COMMON and EQUIVALENCE decls are shared. They
are only referenced through DECL_VALUE_EXPR of the variables
contained in them. If those are privatized, they will not be
return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
}
+/* Return decl that should be used when reporting DEFAULT(NONE)
+ diagnostics. */
+
+tree
+gfc_omp_report_decl (tree decl)
+{
+ if (DECL_ARTIFICIAL (decl)
+ && DECL_LANG_SPECIFIC (decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (decl))
+ return GFC_DECL_SAVED_DESCRIPTOR (decl);
+
+ return decl;
+}
/* Return true if DECL in private clause needs
OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */
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);
+ 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 (COND_EXPR, void_type_node,
cond, then_b, else_b));
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),
size, NULL, NULL);
gfc_conv_descriptor_data_set (&block, decl, ptr);
- gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false));
+ gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false,
+ false));
stmt = gfc_finish_block (&block);
}
else
- stmt = gfc_trans_assignment (e1, e2, false);
+ stmt = gfc_trans_assignment (e1, e2, false, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
stmtblock_t block;
gfc_start_block (&block);
- gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false));
+ gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false,
+ true));
gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl));
stmt = gfc_finish_block (&block);
}
else
- stmt = gfc_trans_assignment (e3, e4, false);
+ stmt = gfc_trans_assignment (e3, e4, false, true);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
- tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
+ tree omp_clauses = NULL_TREE, chunk_size, c;
int list;
enum omp_clause_code clause_code;
gfc_se se;
default:
gcc_unreachable ();
}
- old_clauses = omp_clauses;
omp_clauses
= gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
where);
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);
return build2 (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 block;
stmtblock_t body;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
- gfc_code *outermost;
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;
- outermost = code = code->block->next;
+ code = code->block->next;
gcc_assert (code->op == EXEC_DO);
init = make_tree_vec (collapse);
{
int simple = 0;
int dovar_found = 0;
+ tree dovar_decl;
if (clauses)
{
gfc_conv_expr_val (&se, code->ext.iterator->step);
gfc_add_block_to_block (pblock, &se.pre);
step = gfc_evaluate_now (se.expr, pblock);
+ dovar_decl = dovar;
/* Special case simple loops. */
- if (integer_onep (step))
- simple = 1;
- else if (tree_int_cst_equal (step, integer_minus_one_node))
- simple = -1;
+ if (TREE_CODE (dovar) == VAR_DECL)
+ {
+ if (integer_onep (step))
+ simple = 1;
+ else if (tree_int_cst_equal (step, integer_minus_one_node))
+ simple = -1;
+ }
+ else
+ dovar_decl
+ = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym);
/* Loop body. */
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));
+ TREE_VEC_ELT (cond, i) = fold_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));
+ TREE_VEC_ELT (cond, i) = fold_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)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
- OMP_CLAUSE_DECL (tmp) = dovar;
+ OMP_CLAUSE_DECL (tmp) = dovar_decl;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
else if (dovar_found == 2)
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)
+ && OMP_CLAUSE_DECL (c) == dovar_decl)
{
OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
break;
{
for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
- && OMP_CLAUSE_DECL (c) == dovar)
+ && OMP_CLAUSE_DECL (c) == dovar_decl)
{
tree l = build_omp_clause (input_location,
OMP_CLAUSE_LASTPRIVATE);
- OMP_CLAUSE_DECL (l) = dovar;
+ OMP_CLAUSE_DECL (l) = dovar_decl;
OMP_CLAUSE_CHAIN (l) = omp_clauses;
OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
omp_clauses = l;
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->block->cycle_label = cycle_label;
+ code->block->exit_label = NULL_TREE;
/* Main loop body. */
tmp = gfc_trans_omp_code (code->block->next, true);
OSDN Git Service
