From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 70578 invoked by alias); 5 Sep 2018 14:58:11 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 69370 invoked by uid 89); 5 Sep 2018 14:58:01 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,GIT_PATCH_0,GIT_PATCH_1,GIT_PATCH_2,GIT_PATCH_3,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.2 spammy=HX-Received:sk:z12-v6m X-HELO: mail-wm0-f47.google.com Received: from mail-wm0-f47.google.com (HELO mail-wm0-f47.google.com) (74.125.82.47) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:58 +0000 Received: by mail-wm0-f47.google.com with SMTP id y2-v6so8334923wma.1; Wed, 05 Sep 2018 07:57:58 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=/CVrPrp2stIqToTV3z8MRH9QAYnsc5lQtryHN9mkLuo=; b=upOtgwRLGqSizKvsBN6OcXmzmttdbpfWTD2Yt+nPCsKY2J9ZqCe08WN7VStNyVZ3ae /Rbj6iJRLnKEtE3SEMXOzbvM3I87Ia19C+5tixjoWcnnRVlHEOXprGSiPbhvgWqzvqXV lCB7TzlJ5W22yDPSBNYu2yMfb+R4J3lcRu49VZ5uk4zWBZ8VuWnIzEZ620f2aHXHIYP8 XhgnUhg1S+wRXDK1jXIw4bcWXaT1TMblEfdHqE0GiBECSJYUIuSuIMiEsIlLvPoLa+/X nf1YUQzGAVivNYoTzH7/jlBj0N+cAhOEsyqX9e/SOQqS5e5q6+zYZkIg64JNITeDmNAW UBTQ== Return-Path: Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id t69-v6sm1484432wmt.40.2018.09.05.07.57.48 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-00007o-Dn; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 12/29] Use stringpool for remaining names Date: Wed, 05 Sep 2018 14:58:00 -0000 Message-Id: <20180905145732.404-13-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-IsSubscribed: yes X-SW-Source: 2018-09/txt/msg00042.txt.bz2 From: Bernhard Reutner-Fischer This replaces the remaining occurrences of names and name manipulation to go through the stringpool. Required to make TYPE (IS) handling work later on. gcc/fortran/ChangeLog: 2017-11-14 Bernhard Reutner-Fischer * class.c (gfc_build_class_symbol): Use pointer for name. (generate_finalization_wrapper): Likewise. (gfc_find_derived_vtab): Likewise. (find_intrinsic_vtab): Likewise. * decl.c (gfc_get_pdt_instance): Likewise. * frontend-passes.c (create_do_loop): Likewise. * match.c (select_intrinsic_set_tmp): Likewise. * resolve.c (resolve_select_type): Likewise. (resolve_critical): Likewise. (get_temp_from_expr): Likewise. (resolve_component): Likewise. * trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment): Likewise. * trans.c (gfc_deferred_strlen): Likewise. --- gcc/fortran/class.c | 44 ++++++++++++++++------------------- gcc/fortran/decl.c | 2 +- gcc/fortran/frontend-passes.c | 6 ++--- gcc/fortran/match.c | 6 ++--- gcc/fortran/resolve.c | 30 +++++++++++------------- gcc/fortran/trans-expr.c | 4 ++-- gcc/fortran/trans.c | 6 ++--- 7 files changed, 46 insertions(+), 52 deletions(-) diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 8e637689fae..c2dc3411811 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -602,7 +602,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, gfc_array_spec **as) { char tname[GFC_MAX_SYMBOL_LEN+1]; - char *name; + const char *name; gfc_symbol *fclass; gfc_symbol *vtab; gfc_component *c; @@ -633,17 +633,17 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank; get_unique_hashed_string (tname, ts->u.derived); if ((*as) && attr->allocatable) - name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank); + name = gfc_get_string ("__class_%s_%d_%da", tname, rank, (*as)->corank); else if ((*as) && attr->pointer) - name = xasprintf ("__class_%s_%d_%dp", tname, rank, (*as)->corank); + name = gfc_get_string ("__class_%s_%d_%dp", tname, rank, (*as)->corank); else if ((*as)) - name = xasprintf ("__class_%s_%d_%dt", tname, rank, (*as)->corank); + name = gfc_get_string ("__class_%s_%d_%dt", tname, rank, (*as)->corank); else if (attr->pointer) - name = xasprintf ("__class_%s_p", tname); + name = gfc_get_string ("__class_%s_p", tname); else if (attr->allocatable) - name = xasprintf ("__class_%s_a", tname); + name = gfc_get_string ("__class_%s_a", tname); else - name = xasprintf ("__class_%s_t", tname); + name = gfc_get_string ("__class_%s_t", tname); if (ts->u.derived->attr.unlimited_polymorphic) { @@ -738,7 +738,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, ts->u.derived = fclass; attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0; (*as) = NULL; - free (name); return true; } @@ -1528,7 +1527,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_component *comp; gfc_namespace *sub_ns; gfc_code *last_code, *block; - char *name; + const char *name; bool finalizable_comp = false; bool expr_null_wrapper = false; gfc_expr *ancestor_wrapper = NULL, *rank; @@ -1607,7 +1606,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, sub_ns->resolved = 1; /* Set up the procedure symbol. */ - name = xasprintf ("__final_%s", tname); + name = gfc_get_string ("__final_%s", tname); gfc_get_symbol (name, sub_ns, &final); sub_ns->proc_name = final; final->attr.flavor = FL_PROCEDURE; @@ -2173,7 +2172,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_free_expr (rank); vtab_final->initializer = gfc_lval_expr_from_sym (final); vtab_final->ts.interface = final; - free (name); } @@ -2242,10 +2240,10 @@ gfc_find_derived_vtab (gfc_symbol *derived) if (ns) { char tname[GFC_MAX_SYMBOL_LEN+1]; - char *name; + const char *name; get_unique_hashed_string (tname, derived); - name = xasprintf ("__vtab_%s", tname); + name = gfc_get_string ("__vtab_%s", tname); /* Look for the vtab symbol in various namespaces. */ if (gsym && gsym->ns) @@ -2273,7 +2271,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - name = xasprintf ("__vtype_%s", tname); + name = gfc_get_string ("__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -2376,7 +2374,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) else { /* Construct default initialization variable. */ - name = xasprintf ("__def_init_%s", tname); + name = gfc_get_string ("__def_init_%s", tname); gfc_get_symbol (name, ns, &def_init); def_init->attr.target = 1; def_init->attr.artificial = 1; @@ -2409,7 +2407,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - name = xasprintf ("__copy_%s", tname); + name = gfc_get_string ("__copy_%s", tname); gfc_get_symbol (name, sub_ns, ©); sub_ns->proc_name = copy; copy->attr.flavor = FL_PROCEDURE; @@ -2486,7 +2484,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - name = xasprintf ("__deallocate_%s", tname); + name = gfc_get_string ("__deallocate_%s", tname); gfc_get_symbol (name, sub_ns, &dealloc); sub_ns->proc_name = dealloc; dealloc->attr.flavor = FL_PROCEDURE; @@ -2535,7 +2533,6 @@ have_vtype: vtab->ts.u.derived = vtype; vtab->value = gfc_default_initializer (&vtab->ts); } - free (name); } found_sym = vtab; @@ -2628,13 +2625,13 @@ find_intrinsic_vtab (gfc_typespec *ts) if (ns) { char tname[GFC_MAX_SYMBOL_LEN+1]; - char *name; + const char *name; /* Encode all types as TYPENAME_KIND_ including especially character arrays, whose length is now consistently stored in the _len component of the class-variable. */ sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind); - name = xasprintf ("__vtab_%s", tname); + name = gfc_get_string ("__vtab_%s", tname); /* Look for the vtab symbol in the top-level namespace only. */ gfc_find_symbol (name, ns, 0, &vtab); @@ -2651,7 +2648,7 @@ find_intrinsic_vtab (gfc_typespec *ts) vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - name = xasprintf ("__vtype_%s", tname); + name = gfc_get_string ("__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -2727,12 +2724,12 @@ find_intrinsic_vtab (gfc_typespec *ts) c->tb->ppc = 1; if (ts->type != BT_CHARACTER) - name = xasprintf ("__copy_%s", tname); + name = gfc_get_string ("__copy_%s", tname); else { /* __copy is always the same for characters. Check to see if copy function already exists. */ - name = xasprintf ("__copy_character_%d", ts->kind); + name = gfc_get_string ("__copy_character_%d", ts->kind); contained = ns->contained; for (; contained; contained = contained->sibling) if (contained->proc_name @@ -2801,7 +2798,6 @@ find_intrinsic_vtab (gfc_typespec *ts) vtab->ts.u.derived = vtype; vtab->value = gfc_default_initializer (&vtab->ts); } - free (name); } found_sym = vtab; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2baa1783434..48ef5637e36 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3582,7 +3582,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, /* Now we search for the PDT instance 'name'. If it doesn't exist, we build it, using 'pdt' as a template. */ - if (gfc_get_symbol (name, pdt->ns, &instance)) + if (gfc_get_symbol (gfc_get_string ("%s", name), pdt->ns, &instance)) { gfc_error ("Parameterized derived type at %C is ambiguous"); goto error_return; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 0a5e8937015..d549d8b6ffd 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -3427,7 +3427,7 @@ create_do_loop (gfc_expr *start, gfc_expr *end, gfc_expr *step, locus *where, gfc_namespace *ns, char *vname) { - char name[GFC_MAX_SYMBOL_LEN +1]; + const char *name; gfc_symtree *symtree; gfc_symbol *symbol; gfc_expr *i; @@ -3435,9 +3435,9 @@ create_do_loop (gfc_expr *start, gfc_expr *end, gfc_expr *step, locus *where, /* Create an expression for the iteration variable. */ if (vname) - sprintf (name, "__var_%d_do_%s", var_num++, vname); + name = gfc_get_string ("__var_%d_do_%s", var_num++, vname); else - sprintf (name, "__var_%d_do", var_num++); + name = gfc_get_string ("__var_%d_do", var_num++); if (gfc_get_sym_tree (name, ns, &symtree, false) != 0) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f27249ec6ed..2c4d6e8228c 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -6048,7 +6048,7 @@ select_type_push (gfc_symbol *sel) static gfc_symtree * select_intrinsic_set_tmp (gfc_typespec *ts) { - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; gfc_symtree *tmp; HOST_WIDE_INT charlen = 0; @@ -6064,10 +6064,10 @@ select_intrinsic_set_tmp (gfc_typespec *ts) charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer); if (ts->type != BT_CHARACTER) - sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type), + name = gfc_get_string ("__tmp_%s_%d", gfc_basic_typename (ts->type), ts->kind); else - snprintf (name, sizeof (name), "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", + name = gfc_get_string ("__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", gfc_basic_typename (ts->type), charlen, ts->kind); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index afb745bddc5..e98e6a6d53e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8842,7 +8842,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_code *class_is = NULL, *default_case = NULL; gfc_case *c; gfc_symtree *st; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; gfc_namespace *ns; int error = 0; int rank = 0; @@ -9096,21 +9096,20 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) 'global' one). */ if (c->ts.type == BT_CLASS) - sprintf (name, "__tmp_class_%s", c->ts.u.derived->name); + name = gfc_get_string ("__tmp_class_%s", c->ts.u.derived->name); else if (c->ts.type == BT_DERIVED) - sprintf (name, "__tmp_type_%s", c->ts.u.derived->name); + name = gfc_get_string ("__tmp_type_%s", c->ts.u.derived->name); else if (c->ts.type == BT_CHARACTER) { HOST_WIDE_INT charlen = 0; if (c->ts.u.cl && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT) charlen = gfc_mpz_get_hwi (c->ts.u.cl->length->value.integer); - snprintf (name, sizeof (name), - "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", + name = gfc_get_string ("__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", gfc_basic_typename (c->ts.type), charlen, c->ts.kind); } else - sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type), + name = gfc_get_string ("__tmp_%s_%d", gfc_basic_typename (c->ts.type), c->ts.kind); st = gfc_find_symtree (ns->sym_root, name); @@ -9553,20 +9552,19 @@ resolve_critical (gfc_code *code) { gfc_symtree *symtree; gfc_symbol *lock_type; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; static int serial = 0; if (flag_coarray != GFC_FCOARRAY_LIB) return; - symtree = gfc_find_symtree (gfc_current_ns->sym_root, - GFC_PREFIX ("lock_type")); + name = gfc_get_string (GFC_PREFIX ("lock_type")); + symtree = gfc_find_symtree (gfc_current_ns->sym_root, name); if (symtree) lock_type = symtree->n.sym; else { - if (gfc_get_sym_tree (GFC_PREFIX ("lock_type"), gfc_current_ns, &symtree, - false) != 0) + if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0) gcc_unreachable (); lock_type = symtree->n.sym; lock_type->attr.flavor = FL_DERIVED; @@ -9575,7 +9573,7 @@ resolve_critical (gfc_code *code) lock_type->intmod_sym_id = ISOFORTRAN_LOCK_TYPE; } - sprintf(name, GFC_PREFIX ("lock_var") "%d",serial++); + name = gfc_get_string (GFC_PREFIX ("lock_var") "%d", serial++); if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0) gcc_unreachable (); @@ -10569,13 +10567,13 @@ static gfc_expr* get_temp_from_expr (gfc_expr *e, gfc_namespace *ns) { static int serial = 0; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; gfc_symtree *tmp; gfc_array_spec *as; gfc_array_ref *aref; gfc_ref *ref; - sprintf (name, GFC_PREFIX("DA%d"), serial++); + name = gfc_get_string (GFC_PREFIX("DA%d"), serial++); gfc_get_sym_tree (name, ns, &tmp, false); gfc_add_type (tmp->n.sym, &e->ts, NULL); @@ -13956,9 +13954,9 @@ resolve_component (gfc_component *c, gfc_symbol *sym) && !c->attr.function && !sym->attr.is_class) { - char name[GFC_MAX_SYMBOL_LEN+9]; + const char *name; gfc_component *strlen; - sprintf (name, "_%s_length", c->name); + name = gfc_get_string ("_%s_length", c->name); strlen = gfc_find_component (sym, name, true, true, NULL); if (strlen == NULL) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6c8a5b30568..d502c127951 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -7307,7 +7307,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block, if (cm->ts.type == BT_CHARACTER && cm->ts.deferred) { - char name[GFC_MAX_SYMBOL_LEN+9]; + const char *name; gfc_component *strlen; /* Use the rhs string length and the lhs element size. */ gcc_assert (expr2->ts.type == BT_CHARACTER); @@ -7321,7 +7321,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block, /* Ensure that cm->ts.u.cl->backend_decl is a componentref to _%s_length component. */ - sprintf (name, "_%s_length", cm->name); + name = gfc_get_string ("_%s_length", cm->name); strlen = gfc_find_component (sym, name, true, true, NULL); lhs_cl_size = fold_build3_loc (input_location, COMPONENT_REF, gfc_charlen_type_node, diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 153bab63396..66ba0572e0c 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2330,14 +2330,14 @@ gfc_likely (tree cond, enum br_predictor predictor) bool gfc_deferred_strlen (gfc_component *c, tree *decl) { - char name[GFC_MAX_SYMBOL_LEN+9]; + const char *name; gfc_component *strlen; if (!(c->ts.type == BT_CHARACTER && (c->ts.deferred || c->attr.pdt_string))) return false; - sprintf (name, "_%s_length", c->name); + name = gfc_get_string ("_%s_length", c->name); for (strlen = c; strlen; strlen = strlen->next) - if (strcmp (strlen->name, name) == 0) + if (strlen->name == name) break; *decl = strlen ? strlen->backend_decl : NULL_TREE; return strlen != NULL; -- 2.19.0.rc1