From a8a6b603730faa3abbc8fd6c2cc3f066dbb70bfa Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sat, 10 Jul 2004 13:21:42 +0200 Subject: [PATCH] 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 From-SVN: r84453 --- gcc/fortran/ChangeLog | 8 +- gcc/fortran/trans-common.c | 225 +++++++++++++++++++------------------ 2 files changed, 120 insertions(+), 113 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7cfab030d7a..f95d64a4345 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,4 +1,10 @@ -2004-07-10 Tobias Schlueter +2004-07-10 Tobias Schlueter + + * trans-common.c: Fix whitespace issues, make variable names + more readable. + (create_common): Additionally, make loop logic more obvious. + +2004-07-10 Tobias Schlueter Paul Brook PR fortran/13415 diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 800ab93cb11..d20a60be906 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -113,7 +113,7 @@ typedef struct segment_info HOST_WIDE_INT offset; HOST_WIDE_INT length; /* This will contain the field type until the field is created. */ - tree field; + tree field; struct segment_info *next; } segment_info; @@ -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) @@ -154,7 +153,7 @@ add_segments (segment_info *list, segment_info *v) segment_info *s; segment_info *p; segment_info *next; - + p = NULL; s = list; @@ -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 @@ -275,7 +277,7 @@ build_equiv_decl (tree union_type, bool is_init) /* Get storage for common block. */ static tree -build_common_decl (gfc_common_head *com, const char *name, +build_common_decl (gfc_common_head *com, const char *name, tree union_type, bool is_init) { gfc_symbol *common_sym; @@ -298,8 +300,8 @@ build_common_decl (gfc_common_head *com, const char *name, in all scoping units of a program in which they appear, but blank common blocks may be of different sizes. */ if (strcmp (name, BLANK_COMMON_NAME)) - gfc_warning ("Named COMMON block '%s' at %L shall be of the " - "same size", name, &com->where); + gfc_warning ("Named COMMON block '%s' at %L shall be of the " + "same size", name, &com->where); DECL_SIZE_UNIT (decl) = size; } } @@ -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 { @@ -348,8 +349,8 @@ 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) + /* Has initial 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,23 +444,23 @@ 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); } -} +} /* Given a symbol, find it in the current segment list. Returns NULL if - not found. */ + not found. */ -static segment_info * +static segment_info * find_segment_info (gfc_symbol *symbol) -{ +{ segment_info *n; for (n = current_segment; n; n = n->next) @@ -470,53 +469,54 @@ find_segment_info (gfc_symbol *symbol) return n; } - return NULL; -} + return NULL; +} /* Given an expression node, make sure it is a constant integer and return - the mpz_t value. */ + the mpz_t value. */ -static mpz_t * -get_mpz (gfc_expr *g) +static mpz_t * +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; +} /* Given an array specification and an array reference, figure out the array element number (zero based). Bounds and elements are guaranteed to be constants. If something goes wrong we generate an error and - return zero. */ + return zero. */ 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,12 +580,12 @@ calculate_offset (gfc_expr *s) break; default: gfc_error ("Illegal reference type at %L as EQUIVALENCE object", - &s->where); - } + &e->where); + } return offset; } - + /* Add a new segment_info structure to the current segment. eq1 is already in the list, eq2 is not. */ @@ -594,7 +594,7 @@ new_condition (segment_info *v, gfc_equiv *eq1, gfc_equiv *eq2) { HOST_WIDE_INT offset1, offset2; segment_info *a; - + offset1 = calculate_offset (eq1->expr); offset2 = calculate_offset (eq2->expr); @@ -610,21 +610,21 @@ 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; 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); +} + - /* Process a new equivalence condition. eq1 is know to be in segment f. If eq2 is also present then confirm that the condition holds. Otherwise add a new variable to the segment list. */ @@ -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; } } @@ -690,7 +690,7 @@ find_equivalence (segment_info *f) return found; } - + /* Add all symbols equivalenced within a segment. We need to scan the segment list multiple times to include indirect equivalences. */ @@ -714,28 +714,27 @@ add_equivalences (void) } } } - - + + /* Given a seed symbol, create a new segment consisting of that symbol and all of the symbols equivalenced with that symbol. */ - + 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. */ + /* The offset of the next common variable. */ current_offset += current_segment->length; /* Add all object directly or indirectly equivalenced with this common - variable. */ + variable. */ add_equivalences (); 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); @@ -778,8 +778,8 @@ finish_equivalences (gfc_namespace *ns) /* Translate a single common block. */ -static void -translate_common (gfc_common_head *common, const char *name, +static void +translate_common (gfc_common_head *common, const char *name, gfc_symbol *var_list) { gfc_symbol *sym; @@ -795,14 +795,15 @@ translate_common (gfc_common_head *common, const char *name, } create_common (common, name); -} - +} + /* Work function for translating a named common block. */ static void named_common (gfc_symtree *st) { + translate_common (st->n.common, st->name, st->n.common->head); } @@ -810,8 +811,8 @@ named_common (gfc_symtree *st) /* Translate the common blocks in a namespace. Unlike other variables, these have to be created before code, because the backend_decl depends on the rest of the common block. */ - -void + +void gfc_trans_common (gfc_namespace *ns) { gfc_common_head *c; @@ -824,7 +825,7 @@ gfc_trans_common (gfc_namespace *ns) } /* Translate all named common blocks. */ - gfc_traverse_symtree (ns->common_root, named_common); + gfc_traverse_symtree (ns->common_root, named_common); /* Commit the newly created symbols for common blocks. */ gfc_commit_symbols (); -- 2.30.2