Skip to content

R
riscv-gcc-1
Commit 2c69df3b by Tobias Burnus
Options

trans.h (gfc_caf_get_image_index, [...]): New prototypes. 

2014-08-30  Tobias Burnus  <burnus@net-b.de>

        * trans.h (gfc_caf_get_image_index,
        gfc_get_caf_token_offset): New prototypes.
        * trans-expr.c (gfc_caf_get_image_index): Moved from
        trans-intrinsic.c and renamed.
        (gfc_get_caf_token_offset) Ditto; support offset = NULL
        with early return.
        * trans-intrinsic.c (get_caf_token_offset, caf_get_image_index):
        Moved to trans-expr.
        (gfc_conv_intrinsic_caf_get, conv_caf_send,
        conv_intrinsic_atomic_op, conv_intrinsic_atomic_ref,
        conv_intrinsic_atomic_cas): Update callers.

From-SVN: r214758
parent e284dec5
Showing with 159 additions and 152 deletions
gcc/fortran/trans-expr.c
......@@ -1444,6 +1444,149 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
}
/* Obtain the Coarray token - and optionally also the offset. */
void
gfc_get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr,
gfc_expr *expr)
{
tree tmp;
/* Coarray token. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
{
gcc_assert (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))
== GFC_ARRAY_ALLOCATABLE
|| expr->symtree->n.sym->attr.select_type_temporary);
*token = gfc_conv_descriptor_token (caf_decl);
}
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
*token = GFC_DECL_TOKEN (caf_decl);
else
{
gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (caf_decl))
&& GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (caf_decl)) != NULL_TREE);
*token = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (caf_decl));
}
if (offset == NULL)
return;
/* Offset between the coarray base address and the address wanted. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))
&& (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE
|| GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_POINTER))
*offset = build_int_cst (gfc_array_index_type, 0);
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
*offset = GFC_DECL_CAF_OFFSET (caf_decl);
else if (GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl)) != NULL_TREE)
*offset = GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl));
else
*offset = build_int_cst (gfc_array_index_type, 0);
if (POINTER_TYPE_P (TREE_TYPE (se_expr))
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se_expr))))
{
tmp = build_fold_indirect_ref_loc (input_location, se_expr);
tmp = gfc_conv_descriptor_data_get (tmp);
}
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se_expr)))
tmp = gfc_conv_descriptor_data_get (se_expr);
else
{
gcc_assert (POINTER_TYPE_P (TREE_TYPE (se_expr)));
tmp = se_expr;
}
*offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
*offset, fold_convert (gfc_array_index_type, tmp));
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
tmp = gfc_conv_descriptor_data_get (caf_decl);
else
{
gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
tmp = caf_decl;
}
*offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, *offset),
fold_convert (gfc_array_index_type, tmp));
}
/* Convert the coindex of a coarray into an image index; the result is
image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2)+1)*extent(1)
+ (idx(3)-lcobound(3)+1)*extent(2) + ... */
tree
gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc)
{
gfc_ref *ref;
tree lbound, ubound, extent, tmp, img_idx;
gfc_se se;
int i;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
break;
gcc_assert (ref != NULL);
img_idx = integer_zero_node;
extent = integer_one_node;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, ref->u.ar.start[i], integer_type_node);
gfc_add_block_to_block (block, &se.pre);
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, se.expr,
fold_convert(integer_type_node, lbound));
tmp = fold_build2_loc (input_location, MULT_EXPR, integer_type_node,
extent, tmp);
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
img_idx, tmp);
if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
{
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
extent = fold_convert (integer_type_node, extent);
}
}
else
for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, ref->u.ar.start[i], integer_type_node);
gfc_add_block_to_block (block, &se.pre);
lbound = GFC_TYPE_ARRAY_LBOUND (TREE_TYPE (desc), i);
lbound = fold_convert (integer_type_node, lbound);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, se.expr, lbound);
tmp = fold_build2_loc (input_location, MULT_EXPR, integer_type_node,
extent, tmp);
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
img_idx, tmp);
if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
{
ubound = GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (desc), i);
ubound = fold_convert (integer_type_node, ubound);
extent = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, ubound, lbound);
extent = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
extent, integer_one_node);
}
}
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
img_idx, integer_one_node);
return img_idx;
}
/* For each character array constructor subexpression without a ts.u.cl->length,
replace it by its first element (if there aren't any elements, the length
should already be set to zero). */
......
gcc/fortran/trans-intrinsic.c
......@@ -926,76 +926,6 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
}
/* Convert the coindex of a coarray into an image index; the result is
image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2)+1)*extent(1)
+ (idx(3)-lcobound(3)+1)*extent(2) + ... */
static tree
caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc)
{
gfc_ref *ref;
tree lbound, ubound, extent, tmp, img_idx;
gfc_se se;
int i;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
break;
gcc_assert (ref != NULL);
img_idx = integer_zero_node;
extent = integer_one_node;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, ref->u.ar.start[i], integer_type_node);
gfc_add_block_to_block (block, &se.pre);
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, se.expr,
fold_convert(integer_type_node, lbound));
tmp = fold_build2_loc (input_location, MULT_EXPR, integer_type_node,
extent, tmp);
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
img_idx, tmp);
if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
{
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
extent = fold_convert (integer_type_node, extent);
}
}
else
for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, ref->u.ar.start[i], integer_type_node);
gfc_add_block_to_block (block, &se.pre);
lbound = GFC_TYPE_ARRAY_LBOUND (TREE_TYPE (desc), i);
lbound = fold_convert (integer_type_node, lbound);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, se.expr, lbound);
tmp = fold_build2_loc (input_location, MULT_EXPR, integer_type_node,
extent, tmp);
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
img_idx, tmp);
if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
{
ubound = GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (desc), i);
ubound = fold_convert (integer_type_node, ubound);
extent = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, ubound, lbound);
extent = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
extent, integer_one_node);
}
}
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
img_idx, integer_one_node);
return img_idx;
}
/* Fill in the following structure
struct caf_vector_t {
size_t nvec; // size of the vector
......@@ -1153,74 +1083,6 @@ conv_caf_vector_subscript (stmtblock_t *block, tree desc, gfc_array_ref *ar)
}
static void
get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr,
gfc_expr *expr)
{
tree tmp;
/* Coarray token. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
{
gcc_assert (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))
== GFC_ARRAY_ALLOCATABLE
|| expr->symtree->n.sym->attr.select_type_temporary);
*token = gfc_conv_descriptor_token (caf_decl);
}
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
*token = GFC_DECL_TOKEN (caf_decl);
else
{
gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (caf_decl))
&& GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (caf_decl)) != NULL_TREE);
*token = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (caf_decl));
}
/* Offset between the coarray base address and the address wanted. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))
&& (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE
|| GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_POINTER))
*offset = build_int_cst (gfc_array_index_type, 0);
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
*offset = GFC_DECL_CAF_OFFSET (caf_decl);
else if (GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl)) != NULL_TREE)
*offset = GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl));
else
*offset = build_int_cst (gfc_array_index_type, 0);
if (POINTER_TYPE_P (TREE_TYPE (se_expr))
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se_expr))))
{
tmp = build_fold_indirect_ref_loc (input_location, se_expr);
tmp = gfc_conv_descriptor_data_get (tmp);
}
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se_expr)))
tmp = gfc_conv_descriptor_data_get (se_expr);
else
{
gcc_assert (POINTER_TYPE_P (TREE_TYPE (se_expr)));
tmp = se_expr;
}
*offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
*offset, fold_convert (gfc_array_index_type, tmp));
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
tmp = gfc_conv_descriptor_data_get (caf_decl);
else
{
gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
tmp = caf_decl;
}
*offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, *offset),
fold_convert (gfc_array_index_type, tmp));
}
/* Get data from a remote coarray. */
static void
......@@ -1328,8 +1190,8 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind)
caf_decl = gfc_get_tree_for_caf_expr (array_expr);
if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
image_index = caf_get_image_index (&se->pre, array_expr, caf_decl);
get_caf_token_offset (&token, &offset, caf_decl, argse.expr, array_expr);
image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl);
gfc_get_caf_token_offset (&token, &offset, caf_decl, argse.expr, array_expr);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 8,
token, offset, image_index, argse.expr, vec,
......@@ -1425,8 +1287,8 @@ conv_caf_send (gfc_code *code) {
caf_decl = gfc_get_tree_for_caf_expr (lhs_expr);
if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
image_index = caf_get_image_index (&block, lhs_expr, caf_decl);
get_caf_token_offset (&token, &offset, caf_decl, lhs_se.expr, lhs_expr);
image_index = gfc_caf_get_image_index (&block, lhs_expr, caf_decl);
gfc_get_caf_token_offset (&token, &offset, caf_decl, lhs_se.expr, lhs_expr);
/* RHS. */
gfc_init_se (&rhs_se, NULL);
......@@ -1490,9 +1352,9 @@ conv_caf_send (gfc_code *code) {
caf_decl = gfc_get_tree_for_caf_expr (rhs_expr);
if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
rhs_image_index = caf_get_image_index (&block, rhs_expr, caf_decl);
get_caf_token_offset (&rhs_token, &rhs_offset, caf_decl, rhs_se.expr,
rhs_expr);
rhs_image_index = gfc_caf_get_image_index (&block, rhs_expr, caf_decl);
gfc_get_caf_token_offset (&rhs_token, &rhs_offset, caf_decl, rhs_se.expr,
rhs_expr);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget, 12,
token, offset, image_index, lhs_se.expr, vec,
rhs_token, rhs_offset, rhs_image_index,
......@@ -5908,7 +5770,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
if (arg->ts.type == BT_ASSUMED)
{
/* This only works if an array descriptor has been passed; thus, extract
the size from the descriptor. */
the size from the descriptor. */
gcc_assert (TYPE_PRECISION (gfc_array_index_type)
== TYPE_PRECISION (size_type_node));
tmp = arg->symtree->n.sym->backend_decl;
......@@ -8519,7 +8381,7 @@ conv_intrinsic_atomic_op (gfc_code *code)
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
if (gfc_is_coindexed (atom_expr))
image_index = caf_get_image_index (&block, atom_expr, caf_decl);
image_index = gfc_caf_get_image_index (&block, atom_expr, caf_decl);
else
image_index = integer_zero_node;
......@@ -8530,7 +8392,7 @@ conv_intrinsic_atomic_op (gfc_code *code)
value = gfc_build_addr_expr (NULL_TREE, tmp);
}
get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
if (code->resolved_isym->id == GFC_ISYM_ATOMIC_DEF)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_atomic_def, 7,
......@@ -8672,11 +8534,11 @@ conv_intrinsic_atomic_ref (gfc_code *code)
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
if (gfc_is_coindexed (atom_expr))
image_index = caf_get_image_index (&block, atom_expr, caf_decl);
image_index = gfc_caf_get_image_index (&block, atom_expr, caf_decl);
else
image_index = integer_zero_node;
get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
/* Different type, need type conversion. */
if (!POINTER_TYPE_P (TREE_TYPE (value)))
......@@ -8790,7 +8652,7 @@ conv_intrinsic_atomic_cas (gfc_code *code)
caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
if (gfc_is_coindexed (atom_expr))
image_index = caf_get_image_index (&block, atom_expr, caf_decl);
image_index = gfc_caf_get_image_index (&block, atom_expr, caf_decl);
else
image_index = integer_zero_node;
......@@ -8809,7 +8671,7 @@ conv_intrinsic_atomic_cas (gfc_code *code)
comp = gfc_build_addr_expr (NULL_TREE, tmp);
}
get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_atomic_cas, 9,
token, offset, image_index, old, comp, new_val,
......
gcc/fortran/trans.h
......@@ -420,6 +420,8 @@ tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr);
tree gfc_string_to_single_character (tree len, tree str, int kind);
tree gfc_get_tree_for_caf_expr (gfc_expr *);
void gfc_get_caf_token_offset (tree *, tree *, tree, tree, gfc_expr *);
tree gfc_caf_get_image_index (stmtblock_t *, gfc_expr *, tree);
/* Find the decl containing the auxiliary variables for assigned variables. */
void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment