Skip to content

R
riscv-gcc-1
Commit a0add3be by Mikael Morin
Options

trans.h (struct gfc_ss, [...]): Move field string_length from the former struct to the latter. 

	* trans.h (struct gfc_ss, struct gfc_ss_info): Move field
	string_length from the former struct to the latter.
	* trans-array.c
	(gfc_get_temp_ss, gfc_trans_array_constructor, gfc_add_loop_ss_code,
	gfc_conv_ss_descriptor, gfc_conv_scalarized_array_ref,
	gfc_conv_resolve_dependencies, gfc_conv_loop_setup,
	gfc_conv_expr_descriptor): Update references to string_length and
	factor common reference chains where possible.
	* trans-const.c (gfc_conv_constant): Ditto.
	* trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg,
	gfc_conv_expr): Ditto.

From-SVN: r180869
parent f98cfd3c
Showing with 47 additions and 26 deletions
gcc/fortran/ChangeLog
2011-11-03 Mikael Morin <mikael@gcc.gnu.org> 2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field
string_length from the former struct to the latter.
* trans-array.c
(gfc_get_temp_ss, gfc_trans_array_constructor, gfc_add_loop_ss_code,
gfc_conv_ss_descriptor, gfc_conv_scalarized_array_ref,
gfc_conv_resolve_dependencies, gfc_conv_loop_setup,
gfc_conv_expr_descriptor): Update references to string_length and
factor common reference chains where possible.
* trans-const.c (gfc_conv_constant): Ditto.
* trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg,
gfc_conv_expr): Ditto.
2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from * trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from
the former struct to the latter. the former struct to the latter.
* trans-array.c * trans-array.c
......
gcc/fortran/trans-array.c
...@@ -557,11 +557,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) ...@@ -557,11 +557,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
ss_info = gfc_get_ss_info (); ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_TEMP; ss_info->type = GFC_SS_TEMP;
ss_info->string_length = string_length;
ss = gfc_get_ss (); ss = gfc_get_ss ();
ss->info = ss_info; ss->info = ss_info;
ss->next = gfc_ss_terminator; ss->next = gfc_ss_terminator;
ss->string_length = string_length;
ss->data.temp.type = type; ss->data.temp.type = type;
ss->dimen = dimen; ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++) for (i = 0; i < ss->dimen; i++)
...@@ -1953,6 +1953,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) ...@@ -1953,6 +1953,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
bool dynamic; bool dynamic;
bool old_first_len, old_typespec_chararray_ctor; bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val; tree old_first_len_val;
gfc_ss_info *ss_info;
gfc_expr *expr; gfc_expr *expr;
/* Save the old values for nested checking. */ /* Save the old values for nested checking. */
...@@ -1960,7 +1961,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) ...@@ -1960,7 +1961,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
old_first_len_val = first_len_val; old_first_len_val = first_len_val;
old_typespec_chararray_ctor = typespec_chararray_ctor; old_typespec_chararray_ctor = typespec_chararray_ctor;
expr = ss->info->expr; ss_info = ss->info;
expr = ss_info->expr;
/* Do bounds-checking here and in gfc_trans_array_ctor_element only if no /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
typespec was given for the array constructor. */ typespec was given for the array constructor. */
...@@ -1993,21 +1995,21 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) ...@@ -1993,21 +1995,21 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
gfc_init_se (&length_se, NULL); gfc_init_se (&length_se, NULL);
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node); gfc_charlen_type_node);
ss->string_length = length_se.expr; ss_info->string_length = length_se.expr;
gfc_add_block_to_block (&loop->pre, &length_se.pre); gfc_add_block_to_block (&loop->pre, &length_se.pre);
gfc_add_block_to_block (&loop->post, &length_se.post); gfc_add_block_to_block (&loop->post, &length_se.post);
} }
else else
const_string = get_array_ctor_strlen (&loop->pre, c, const_string = get_array_ctor_strlen (&loop->pre, c,
&ss->string_length); &ss_info->string_length);
/* Complex character array constructors should have been taken care of /* Complex character array constructors should have been taken care of
and not end up here. */ and not end up here. */
gcc_assert (ss->string_length); gcc_assert (ss_info->string_length);
expr->ts.u.cl->backend_decl = ss->string_length; expr->ts.u.cl->backend_decl = ss_info->string_length;
type = gfc_get_character_type_len (expr->ts.kind, ss->string_length); type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length);
if (const_string) if (const_string)
type = build_pointer_type (type); type = build_pointer_type (type);
} }
...@@ -2207,7 +2209,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, ...@@ -2207,7 +2209,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_add_block_to_block (&loop->post, &se.post); gfc_add_block_to_block (&loop->post, &se.post);
ss->data.scalar.expr = se.expr; ss->data.scalar.expr = se.expr;
ss->string_length = se.string_length; ss_info->string_length = se.string_length;
break; break;
case GFC_SS_REFERENCE: case GFC_SS_REFERENCE:
...@@ -2219,7 +2221,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, ...@@ -2219,7 +2221,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_add_block_to_block (&loop->post, &se.post); gfc_add_block_to_block (&loop->post, &se.post);
ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre); ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre);
ss->string_length = se.string_length; ss_info->string_length = se.string_length;
break; break;
case GFC_SS_SECTION: case GFC_SS_SECTION:
...@@ -2254,19 +2256,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, ...@@ -2254,19 +2256,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_conv_expr (&se, expr); gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post); gfc_add_block_to_block (&loop->post, &se.post);
ss->string_length = se.string_length; ss_info->string_length = se.string_length;
break; break;
case GFC_SS_CONSTRUCTOR: case GFC_SS_CONSTRUCTOR:
if (expr->ts.type == BT_CHARACTER if (expr->ts.type == BT_CHARACTER
&& ss->string_length == NULL && ss_info->string_length == NULL
&& expr->ts.u.cl && expr->ts.u.cl
&& expr->ts.u.cl->length) && expr->ts.u.cl->length)
{ {
gfc_init_se (&se, NULL); gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node); gfc_charlen_type_node);
ss->string_length = se.expr; ss_info->string_length = se.expr;
gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->pre, &se.pre);
gfc_add_block_to_block (&loop->post, &se.post); gfc_add_block_to_block (&loop->post, &se.post);
} }
...@@ -2304,7 +2306,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) ...@@ -2304,7 +2306,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
gfc_conv_expr_lhs (&se, ss_info->expr); gfc_conv_expr_lhs (&se, ss_info->expr);
gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (block, &se.pre);
ss->data.info.descriptor = se.expr; ss->data.info.descriptor = se.expr;
ss->string_length = se.string_length; ss_info->string_length = se.string_length;
if (base) if (base)
{ {
...@@ -2697,7 +2699,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) ...@@ -2697,7 +2699,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
void void
gfc_conv_tmp_array_ref (gfc_se * se) gfc_conv_tmp_array_ref (gfc_se * se)
{ {
se->string_length = se->ss->string_length; se->string_length = se->ss->info->string_length;
gfc_conv_scalarized_array_ref (se, NULL); gfc_conv_scalarized_array_ref (se, NULL);
gfc_advance_se_ss_chain (se); gfc_advance_se_ss_chain (se);
} }
...@@ -3899,7 +3901,7 @@ temporary: ...@@ -3899,7 +3901,7 @@ temporary:
if (GFC_ARRAY_TYPE_P (base_type) if (GFC_ARRAY_TYPE_P (base_type)
|| GFC_DESCRIPTOR_TYPE_P (base_type)) || GFC_DESCRIPTOR_TYPE_P (base_type))
base_type = gfc_get_element_type (base_type); base_type = gfc_get_element_type (base_type);
loop->temp_ss = gfc_get_temp_ss (base_type, dest->string_length, loop->temp_ss = gfc_get_temp_ss (base_type, dest->info->string_length,
loop->dimen); loop->dimen);
gfc_add_ss_to_loop (loop, loop->temp_ss); gfc_add_ss_to_loop (loop, loop->temp_ss);
} }
...@@ -4124,11 +4126,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) ...@@ -4124,11 +4126,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
/* Make absolutely sure that this is a complete type. */ /* Make absolutely sure that this is a complete type. */
if (loop->temp_ss->string_length) if (tmp_ss_info->string_length)
loop->temp_ss->data.temp.type loop->temp_ss->data.temp.type
= gfc_get_character_type_len_for_eltype = gfc_get_character_type_len_for_eltype
(TREE_TYPE (loop->temp_ss->data.temp.type), (TREE_TYPE (loop->temp_ss->data.temp.type),
loop->temp_ss->string_length); tmp_ss_info->string_length);
tmp = loop->temp_ss->data.temp.type; tmp = loop->temp_ss->data.temp.type;
memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
...@@ -5973,7 +5975,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) ...@@ -5973,7 +5975,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
: NULL), : NULL),
loop.dimen); loop.dimen);
se->string_length = loop.temp_ss->string_length; se->string_length = loop.temp_ss->info->string_length;
gcc_assert (loop.temp_ss->dimen == loop.dimen); gcc_assert (loop.temp_ss->dimen == loop.dimen);
gfc_add_ss_to_loop (&loop, loop.temp_ss); gfc_add_ss_to_loop (&loop, loop.temp_ss);
} }
...@@ -6030,7 +6032,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) ...@@ -6030,7 +6032,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss))
{ {
desc = info->descriptor; desc = info->descriptor;
se->string_length = ss->string_length; se->string_length = ss_info->string_length;
} }
else else
{ {
......
gcc/fortran/trans-const.c
...@@ -393,7 +393,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) ...@@ -393,7 +393,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
gcc_assert (ss_info->expr == expr); gcc_assert (ss_info->expr == expr);
se->expr = se->ss->data.scalar.expr; se->expr = se->ss->data.scalar.expr;
se->string_length = se->ss->string_length; se->string_length = ss_info->string_length;
gfc_advance_se_ss_chain (se); gfc_advance_se_ss_chain (se);
return; return;
} }
......
gcc/fortran/trans-expr.c
...@@ -626,13 +626,15 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) ...@@ -626,13 +626,15 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
ss = se->ss; ss = se->ss;
if (ss != NULL) if (ss != NULL)
{ {
gfc_ss_info *ss_info = ss->info;
/* Check that something hasn't gone horribly wrong. */ /* Check that something hasn't gone horribly wrong. */
gcc_assert (ss != gfc_ss_terminator); gcc_assert (ss != gfc_ss_terminator);
gcc_assert (ss->info->expr == expr); gcc_assert (ss_info->expr == expr);
/* A scalarized term. We already know the descriptor. */ /* A scalarized term. We already know the descriptor. */
se->expr = se->ss->data.info.descriptor; se->expr = se->ss->data.info.descriptor;
se->string_length = se->ss->string_length; se->string_length = ss_info->string_length;
for (ref = se->ss->data.info.ref; ref; ref = ref->next) for (ref = se->ss->data.info.ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break; break;
...@@ -2402,7 +2404,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, ...@@ -2402,7 +2404,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
: NULL), : NULL),
loop.dimen); loop.dimen);
parmse->string_length = loop.temp_ss->string_length; parmse->string_length = loop.temp_ss->info->string_length;
/* Associate the SS with the loop. */ /* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, loop.temp_ss); gfc_add_ss_to_loop (&loop, loop.temp_ss);
...@@ -4833,12 +4835,15 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) ...@@ -4833,12 +4835,15 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
&& (ss->info->type == GFC_SS_SCALAR && (ss->info->type == GFC_SS_SCALAR
|| ss->info->type == GFC_SS_REFERENCE)) || ss->info->type == GFC_SS_REFERENCE))
{ {
gfc_ss_info *ss_info;
ss_info = ss->info;
/* Substitute a scalar expression evaluated outside the scalarization /* Substitute a scalar expression evaluated outside the scalarization
loop. */ loop. */
se->expr = se->ss->data.scalar.expr; se->expr = se->ss->data.scalar.expr;
if (ss->info->type == GFC_SS_REFERENCE) if (ss_info->type == GFC_SS_REFERENCE)
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); 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); gfc_advance_se_ss_chain (se);
return; return;
} }
......
gcc/fortran/trans.h
...@@ -187,6 +187,7 @@ typedef struct gfc_ss_info ...@@ -187,6 +187,7 @@ typedef struct gfc_ss_info
{ {
gfc_ss_type type; gfc_ss_type type;
gfc_expr *expr; gfc_expr *expr;
tree string_length;
} }
gfc_ss_info; gfc_ss_info;
...@@ -205,7 +206,6 @@ typedef struct gfc_ss ...@@ -205,7 +206,6 @@ typedef struct gfc_ss
{ {
gfc_ss_info *info; gfc_ss_info *info;
tree string_length;
union union
{ {
/* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */
......
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