Commit a8a6b603 by Tobias Schlüter Committed by Tobias Schlüter

trans-common.c: Fix whitespace issues, make variable names more readable.

* trans-common.c: Fix whitespace issues, make variable names
more readable.
(create_common): Additionally, make loop logic more obvious.

Co-Authored-By: Paul Brook <paul@codesourcery.com>

From-SVN: r84453
parent 44bce8bf
2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* trans-common.c: Fix whitespace issues, make variable names
more readable.
(create_common): Additionally, make loop logic more obvious.
2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
Paul Brook <paul@codesourcery.com>
PR fortran/13415
......
......@@ -123,7 +123,6 @@ static gfc_namespace *gfc_common_ns = NULL;
#define BLANK_COMMON_NAME "__BLNK__"
/* Make a segment_info based on a symbol. */
static segment_info *
......@@ -146,7 +145,7 @@ get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset)
return s;
}
/* Add combine segment V and segement LIST. */
/* Add combine segment V and segment LIST. */
static segment_info *
add_segments (segment_info *list, segment_info *v)
......@@ -184,6 +183,7 @@ add_segments (segment_info *list, segment_info *v)
p = v;
v = next;
}
return list;
}
......@@ -197,6 +197,7 @@ gfc_sym_mangled_common_id (const char *name)
if (strcmp (name, BLANK_COMMON_NAME) == 0)
return get_identifier (name);
if (gfc_option.flag_underscoring)
{
has_underscore = strchr (name, '_') != 0;
......@@ -204,6 +205,7 @@ gfc_sym_mangled_common_id (const char *name)
snprintf (mangled_name, sizeof mangled_name, "%s__", name);
else
snprintf (mangled_name, sizeof mangled_name, "%s_", name);
return get_identifier (mangled_name);
}
else
......@@ -331,7 +333,6 @@ build_common_decl (gfc_common_head *com, const char *name,
DECL_INITIAL (decl) = NULL_TREE;
DECL_COMMON (decl) = 1;
DECL_DEFER_OUTPUT (decl) = 1;
}
else
{
......@@ -349,7 +350,7 @@ build_common_decl (gfc_common_head *com, const char *name,
static void
create_common (gfc_common_head *com, const char *name)
{
segment_info *h, *next_s;
segment_info *s, *next_s;
tree union_type;
tree *field_link;
record_layout_info rli;
......@@ -361,19 +362,17 @@ create_common (gfc_common_head *com, const char *name)
rli = start_record_layout (union_type);
field_link = &TYPE_FIELDS (union_type);
for (h = current_common; h; h = next_s)
for (s = current_common; s; s = s->next)
{
build_field (h, union_type, rli);
build_field (s, union_type, rli);
/* Link the field into the type. */
*field_link = h->field;
field_link = &TREE_CHAIN (h->field);
*field_link = s->field;
field_link = &TREE_CHAIN (s->field);
/* Has initial value. */
if (h->sym->value)
if (s->sym->value)
is_init = true;
next_s = h->next;
}
finish_record_layout (rli, true);
......@@ -389,46 +388,46 @@ create_common (gfc_common_head *com, const char *name)
HOST_WIDE_INT offset = 0;
list = NULL_TREE;
for (h = current_common; h; h = h->next)
for (s = current_common; s; s = s->next)
{
if (h->sym->value)
if (s->sym->value)
{
if (h->offset < offset)
if (s->offset < offset)
{
/* We have overlapping initializers. It could either be
partially initilalized arrays (lagal), or the user
partially initilalized arrays (legal), or the user
specified multiple initial values (illegal).
We don't implement this yet, so bail out. */
gfc_todo_error ("Initialization of overlapping variables");
}
if (h->sym->attr.dimension)
if (s->sym->attr.dimension)
{
tmp = gfc_conv_array_initializer (TREE_TYPE (h->field),
h->sym->value);
list = tree_cons (h->field, tmp, list);
tmp = gfc_conv_array_initializer (TREE_TYPE (s->field),
s->sym->value);
list = tree_cons (s->field, tmp, list);
}
else
{
switch (h->sym->ts.type)
switch (s->sym->ts.type)
{
case BT_CHARACTER:
se.expr = gfc_conv_string_init
(h->sym->ts.cl->backend_decl, h->sym->value);
(s->sym->ts.cl->backend_decl, s->sym->value);
break;
case BT_DERIVED:
gfc_init_se (&se, NULL);
gfc_conv_structure (&se, h->sym->value, 1);
gfc_conv_structure (&se, s->sym->value, 1);
break;
default:
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, h->sym->value);
gfc_conv_expr (&se, s->sym->value);
break;
}
list = tree_cons (h->field, se.expr, list);
list = tree_cons (s->field, se.expr, list);
}
offset = h->offset + h->length;
offset = s->offset + s->length;
}
}
assert (list);
......@@ -445,13 +444,13 @@ create_common (gfc_common_head *com, const char *name)
}
/* Build component reference for each variable. */
for (h = current_common; h; h = next_s)
for (s = current_common; s; s = next_s)
{
h->sym->backend_decl = build (COMPONENT_REF, TREE_TYPE (h->field),
decl, h->field, NULL_TREE);
s->sym->backend_decl = build (COMPONENT_REF, TREE_TYPE (s->field),
decl, s->field, NULL_TREE);
next_s = h->next;
gfc_free (h);
next_s = s->next;
gfc_free (s);
}
}
......@@ -478,12 +477,13 @@ find_segment_info (gfc_symbol *symbol)
the mpz_t value. */
static mpz_t *
get_mpz (gfc_expr *g)
get_mpz (gfc_expr *e)
{
if (g->expr_type != EXPR_CONSTANT)
if (e->expr_type != EXPR_CONSTANT)
gfc_internal_error ("get_mpz(): Not an integer constant");
return &g->value.integer;
return &e->value.integer;
}
......@@ -495,28 +495,28 @@ get_mpz (gfc_expr *g)
static HOST_WIDE_INT
element_number (gfc_array_ref *ar)
{
mpz_t multiplier, offset, extent, l;
mpz_t multiplier, offset, extent, n;
gfc_array_spec *as;
HOST_WIDE_INT b, rank;
HOST_WIDE_INT i, rank;
as = ar->as;
rank = as->rank;
mpz_init_set_ui (multiplier, 1);
mpz_init_set_ui (offset, 0);
mpz_init (extent);
mpz_init (l);
mpz_init (n);
for (b = 0; b < rank; b++)
for (i = 0; i < rank; i++)
{
if (ar->dimen_type[b] != DIMEN_ELEMENT)
if (ar->dimen_type[i] != DIMEN_ELEMENT)
gfc_internal_error ("element_number(): Bad dimension type");
mpz_sub (l, *get_mpz (ar->start[b]), *get_mpz (as->lower[b]));
mpz_sub (n, *get_mpz (ar->start[i]), *get_mpz (as->lower[i]));
mpz_mul (l, l, multiplier);
mpz_add (offset, offset, l);
mpz_mul (n, n, multiplier);
mpz_add (offset, offset, n);
mpz_sub (extent, *get_mpz (as->upper[b]), *get_mpz (as->lower[b]));
mpz_sub (extent, *get_mpz (as->upper[i]), *get_mpz (as->lower[i]));
mpz_add_ui (extent, extent, 1);
if (mpz_sgn (extent) < 0)
......@@ -525,14 +525,14 @@ element_number (gfc_array_ref *ar)
mpz_mul (multiplier, multiplier, extent);
}
b = mpz_get_ui (offset);
i = mpz_get_ui (offset);
mpz_clear (multiplier);
mpz_clear (offset);
mpz_clear (extent);
mpz_clear (l);
mpz_clear (n);
return b;
return i;
}
......@@ -543,16 +543,16 @@ element_number (gfc_array_ref *ar)
have to calculate the further reference. */
static HOST_WIDE_INT
calculate_offset (gfc_expr *s)
calculate_offset (gfc_expr *e)
{
HOST_WIDE_INT a, element_size, offset;
HOST_WIDE_INT n, element_size, offset;
gfc_typespec *element_type;
gfc_ref *reference;
offset = 0;
element_type = &s->symtree->n.sym->ts;
element_type = &e->symtree->n.sym->ts;
for (reference = s->ref; reference; reference = reference->next)
for (reference = e->ref; reference; reference = reference->next)
switch (reference->type)
{
case REF_ARRAY:
......@@ -562,16 +562,16 @@ calculate_offset (gfc_expr *s)
break;
case AR_ELEMENT:
a = element_number (&reference->u.ar);
n = element_number (&reference->u.ar);
if (element_type->type == BT_CHARACTER)
gfc_conv_const_charlen (element_type->cl);
element_size =
int_size_in_bytes (gfc_typenode_for_spec (element_type));
offset += a * element_size;
offset += n * element_size;
break;
default:
gfc_error ("Bad array reference at %L", &s->where);
gfc_error ("Bad array reference at %L", &e->where);
}
break;
case REF_SUBSTRING:
......@@ -580,7 +580,7 @@ calculate_offset (gfc_expr *s)
break;
default:
gfc_error ("Illegal reference type at %L as EQUIVALENCE object",
&s->where);
&e->where);
}
return offset;
}
......@@ -610,7 +610,7 @@ new_condition (segment_info *v, gfc_equiv *eq1, gfc_equiv *eq2)
is. */
static void
confirm_condition (segment_info *k, gfc_equiv *eq1, segment_info *e,
confirm_condition (segment_info *s1, gfc_equiv *eq1, segment_info *s2,
gfc_equiv *eq2)
{
HOST_WIDE_INT offset1, offset2;
......@@ -618,10 +618,10 @@ confirm_condition (segment_info *k, gfc_equiv *eq1, segment_info *e,
offset1 = calculate_offset (eq1->expr);
offset2 = calculate_offset (eq2->expr);
if (k->offset + offset1 != e->offset + offset2)
if (s1->offset + offset1 != s2->offset + offset2)
gfc_error ("Inconsistent equivalence rules involving '%s' at %L and "
"'%s' at %L", k->sym->name, &k->sym->declared_at,
e->sym->name, &e->sym->declared_at);
"'%s' at %L", s1->sym->name, &s1->sym->declared_at,
s2->sym->name, &s2->sym->declared_at);
}
......@@ -648,41 +648,41 @@ add_condition (segment_info *f, gfc_equiv *eq1, gfc_equiv *eq2)
checks for rules involving the first symbol in the equivalence set. */
static bool
find_equivalence (segment_info *f)
find_equivalence (segment_info *n)
{
gfc_equiv *c, *l, *eq, *other;
gfc_equiv *e1, *e2, *eq, *other;
bool found;
found = FALSE;
for (c = f->sym->ns->equiv; c; c = c->next)
for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
{
other = NULL;
for (l = c->eq; l; l = l->eq)
for (e2 = e1->eq; e2; e2 = e2->eq)
{
if (l->used)
if (e2->used)
continue;
if (c->expr->symtree->n.sym == f-> sym)
if (e1->expr->symtree->n.sym == n->sym)
{
eq = c;
other = l;
eq = e1;
other = e2;
}
else if (l->expr->symtree->n.sym == f->sym)
else if (e2->expr->symtree->n.sym == n->sym)
{
eq = l;
other = c;
eq = e2;
other = e1;
}
else
eq = NULL;
if (eq)
{
add_condition (f, eq, other);
add_condition (n, eq, other);
eq->used = 1;
found = TRUE;
/* If this symbol is the first in the chain we may find other
matches. Otherwise we can skip to the next equivalence. */
if (eq == l)
if (eq == e2)
break;
}
}
......@@ -722,6 +722,7 @@ add_equivalences (void)
static void
new_segment (gfc_common_head *common, const char *name, gfc_symbol *sym)
{
current_segment = get_segment_info (sym, current_offset);
/* The offset of the next common variable. */
......@@ -733,9 +734,7 @@ new_segment (gfc_common_head *common, const char *name, gfc_symbol *sym)
if (current_segment->offset < 0)
gfc_error ("The equivalence set for '%s' cause an invalid extension "
"to COMMON '%s' at %L",
sym->name, name, &common->where);
"to COMMON '%s' at %L", sym->name, name, &common->where);
/* Add these to the common block. */
current_common = add_segments (current_common, current_segment);
......@@ -753,9 +752,10 @@ finish_equivalences (gfc_namespace *ns)
HOST_WIDE_INT min_offset;
for (z = ns->equiv; z; z = z->next)
for (y= z->eq; y; y = y->eq)
for (y = z->eq; y; y = y->eq)
{
if (y->used) continue;
if (y->used)
continue;
sym = z->expr->symtree->n.sym;
current_segment = get_segment_info (sym, 0);
......@@ -803,6 +803,7 @@ translate_common (gfc_common_head *common, const char *name,
static void
named_common (gfc_symtree *st)
{
translate_common (st->n.common, st->name, st->n.common->head);
}
......
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