From patchwork Wed Sep 5 14:57:25 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966440 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485237-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="dKD6+Gex"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="nYjSbdqx"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256RB2h64z9sD2 for ; Thu, 6 Sep 2018 01:03:50 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=eKp Z6JQ4p6+0m4Mp8HKs1H+Av0iXFdmny07Prl0+XzOn5Kc6SKyQ3zpyK4Xrw+zwPFF xHrfB/+NKSIcsK5Ze0x4sDZjuBZaVbBwfMcg6xQUVyOkcR46W9rdumr1bKTeANGa Poi7k+YXedrrq7wvfhMxVw4nuDoOhjYd0OpYueiQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=tJvJCmITw ZzeN126qPwncn//qqc=; b=dKD6+GexiNPa2W7Ijc2FgBERs4W6MuAiXStWS54Nz FJQPF9OOmAhusFoj4FFBkiqxOrgOlx1i0jCMwlCl3meCmlK7jmGQocKCyKDpeInf ShY6miBcPBBSsF/QbCbGAU2YCaVqQ+cp49i4Ln56oNYbrN7DQipsTTtB2qpc5llp Os= Received: (qmail 70172 invoked by alias); 5 Sep 2018 14:58:08 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69071 invoked by uid 89); 5 Sep 2018 14:57:58 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.4 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= X-HELO: mail-wm0-f44.google.com Received: from mail-wm0-f44.google.com (HELO mail-wm0-f44.google.com) (74.125.82.44) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:56 +0000 Received: by mail-wm0-f44.google.com with SMTP id s12-v6so8356724wmc.0; Wed, 05 Sep 2018 07:57:55 -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=KZtW+ooMVJ3y6QdWn4tv0QWur29qycvVeIRDg0icSPc=; b=nYjSbdqx8l4ZyWQFlZLb3ykbNdrgvaw37VCNihdVN84VVCYuQBEMxoerksLGpn3js4 Y0oWrEBmOF9YdWEQ7LmEDHma/xV3/yr+PhgvtOCIRQBa4slfR5mMr4ZCGr7HnFEb4AVJ v5+0dTWEPJLJX4kxf6D5Rm5fIYujBNqyOMY8IeZKPo/3QqKz2biDp+3iTqq1CEAGeMwx JrXwkkDl2MEF/yBslHieElKIN2OGg1SrkviieX05HEpWyvGERMEdVfH38Yfp/cbOUrV1 gZMRchc8e+wB/T34xGo8dOOAFJ/fBgq/poWYpy5NHOgObFtVBfklqd4dNttgIls4plSB JQVA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id z101-v6sm2435720wrb.55.2018.09.05.07.57.49 (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 1fxZFa-00008I-S7; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 22/29] Use stringpool in class and procedure-pointer result Date: Wed, 5 Sep 2018 14:57:25 +0000 Message-Id: <20180905145732.404-23-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-26 Bernhard Reutner-Fischer * class.c (finalize_component): Use stringpool. (finalization_scalarizer): Likewise. * frontend-passes.c (create_var): Likewise. (get_len_trim_call): Likewise. * iresolve.c (gfc_resolve_atomic_def): Likewise. (gfc_resolve_atomic_ref): Likewise. (gfc_resolve_event_query): Likewise. * openmp.c (gfc_match_omp_declare_reduction): Likewise. * parse.c (gfc_parse_file): Likewise. * resolve.c (build_loc_call): Likewise. (resolve_ordinary_assign): Likewise. * decl.c (add_hidden_procptr_result): Likewise and use pointer comparison instead of string comparison. --- gcc/fortran/class.c | 10 +++++++--- gcc/fortran/decl.c | 11 +++++++---- gcc/fortran/frontend-passes.c | 10 ++++++---- gcc/fortran/iresolve.c | 6 +++--- gcc/fortran/openmp.c | 13 +++++++++---- gcc/fortran/parse.c | 2 +- gcc/fortran/resolve.c | 6 ++++-- 7 files changed, 37 insertions(+), 21 deletions(-) diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 20a68da8e9b..33c772c6eba 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -959,12 +959,13 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, dealloc->ext.alloc.list->expr = e; dealloc->expr1 = gfc_lval_expr_from_sym (stat); + const char *sname = gfc_get_string ("%s", "associated"); gfc_code *cond = gfc_get_code (EXEC_IF); cond->block = gfc_get_code (EXEC_IF); cond->block->expr1 = gfc_get_expr (); cond->block->expr1->expr_type = EXPR_FUNCTION; cond->block->expr1->where = gfc_current_locus; - gfc_get_sym_tree ("associated", sub_ns, &cond->block->expr1->symtree, false); + gfc_get_sym_tree (sname, sub_ns, &cond->block->expr1->symtree, false); cond->block->expr1->symtree->n.sym->attr.flavor = FL_PROCEDURE; cond->block->expr1->symtree->n.sym->attr.intrinsic = 1; cond->block->expr1->symtree->n.sym->result = cond->block->expr1->symtree->n.sym; @@ -1038,10 +1039,12 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, { gfc_code *block; gfc_expr *expr, *expr2; + const char *sname; /* C_F_POINTER(). */ block = gfc_get_code (EXEC_CALL); - gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true); + sname = gfc_get_string ("%s", "c_f_pointer"); + gfc_get_sym_tree (sname, sub_ns, &block->symtree, true); block->resolved_sym = block->symtree->n.sym; block->resolved_sym->attr.flavor = FL_PROCEDURE; block->resolved_sym->attr.intrinsic = 1; @@ -1063,7 +1066,8 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, /* TRANSFER's first argument: C_LOC (array). */ expr = gfc_get_expr (); expr->expr_type = EXPR_FUNCTION; - gfc_get_sym_tree ("c_loc", sub_ns, &expr->symtree, false); + sname = gfc_get_string ("%s", "c_loc"); + gfc_get_sym_tree (sname, sub_ns, &expr->symtree, false); expr->symtree->n.sym->attr.flavor = FL_PROCEDURE; expr->symtree->n.sym->intmod_sym_id = ISOCBINDING_LOC; expr->symtree->n.sym->attr.intrinsic = 1; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index cc14a871dfd..1f148c88eb8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6441,6 +6441,7 @@ static bool add_hidden_procptr_result (gfc_symbol *sym) { bool case1,case2; + const char *ppr_name; if (gfc_notification_std (GFC_STD_F2003) == ERROR) return false; @@ -6454,16 +6455,18 @@ add_hidden_procptr_result (gfc_symbol *sym) && gfc_state_stack->previous->state == COMP_FUNCTION && gfc_state_stack->previous->sym->name == sym->name; + ppr_name = gfc_get_string ("%s", "ppr@"); if (case1 || case2) { + gfc_symtree *stree; if (case1) - gfc_get_sym_tree ("ppr@", gfc_current_ns, &stree, false); + gfc_get_sym_tree (ppr_name, gfc_current_ns, &stree, false); else if (case2) { gfc_symtree *st2; - gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree, false); - st2 = gfc_new_symtree (&gfc_current_ns->sym_root, "ppr@"); + gfc_get_sym_tree (ppr_name, gfc_current_ns->parent, &stree, false); + st2 = gfc_new_symtree (&gfc_current_ns->sym_root, ppr_name); st2->n.sym = stree->n.sym; stree->n.sym->refs++; } @@ -6490,7 +6493,7 @@ add_hidden_procptr_result (gfc_symbol *sym) && sym->result && sym->result != sym && sym->result->attr.external && sym == gfc_current_ns->proc_name && sym == sym->result->ns->proc_name - && strcmp ("ppr@", sym->result->name) == 0) + && sym->result->name == ppr_name) { sym->result->attr.proc_pointer = 1; sym->attr.pointer = 0; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index d549d8b6ffd..ccbc25acf97 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -713,7 +713,7 @@ insert_block () static gfc_expr* create_var (gfc_expr * e, const char *vname) { - char name[GFC_MAX_SYMBOL_LEN +1]; + const char *name; gfc_symtree *symtree; gfc_symbol *symbol; gfc_expr *result; @@ -733,9 +733,9 @@ create_var (gfc_expr * e, const char *vname) ns = insert_block (); if (vname) - snprintf (name, GFC_MAX_SYMBOL_LEN, "__var_%d_%s", var_num++, vname); + name = gfc_get_string ("__var_%d_%s", var_num++, vname); else - snprintf (name, GFC_MAX_SYMBOL_LEN, "__var_%d", var_num++); + name = gfc_get_string ("__var_%d", var_num++); if (gfc_get_sym_tree (name, ns, &symtree, false) != 0) gcc_unreachable (); @@ -1985,6 +1985,7 @@ get_len_trim_call (gfc_expr *str, int kind) { gfc_expr *fcn; gfc_actual_arglist *actual_arglist, *next; + const char *sname; fcn = gfc_get_expr (); fcn->expr_type = EXPR_FUNCTION; @@ -2000,7 +2001,8 @@ get_len_trim_call (gfc_expr *str, int kind) fcn->ts.type = BT_INTEGER; fcn->ts.kind = gfc_charlen_int_kind; - gfc_get_sym_tree ("__internal_len_trim", current_ns, &fcn->symtree, false); + sname = gfc_get_string ("%s", "__internal_len_trim"); + gfc_get_sym_tree (sname, current_ns, &fcn->symtree, false); fcn->symtree->n.sym->ts = fcn->ts; fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE; fcn->symtree->n.sym->attr.function = 1; diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 2eb8f7c9113..f22e0da54c9 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -3351,7 +3351,7 @@ create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints) void gfc_resolve_atomic_def (gfc_code *c) { - const char *name = "atomic_define"; + const char *name = gfc_get_string ("%s", "atomic_define"); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } @@ -3359,14 +3359,14 @@ gfc_resolve_atomic_def (gfc_code *c) void gfc_resolve_atomic_ref (gfc_code *c) { - const char *name = "atomic_ref"; + const char *name = gfc_get_string ("%s", "atomic_ref"); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } void gfc_resolve_event_query (gfc_code *c) { - const char *name = "event_query"; + const char *name = gfc_get_string ("%s", "event_query"); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a868e34193f..fcfe671be8b 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2860,6 +2860,7 @@ gfc_match_omp_declare_reduction (void) gfc_namespace *combiner_ns, *initializer_ns = NULL; gfc_omp_udr *prev_udr, *omp_udr; const char *predef_name = NULL; + const char *sname; omp_udr = gfc_get_omp_udr (); omp_udr->name = name; @@ -2870,8 +2871,10 @@ gfc_match_omp_declare_reduction (void) gfc_current_ns = combiner_ns = gfc_get_namespace (gfc_current_ns, 1); combiner_ns->proc_name = combiner_ns->parent->proc_name; - gfc_get_sym_tree ("omp_out", combiner_ns, &omp_out, false); - gfc_get_sym_tree ("omp_in", combiner_ns, &omp_in, false); + sname = gfc_get_string ("%s", "omp_out"); + gfc_get_sym_tree (sname, combiner_ns, &omp_out, false); + sname = gfc_get_string ("%s", "omp_in"); + gfc_get_sym_tree (sname, combiner_ns, &omp_in, false); combiner_ns->omp_udr_ns = 1; omp_out->n.sym->ts = tss[i]; omp_in->n.sym->ts = tss[i]; @@ -2903,8 +2906,10 @@ gfc_match_omp_declare_reduction (void) gfc_current_ns = initializer_ns; initializer_ns->proc_name = initializer_ns->parent->proc_name; - gfc_get_sym_tree ("omp_priv", initializer_ns, &omp_priv, false); - gfc_get_sym_tree ("omp_orig", initializer_ns, &omp_orig, false); + sname = gfc_get_string ("%s", "omp_priv"); + gfc_get_sym_tree (sname, initializer_ns, &omp_priv, false); + sname = gfc_get_string ("%s", "omp_orig"); + gfc_get_sym_tree (sname, initializer_ns, &omp_orig, false); initializer_ns->omp_udr_ns = 1; omp_priv->n.sym->ts = tss[i]; omp_orig->n.sym->ts = tss[i]; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 755bff56e24..b7265c42f58 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -6252,7 +6252,7 @@ loop: prog_locus = gfc_current_locus; push_state (&s, COMP_PROGRAM, gfc_new_block); - main_program_symbol (gfc_current_ns, "MAIN__"); + main_program_symbol (gfc_current_ns, gfc_get_string ("MAIN__")); parse_progunit (st); goto prog_units; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 88c16d462bd..8072bd20435 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8814,10 +8814,11 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2, static gfc_expr * build_loc_call (gfc_expr *sym_expr) { + const char *loc = gfc_get_string ("%s", "_loc"); gfc_expr *loc_call; loc_call = gfc_get_expr (); loc_call->expr_type = EXPR_FUNCTION; - gfc_get_sym_tree ("_loc", gfc_current_ns, &loc_call->symtree, false); + gfc_get_sym_tree (loc, gfc_current_ns, &loc_call->symtree, false); loc_call->symtree->n.sym->attr.flavor = FL_PROCEDURE; loc_call->symtree->n.sym->attr.intrinsic = 1; loc_call->symtree->n.sym->result = loc_call->symtree->n.sym; @@ -10487,12 +10488,13 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) path. */ if (caf_convert_to_send) { + const char *sname = gfc_get_string ("%s", GFC_PREFIX ("caf_send")); if (code->expr2->expr_type == EXPR_FUNCTION && code->expr2->value.function.isym && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET) remove_caf_get_intrinsic (code->expr2); code->op = EXEC_CALL; - gfc_get_sym_tree (GFC_PREFIX ("caf_send"), ns, &code->symtree, true); + gfc_get_sym_tree (sname, ns, &code->symtree, true); code->resolved_sym = code->symtree->n.sym; code->resolved_sym->attr.flavor = FL_PROCEDURE; code->resolved_sym->attr.intrinsic = 1;