gfc_advance_se_ss_chain (gfc_se * se)
{
gfc_se *p;
+ gfc_ss *ss;
gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
while (p != NULL)
{
/* Simple consistency check. */
- gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
+ gcc_assert (p->parent == NULL || p->parent->ss == p->ss
+ || p->parent->ss->nested_ss == p->ss);
+
+ /* If we were in a nested loop, the next scalarized expression can be
+ on the parent ss' next pointer. Thus we should not take the next
+ pointer blindly, but rather go up one nest level as long as next
+ is the end of chain. */
+ ss = p->ss;
+ while (ss->next == gfc_ss_terminator && ss->parent != NULL)
+ ss = ss->parent;
- p->ss = p->ss->next;
+ p->ss = ss->next;
p = p->parent;
}
se->string_length = tmp;
}
- if (((c->attr.pointer || c->attr.allocatable) && c->attr.dimension == 0
+ if (((c->attr.pointer || c->attr.allocatable)
+ && (!c->attr.dimension && !c->attr.codimension)
&& c->ts.type != BT_CHARACTER)
|| c->attr.proc_pointer)
se->expr = build_fold_indirect_ref_loc (input_location,
static void
gfc_conv_variable (gfc_se * se, gfc_expr * expr)
{
+ gfc_ss *ss;
gfc_ref *ref;
gfc_symbol *sym;
tree parent_decl = NULL_TREE;
bool entry_master;
sym = expr->symtree->n.sym;
- if (se->ss != NULL)
+ ss = se->ss;
+ if (ss != NULL)
{
+ gfc_ss_info *ss_info = ss->info;
+
/* Check that something hasn't gone horribly wrong. */
- gcc_assert (se->ss != gfc_ss_terminator);
- gcc_assert (se->ss->expr == expr);
+ gcc_assert (ss != gfc_ss_terminator);
+ gcc_assert (ss_info->expr == expr);
/* A scalarized term. We already know the descriptor. */
- se->expr = se->ss->data.info.descriptor;
- se->string_length = se->ss->string_length;
- for (ref = se->ss->data.info.ref; ref; ref = ref->next)
+ se->expr = ss_info->data.array.descriptor;
+ se->string_length = ss_info->string_length;
+ for (ref = ss_info->data.array.ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
}
switch (kind)
{
case 0:
- fndecl = built_in_decls[BUILT_IN_POWIF];
+ fndecl = builtin_decl_explicit (BUILT_IN_POWIF);
break;
case 1:
- fndecl = built_in_decls[BUILT_IN_POWI];
+ fndecl = builtin_decl_explicit (BUILT_IN_POWI);
break;
case 2:
- fndecl = built_in_decls[BUILT_IN_POWIL];
+ fndecl = builtin_decl_explicit (BUILT_IN_POWIL);
break;
case 3:
/* Use the __builtin_powil() only if real(kind=16) is
actually the C long double type. */
if (!gfc_real16_is_float128)
- fndecl = built_in_decls[BUILT_IN_POWIL];
+ fndecl = builtin_decl_explicit (BUILT_IN_POWIL);
break;
default:
gfc_ss *rss;
gfc_loopinfo loop;
gfc_loopinfo loop2;
- gfc_ss_info *info;
+ gfc_array_info *info;
tree offset;
tree tmp_index;
tree tmp;
|| GFC_DESCRIPTOR_TYPE_P (base_type))
base_type = gfc_get_element_type (base_type);
- loop.temp_ss = gfc_get_ss ();;
- loop.temp_ss->type = GFC_SS_TEMP;
- loop.temp_ss->data.temp.type = base_type;
-
- if (expr->ts.type == BT_CHARACTER)
- loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;
- else
- loop.temp_ss->string_length = NULL;
+ loop.temp_ss = gfc_get_temp_ss (base_type, ((expr->ts.type == BT_CHARACTER)
+ ? expr->ts.u.cl->backend_decl
+ : NULL),
+ loop.dimen);
- parmse->string_length = loop.temp_ss->string_length;
- loop.temp_ss->data.temp.dimen = loop.dimen;
- loop.temp_ss->next = gfc_ss_terminator;
+ parmse->string_length = loop.temp_ss->info->string_length;
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, loop.temp_ss);
gfc_conv_loop_setup (&loop, &expr->where);
/* Pass the temporary descriptor back to the caller. */
- info = &loop.temp_ss->data.info;
+ info = &loop.temp_ss->info->data.array;
parmse->expr = info->descriptor;
/* Setup the gfc_se structures. */
dimensions, so this is very simple. The offset is only computed
outside the innermost loop, so the overall transfer could be
optimized further. */
- info = &rse.ss->data.info;
- dimen = info->dimen;
+ info = &rse.ss->info->data.array;
+ dimen = rse.ss->dimen;
tmp_index = gfc_index_zero_node;
for (n = dimen - 1; n > 0; n--)
tree fntype;
gfc_se parmse;
gfc_ss *argss;
- gfc_ss_info *info;
+ gfc_array_info *info;
int byref;
int parm_kind;
tree type;
{
if (!sym->attr.elemental)
{
- gcc_assert (se->ss->type == GFC_SS_FUNCTION);
- if (se->ss->useflags)
+ gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
+ if (se->ss->info->useflags)
{
gcc_assert ((!comp && gfc_return_by_reference (sym)
&& sym->result->attr.dimension)
return 0;
}
}
- info = &se->ss->data.info;
+ info = &se->ss->info->data.array;
}
else
info = NULL;
gfc_init_se (&parmse, se);
gfc_conv_derived_to_class (&parmse, e, fsym->ts);
}
- else if (se->ss && se->ss->useflags)
+ else if (se->ss && se->ss->info->useflags)
{
/* An elemental function inside a scalarized loop. */
gfc_init_se (&parmse, se);
else
goto end_pointer_check;
+ tmp = parmse.expr;
+
+ /* If the argument is passed by value, we need to strip the
+ INDIRECT_REF. */
+ if (!POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
cond = fold_build2_loc (input_location, EQ_EXPR,
- boolean_type_node, parmse.expr,
- fold_convert (TREE_TYPE (parmse.expr),
+ boolean_type_node, tmp,
+ fold_convert (TREE_TYPE (tmp),
null_pointer_node));
}
if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
VEC_safe_push (tree, gc, stringargs, parmse.string_length);
- /* For descriptorless coarrays, we pass the token and the offset
- as additional arguments. */
+ /* For descriptorless coarrays and assumed-shape coarray dummies, we
+ pass the token and the offset as additional arguments. */
if (fsym && fsym->attr.codimension
&& gfc_option.coarray == GFC_FCOARRAY_LIB
- && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE
+ && !fsym->attr.allocatable
&& e == NULL)
{
/* Token and offset. */
gcc_assert (fsym->attr.optional);
}
else if (fsym && fsym->attr.codimension
- && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE
+ && !fsym->attr.allocatable
&& gfc_option.coarray == GFC_FCOARRAY_LIB)
{
tree caf_decl, caf_type;
caf_decl = get_tree_for_caf_expr (e);
caf_type = TREE_TYPE (caf_decl);
- if (GFC_DESCRIPTOR_TYPE_P (caf_type))
+ if (GFC_DESCRIPTOR_TYPE_P (caf_type)
+ && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
tmp = gfc_conv_descriptor_token (caf_decl);
+ else if (DECL_LANG_SPECIFIC (caf_decl)
+ && GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
+ tmp = GFC_DECL_TOKEN (caf_decl);
else
{
gcc_assert (GFC_ARRAY_TYPE_P (caf_type)
VEC_safe_push (tree, gc, stringargs, tmp);
- if (GFC_DESCRIPTOR_TYPE_P (caf_type))
+ if (GFC_DESCRIPTOR_TYPE_P (caf_type)
+ && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
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 (caf_type) != NULL_TREE)
offset = GFC_TYPE_ARRAY_CAF_OFFSET (caf_type);
else
tmp = caf_decl;
}
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr)))
+ if (fsym->as->type == AS_ASSUMED_SHAPE)
+ {
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE
+ (TREE_TYPE (parmse.expr))));
+ tmp2 = build_fold_indirect_ref_loc (input_location, parmse.expr);
+ tmp2 = gfc_conv_descriptor_data_get (tmp2);
+ }
+ else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr)))
tmp2 = gfc_conv_descriptor_data_get (parmse.expr);
else
{
/* Set the type of the array. */
tmp = gfc_typenode_for_spec (&comp->ts);
- info->dimen = se->loop->dimen;
+ gcc_assert (se->ss->dimen == se->loop->dimen);
/* Evaluate the bounds of the result, if known. */
gfc_set_loop_bounds_from_array_spec (&mapping, se, comp->as);
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- NULL_TREE, false, !comp->attr.pointer,
- callee_alloc, &se->ss->expr->where);
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
+ tmp, NULL_TREE, false,
+ !comp->attr.pointer, callee_alloc,
+ &se->ss->info->expr->where);
/* Pass the temporary as the first argument. */
result = info->descriptor;
/* Set the type of the array. */
tmp = gfc_typenode_for_spec (&ts);
- info->dimen = se->loop->dimen;
+ gcc_assert (se->ss->dimen == se->loop->dimen);
/* Evaluate the bounds of the result, if known. */
gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as);
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
- gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- NULL_TREE, false, !sym->attr.pointer,
- callee_alloc, &se->ss->expr->where);
+ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
+ tmp, NULL_TREE, false,
+ !sym->attr.pointer, callee_alloc,
+ &se->ss->info->expr->where);
/* Pass the temporary as the first argument. */
result = info->descriptor;
/* For a simple char type, we can call memset(). */
if (compare_tree_int (TYPE_SIZE_UNIT (type), 1) == 0)
return build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMSET], 3, start,
+ builtin_decl_explicit (BUILT_IN_MEMSET),
+ 3, start,
build_int_cst (gfc_get_int_type (gfc_c_int_kind),
lang_hooks.to_target_charset (' ')),
size);
cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen,
dlen);
tmp2 = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMMOVE],
- 3, dest, src, dlen);
+ builtin_decl_explicit (BUILT_IN_MEMMOVE),
+ 3, dest, src, dlen);
/* Else copy and pad with spaces. */
tmp3 = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMMOVE],
- 3, dest, src, slen);
+ builtin_decl_explicit (BUILT_IN_MEMMOVE),
+ 3, dest, src, slen);
tmp4 = fold_build_pointer_plus_loc (input_location, dest, slen);
tmp4 = fill_with_spaces (tmp4, chartype,
static void
gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr)
{
- gcc_assert (se->ss != NULL && se->ss != gfc_ss_terminator);
- gcc_assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR);
+ gfc_ss *ss;
+
+ ss = se->ss;
+ gcc_assert (ss != NULL && ss != gfc_ss_terminator);
+ gcc_assert (ss->info->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR);
gfc_conv_tmp_array_ref (se);
}
gfc_se lse;
gfc_ss *rss;
gfc_ss *lss;
+ gfc_array_info *lss_array;
stmtblock_t body;
stmtblock_t block;
gfc_loopinfo loop;
/* Walk the rhs. */
rss = gfc_walk_expr (expr);
if (rss == gfc_ss_terminator)
- {
- /* The rhs is scalar. Add a ss for the expression. */
- rss = gfc_get_ss ();
- rss->next = gfc_ss_terminator;
- rss->type = GFC_SS_SCALAR;
- rss->expr = expr;
- }
+ /* The rhs is scalar. Add a ss for the expression. */
+ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr);
/* Create a SS for the destination. */
- lss = gfc_get_ss ();
- lss->type = GFC_SS_COMPONENT;
- lss->expr = NULL;
- lss->shape = gfc_get_shape (cm->as->rank);
- lss->next = gfc_ss_terminator;
- lss->data.info.dimen = cm->as->rank;
- lss->data.info.descriptor = dest;
- lss->data.info.data = gfc_conv_array_data (dest);
- lss->data.info.offset = gfc_conv_array_offset (dest);
+ lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank,
+ GFC_SS_COMPONENT);
+ lss_array = &lss->info->data.array;
+ lss_array->shape = gfc_get_shape (cm->as->rank);
+ lss_array->descriptor = dest;
+ lss_array->data = gfc_conv_array_data (dest);
+ lss_array->offset = gfc_conv_array_offset (dest);
for (n = 0; n < cm->as->rank; n++)
{
- lss->data.info.dim[n] = n;
- lss->data.info.start[n] = gfc_conv_array_lbound (dest, n);
- lss->data.info.stride[n] = gfc_index_one_node;
+ lss_array->start[n] = gfc_conv_array_lbound (dest, n);
+ lss_array->stride[n] = gfc_index_one_node;
- mpz_init (lss->shape[n]);
- mpz_sub (lss->shape[n], cm->as->upper[n]->value.integer,
+ mpz_init (lss_array->shape[n]);
+ mpz_sub (lss_array->shape[n], cm->as->upper[n]->value.integer,
cm->as->lower[n]->value.integer);
- mpz_add_ui (lss->shape[n], lss->shape[n], 1);
+ mpz_add_ui (lss_array->shape[n], lss_array->shape[n], 1);
}
/* Associate the SS with the loop. */
gfc_add_block_to_block (&block, &loop.pre);
gfc_add_block_to_block (&block, &loop.post);
- for (n = 0; n < cm->as->rank; n++)
- mpz_clear (lss->shape[n]);
- free (lss->shape);
-
+ gcc_assert (lss_array->shape != NULL);
+ gfc_free_shape (&lss_array->shape, cm->as->rank);
gfc_cleanup_loop (&loop);
return gfc_finish_block (&block);
void
gfc_conv_expr (gfc_se * se, gfc_expr * expr)
{
- if (se->ss && se->ss->expr == expr
- && (se->ss->type == GFC_SS_SCALAR || se->ss->type == GFC_SS_REFERENCE))
+ gfc_ss *ss;
+
+ ss = se->ss;
+ if (ss && ss->info->expr == expr
+ && (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE))
{
+ gfc_ss_info *ss_info;
+
+ ss_info = ss->info;
/* Substitute a scalar expression evaluated outside the scalarization
loop. */
- se->expr = se->ss->data.scalar.expr;
- if (se->ss->type == GFC_SS_REFERENCE)
+ se->expr = ss_info->data.scalar.value;
+ if (ss_info->type == GFC_SS_REFERENCE)
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
- se->string_length = se->ss->string_length;
+ se->string_length = ss_info->string_length;
gfc_advance_se_ss_chain (se);
return;
}
void
gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
{
+ gfc_ss *ss;
tree var;
- if (se->ss && se->ss->expr == expr
- && se->ss->type == GFC_SS_REFERENCE)
+ ss = se->ss;
+ if (ss && ss->info->expr == expr
+ && ss->info->type == GFC_SS_REFERENCE)
{
/* Returns a reference to the scalar evaluated outside the loop
for this case. */
/* Construct call to __builtin_memset. */
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMSET],
- 3, dest, integer_zero_node, len);
+ builtin_decl_explicit (BUILT_IN_MEMSET),
+ 3, dest, integer_zero_node, len);
return fold_convert (void_type_node, tmp);
}
/* Construct call to __builtin_memcpy. */
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMCPY], 3, dst, src, len);
+ builtin_decl_explicit (BUILT_IN_MEMCPY),
+ 3, dst, src, len);
return fold_convert (void_type_node, tmp);
}
}
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MALLOC], 1,
- size_in_bytes);
+ builtin_decl_explicit (BUILT_IN_MALLOC),
+ 1, size_in_bytes);
tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
gfc_add_modify (block, lse.expr, tmp);
if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp);
tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_REALLOC], 2,
- fold_convert (pvoid_type_node, lse.expr),
+ builtin_decl_explicit (BUILT_IN_REALLOC),
+ 2, fold_convert (pvoid_type_node, lse.expr),
size_in_bytes);
tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
gfc_add_modify (block, lse.expr, tmp);
/* Find a non-scalar SS from the lhs. */
while (lss_section != gfc_ss_terminator
- && lss_section->type != GFC_SS_SECTION)
+ && lss_section->info->type != GFC_SS_SECTION)
lss_section = lss_section->next;
gcc_assert (lss_section != gfc_ss_terminator);
/* Walk the rhs. */
rss = gfc_walk_expr (expr2);
if (rss == gfc_ss_terminator)
- {
- /* The rhs is scalar. Add a ss for the expression. */
- rss = gfc_get_ss ();
- rss->next = gfc_ss_terminator;
- rss->type = GFC_SS_SCALAR;
- rss->expr = expr2;
- }
+ /* The rhs is scalar. Add a ss for the expression. */
+ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
+
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, lss);
gfc_add_ss_to_loop (&loop, rss);
OSDN Git Service
