mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-24 00:59:38 +08:00
Code Issues Packages Projects Releases Wiki Activity

trans.h (struct gfc_ss_info): New struct.

Browse Source 
* trans.h (struct gfc_ss_info): New struct.
	(gfc_get_ss_info): New macro.
	(struct gfc_ss): Move type field to struct gfc_ss_info.
	Add an info field of type gfc_ss_info.
	* trans-array.c (free_ss_info): New function.
	(gfc_free_ss): Call free_ss_info.
	(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss):
	Allocate gfc_ss_info field.
	(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss,
	gfc_set_vector_loop_bounds, gfc_add_loop_ss_code,
	gfc_conv_array_index_offset, gfc_trans_preloop_setup,
	gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride,
	gfc_conv_ss_startstride, gfc_conv_resolve_dependencies,
	gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor,
	gfc_walk_elemental_function_args): Update references to type.
	* trans-const.c (gfc_conv_constant): Factor common reference chains
	and update reference to type.
	* trans-expr.c (gfc_conv_procedure_call, gfc_trans_assignment_1):
	Update reference to type.
	(gfc_conv_array_constructor_expr, gfc_conv_expr,
	gfc_conv_expr_reference): Ditto. Factor common reference chains.
	* trans-intrinsic.c (walk_inline_intrinsic_transpose): Update references
	to type
	* trans-stmt.c (gfc_trans_where_assign): Ditto.

From-SVN: r180867
This commit is contained in:
Mikael Morin 2011-11-03 21:55:48 +00:00
parent 08dcec6137
commit bcc4d4e089
7 changed files with 141 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/fortran/ChangeLog
View File

@ -1,3 +1,30 @@
2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss_info): New struct.
(gfc_get_ss_info): New macro.
(struct gfc_ss): Move type field to struct gfc_ss_info.
Add an info field of type gfc_ss_info.
* trans-array.c (free_ss_info): New function.
(gfc_free_ss): Call free_ss_info.
(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss):
Allocate gfc_ss_info field.
(gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss,
gfc_set_vector_loop_bounds, gfc_add_loop_ss_code,
gfc_conv_array_index_offset, gfc_trans_preloop_setup,
gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride,
gfc_conv_ss_startstride, gfc_conv_resolve_dependencies,
gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor,
gfc_walk_elemental_function_args): Update references to type.
* trans-const.c (gfc_conv_constant): Factor common reference chains
and update reference to type.
* trans-expr.c (gfc_conv_procedure_call, gfc_trans_assignment_1):
Update reference to type.
(gfc_conv_array_constructor_expr, gfc_conv_expr,
gfc_conv_expr_reference): Ditto. Factor common reference chains.
* trans-intrinsic.c (walk_inline_intrinsic_transpose): Update references
to type
* trans-stmt.c (gfc_trans_where_assign): Ditto.
2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
* trans.h (struct gfc_ss, struct gfc_array_info): Move shape field

113
gcc/fortran/trans-array.c
View File

@ -486,14 +486,24 @@ gfc_free_ss_chain (gfc_ss * ss)
}
static void
free_ss_info (gfc_ss_info *ss_info)
{
free (ss_info);
}
/* Free a SS. */
static void
gfc_free_ss (gfc_ss * ss)
{
gfc_ss_info *ss_info;
int n;
switch (ss->type)
ss_info = ss->info;
switch (ss_info->type)
{
case GFC_SS_SECTION:
for (n = 0; n < ss->dimen; n++)
@ -507,6 +517,7 @@ gfc_free_ss (gfc_ss * ss)
break;
}
free_ss_info (ss_info);
free (ss);
}
@ -517,11 +528,15 @@ gfc_ss *
gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
{
gfc_ss *ss;
gfc_ss_info *ss_info;
int i;
ss_info = gfc_get_ss_info ();
ss_info->type = type;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = next;
ss->type = type;
ss->expr = expr;
ss->dimen = dimen;
for (i = 0; i < ss->dimen; i++)
@ -537,11 +552,15 @@ gfc_ss *
gfc_get_temp_ss (tree type, tree string_length, int dimen)
{
gfc_ss *ss;
gfc_ss_info *ss_info;
int i;
ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_TEMP;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = gfc_ss_terminator;
ss->type = GFC_SS_TEMP;
ss->string_length = string_length;
ss->data.temp.type = type;
ss->dimen = dimen;
@ -558,10 +577,14 @@ gfc_ss *
gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
{
gfc_ss *ss;
gfc_ss_info *ss_info;
ss_info = gfc_get_ss_info ();
ss_info->type = GFC_SS_SCALAR;
ss = gfc_get_ss ();
ss->info = ss_info;
ss->next = next;
ss->type = GFC_SS_SCALAR;
ss->expr = expr;
return ss;
@ -2118,7 +2141,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
difference between the vector's upper and lower bounds. */
gcc_assert (loop->from[n] == gfc_index_zero_node);
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->type == GFC_SS_VECTOR);
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
gfc_init_se (&se, NULL);
desc = info->subscript[dim]->data.info.descriptor;
@ -2153,7 +2176,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
{
gcc_assert (ss);
switch (ss->type)
switch (ss->info->type)
{
case GFC_SS_SCALAR:
/* Scalar expression. Evaluate this now. This includes elemental
@ -2533,7 +2556,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
case DIMEN_ELEMENT:
/* Elemental dimension. */
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->type == GFC_SS_SCALAR);
&& info->subscript[dim]->info->type == GFC_SS_SCALAR);
/* We've already translated this value outside the loop. */
index = info->subscript[dim]->data.scalar.expr;
@ -2545,7 +2568,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
case DIMEN_VECTOR:
gcc_assert (info && se->loop);
gcc_assert (info->subscript[dim]
&& info->subscript[dim]->type == GFC_SS_VECTOR);
&& info->subscript[dim]->info->type == GFC_SS_VECTOR);
desc = info->subscript[dim]->data.info.descriptor;
/* Get a zero-based index into the vector. */
@ -2600,7 +2623,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
/* Pointer functions can have stride[0] different from unity.
Use the stride returned by the function call and stored in
the descriptor for the temporary. */
if (se->ss && se->ss->type == GFC_SS_FUNCTION
if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
&& se->ss->expr
&& se->ss->expr->symtree
&& se->ss->expr->symtree->n.sym->result
@ -2854,6 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
{
tree stride;
gfc_array_info *info;
gfc_ss_type ss_type;
gfc_ss *ss;
gfc_array_ref *ar;
int i;
@ -2865,9 +2889,11 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
if ((ss->useflags & flag) == 0)
continue;
if (ss->type != GFC_SS_SECTION
&& ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR
&& ss->type != GFC_SS_COMPONENT)
ss_type = ss->info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_FUNCTION
&& ss_type != GFC_SS_CONSTRUCTOR
&& ss_type != GFC_SS_COMPONENT)
continue;
info = &ss->data.info;
@ -3134,12 +3160,16 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
/* Restore the initial offsets. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
gfc_ss_type ss_type;
if ((ss->useflags & 2) == 0)
continue;
if (ss->type != GFC_SS_SECTION
&& ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR
&& ss->type != GFC_SS_COMPONENT)
ss_type = ss->info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_FUNCTION
&& ss_type != GFC_SS_CONSTRUCTOR
&& ss_type != GFC_SS_COMPONENT)
continue;
ss->data.info.offset = ss->data.info.saved_offset;
@ -3207,7 +3237,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
gfc_array_info *info;
gfc_array_ref *ar;
gcc_assert (ss->type == GFC_SS_SECTION);
gcc_assert (ss->info->type == GFC_SS_SECTION);
info = &ss->data.info;
ar = &info->ref->u.ar;
@ -3264,7 +3294,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
/* Determine the rank of the loop. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
switch (ss->type)
switch (ss->info->type)
{
case GFC_SS_SECTION:
case GFC_SS_CONSTRUCTOR:
@ -3309,7 +3339,7 @@ done:
if (ss->expr && ss->expr->shape && !info->shape)
info->shape = ss->expr->shape;
switch (ss->type)
switch (ss->info->type)
{
case GFC_SS_SECTION:
/* Get the descriptor for the array. */
@ -3372,7 +3402,7 @@ done:
{
stmtblock_t inner;
if (ss->type != GFC_SS_SECTION)
if (ss->info->type != GFC_SS_SECTION)
continue;
/* Catch allocatable lhs in f2003. */
@ -3757,7 +3787,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
{
if (ss->type != GFC_SS_SECTION)
if (ss->info->type != GFC_SS_SECTION)
continue;
if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym)
@ -3874,7 +3904,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
gfc_ss_type ss_type;
ss_type = ss->type;
ss_type = ss->info->type;
if (ss_type == GFC_SS_SCALAR
|| ss_type == GFC_SS_TEMP
|| ss_type == GFC_SS_REFERENCE)
@ -3907,7 +3937,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
continue;
}
if (ss->type == GFC_SS_CONSTRUCTOR)
if (ss_type == GFC_SS_CONSTRUCTOR)
{
gfc_constructor_base base;
/* An unknown size constructor will always be rank one.
@ -3928,7 +3958,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* TODO: Pick the best bound if we have a choice between a
function and something else. */
if (ss->type == GFC_SS_FUNCTION)
if (ss_type == GFC_SS_FUNCTION)
{
loopspec[n] = ss;
continue;
@ -3939,7 +3969,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
if (loopspec[n] && ss->is_alloc_lhs)
continue;
if (ss->type != GFC_SS_SECTION)
if (ss_type != GFC_SS_SECTION)
continue;
if (!loopspec[n])
@ -3951,7 +3981,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
known lower bound
known upper bound
*/
else if ((loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n])
else if ((loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n])
|| n >= loop->dimen)
loopspec[n] = ss;
else if (integer_onep (info->stride[dim])
@ -3997,7 +4027,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
else
{
loop->from[n] = info->start[dim];
switch (loopspec[n]->type)
switch (loopspec[n]->info->type)
{
case GFC_SS_CONSTRUCTOR:
/* The upper bound is calculated when we expand the
@ -4054,7 +4084,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* If we want a temporary then create it. */
if (tmp_ss != NULL)
{
gcc_assert (loop->temp_ss->type == GFC_SS_TEMP);
gfc_ss_info *tmp_ss_info;
tmp_ss_info = tmp_ss->info;
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
/* Make absolutely sure that this is a complete type. */
if (loop->temp_ss->string_length)
@ -4065,7 +4098,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
tmp = loop->temp_ss->data.temp.type;
memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
loop->temp_ss->type = GFC_SS_SECTION;
tmp_ss_info->type = GFC_SS_SECTION;
gcc_assert (tmp_ss->dimen != 0);
@ -4087,9 +4120,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT
&& ss->type != GFC_SS_CONSTRUCTOR)
gfc_ss_type ss_type;
ss_type = ss->info->type;
if (ss_type != GFC_SS_SECTION
&& ss_type != GFC_SS_COMPONENT
&& ss_type != GFC_SS_CONSTRUCTOR)
continue;
info = &ss->data.info;
@ -5702,6 +5738,7 @@ transposed_dims (gfc_ss *ss)
void
gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
{
gfc_ss_type ss_type;
gfc_loopinfo loop;
gfc_array_info *info;
int need_tmp;
@ -5718,6 +5755,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (ss != NULL);
gcc_assert (ss != gfc_ss_terminator);
ss_type = ss->info->type;
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
{
@ -5725,7 +5764,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* If we have a linear array section, we can pass it directly.
Otherwise we need to copy it into a temporary. */
gcc_assert (ss->type == GFC_SS_SECTION);
gcc_assert (ss_type == GFC_SS_SECTION);
gcc_assert (ss->expr == expr);
info = &ss->data.info;
@ -5804,7 +5843,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
if (se->direct_byref)
{
gcc_assert (ss->type == GFC_SS_FUNCTION && ss->expr == expr);
gcc_assert (ss_type == GFC_SS_FUNCTION && ss->expr == expr);
/* For pointer assignments pass the descriptor directly. */
if (se->ss == NULL)
@ -5816,7 +5855,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
return;
}
if (ss->expr != expr || ss->type != GFC_SS_FUNCTION)
if (ss->expr != expr || ss_type != GFC_SS_FUNCTION)
{
if (ss->expr != expr)
/* Elemental function. */
@ -5825,7 +5864,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
|| (expr->value.function.isym != NULL
&& expr->value.function.isym->elemental));
else
gcc_assert (ss->type == GFC_SS_INTRINSIC);
gcc_assert (ss_type == GFC_SS_INTRINSIC);
need_tmp = 1;
if (expr->ts.type == BT_CHARACTER
@ -5844,7 +5883,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
case EXPR_ARRAY:
/* Constant array constructors don't need a temporary. */
if (ss->type == GFC_SS_CONSTRUCTOR
if (ss_type == GFC_SS_CONSTRUCTOR
&& expr->ts.type != BT_CHARACTER
&& gfc_constant_array_constructor_p (expr->value.constructor))
{
@ -6055,7 +6094,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
&& info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
{
gcc_assert (info->subscript[n]
&& info->subscript[n]->type == GFC_SS_SCALAR);
&& info->subscript[n]->info->type == GFC_SS_SCALAR);
start = info->subscript[n]->data.scalar.expr;
}
else
@ -7811,7 +7850,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
/* Scalar argument. */
gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE);
newss = gfc_get_scalar_ss (head, arg->expr);
newss->type = type;
newss->info->type = type;
}
else
scalar = 0;

9
gcc/fortran/trans-const.c
View File

@ -358,6 +358,8 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
void
gfc_conv_constant (gfc_se * se, gfc_expr * expr)
{
gfc_ss *ss;
/* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR. If
so, the expr_type will not yet be an EXPR_CONSTANT. We need to make
it so here. */
@ -380,10 +382,11 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
return;
}
if (se->ss != NULL)
ss = se->ss;
if (ss != NULL)
{
gcc_assert (se->ss != gfc_ss_terminator);
gcc_assert (se->ss->type == GFC_SS_SCALAR);
gcc_assert (ss != gfc_ss_terminator);
gcc_assert (ss->info->type == GFC_SS_SCALAR);
gcc_assert (se->ss->expr == expr);
se->expr = se->ss->data.scalar.expr;

27
gcc/fortran/trans-expr.c
View File

@ -2893,7 +2893,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
if (!sym->attr.elemental)
{
gcc_assert (se->ss->type == GFC_SS_FUNCTION);
gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
if (se->ss->useflags)
{
gcc_assert ((!comp && gfc_return_by_reference (sym)
@ -4239,8 +4239,11 @@ is_zero_initializer_p (gfc_expr * expr)
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->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR);
gfc_conv_tmp_array_ref (se);
}
@ -4821,13 +4824,17 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr)
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->expr == expr
&& (ss->info->type == GFC_SS_SCALAR
|| ss->info->type == GFC_SS_REFERENCE))
{
/* Substitute a scalar expression evaluated outside the scalarization
loop. */
se->expr = se->ss->data.scalar.expr;
if (se->ss->type == GFC_SS_REFERENCE)
if (ss->info->type == GFC_SS_REFERENCE)
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
se->string_length = se->ss->string_length;
gfc_advance_se_ss_chain (se);
@ -4946,10 +4953,12 @@ gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type)
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->expr == expr
&& ss->info->type == GFC_SS_REFERENCE)
{
/* Returns a reference to the scalar evaluated outside the loop
for this case. */
@ -6154,7 +6163,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
/* 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);

4
gcc/fortran/trans-intrinsic.c
View File

@ -6753,8 +6753,8 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
for (tmp_ss = arg_ss; ; tmp_ss = tmp_ss->next)
{
if (tmp_ss->type != GFC_SS_SCALAR
&& tmp_ss->type != GFC_SS_REFERENCE)
if (tmp_ss->info->type != GFC_SS_SCALAR
&& tmp_ss->info->type != GFC_SS_REFERENCE)
{
int tmp_dim;

2
gcc/fortran/trans-stmt.c
View File

@ -4048,7 +4048,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* 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);

12
gcc/fortran/trans.h
View File

@ -183,6 +183,15 @@ typedef enum
gfc_ss_type;
typedef struct gfc_ss_info
{
gfc_ss_type type;
}
gfc_ss_info;
#define gfc_get_ss_info() XCNEW (gfc_ss_info)
/* Scalarization State chain. Created by walking an expression tree before
creating the scalarization loops. Then passed as part of a gfc_se structure
to translate the expression inside the loop. Note that these chains are
@ -193,7 +202,8 @@ gfc_ss_type;
typedef struct gfc_ss
{
gfc_ss_type type;
gfc_ss_info *info;
gfc_expr *expr;
tree string_length;
union