From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp-14.smtpout.orange.fr [80.12.242.14]) by sourceware.org (Postfix) with ESMTPS id 141F1385770D for ; Thu, 13 Jul 2023 08:52:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 141F1385770D Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: sourceware.org; spf=fail smtp.mailfrom=gcc.gnu.org Received: from cyrano.home ([86.215.161.51]) by smtp.orange.fr with ESMTPA id Js3wqzoJKtImzJs45q0yWG; Thu, 13 Jul 2023 10:52:45 +0200 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=wanadoo.fr; s=t20230301; t=1689238365; bh=HtuvCzVObHdBdYeu1Jd6san33AasMzsP7XCIx9SdWXU=; h=From:To:Subject:Date:In-Reply-To:References; b=nrpQSb1tSD4pB0BnGsD5PsSzOpNXPjgpigLMMlW1OGPiZYIK+RhozzJ/Vj6+i7JHm 7ImGvByUaxc4ogAL6PNII9yBwrXP9ZQ0OuYPnjN0FAy2Q4xHnNs0iyf+HYMzKSdONM gGqPqVJ2SIc8tY36juhlHXPviutM8S/dXksv4jThaJ3xhkPd3dRk6nnglvJyeAHgzi QUlr3FAGzllrBMWHAkKPuYqpqR5PTEPNPYsLHL/oSkQwreOyZ+h6ibtbueOws2vTdk TvanX9EgVbZh37+dpg3dSn8MQW2ew4rpcl3Ir+0LUNrjz44ciMa/yQMNSvKTMN7X2f EQEWPk1wVk2Eg== X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Thu, 13 Jul 2023 10:52:45 +0200 X-ME-IP: 86.215.161.51 From: Mikael Morin To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH 13/14] fortran: Use pre-evaluated class container if available [PR110618] Date: Thu, 13 Jul 2023 10:52:35 +0200 Message-Id: <20230713085236.330222-14-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: <20230713085236.330222-1-mikael@gcc.gnu.org> References: <20230713085236.330222-1-mikael@gcc.gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,FORGED_SPF_HELO,GIT_PATCH_0,JMQ_SPF_NEUTRAL,RCVD_IN_DNSWL_NONE,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,SPF_NEUTRAL,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: Add the possibility to provide a pre-evaluated class container argument to gfc_add_finalizer to avoid repeatedly evaluating data reference expressions in the generated code. PR fortran/110618 gcc/fortran/ChangeLog: * trans.h (gfc_add_finalizer_call): Add class container argument. * trans.cc (gfc_add_finalizer_call): Ditto. Pass down new argument to get_final_proc_ref, get_elem_size, get_var_desc, and get_vptr. (get_elem_size): Add class container argument. Use provided class container if it's available. (get_var_descr): Same. (get_vptr): Same. (get_final_proc_ref): Same. Add boolean telling the class container argument is used. Set it. Don't try to use final_wrapper if class container argument was used. --- gcc/fortran/trans.cc | 61 +++++++++++++++++++++++++++++--------------- gcc/fortran/trans.h | 2 +- 2 files changed, 41 insertions(+), 22 deletions(-) diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 69e9329c9cb..18965b9cbd2 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1089,14 +1089,20 @@ gfc_call_free (tree var) with the expression passed as argument in EXPR. */ static void -get_final_proc_ref (gfc_se *se, gfc_expr *expr) +get_final_proc_ref (gfc_se *se, gfc_expr *expr, tree class_container) { gfc_expr *final_wrapper = NULL; gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS); + bool using_class_container = false; if (expr->ts.type == BT_DERIVED) gfc_is_finalizable (expr->ts.u.derived, &final_wrapper); + else if (class_container) + { + using_class_container = true; + se->expr = gfc_class_vtab_final_get (class_container); + } else { final_wrapper = gfc_copy_expr (expr); @@ -1104,9 +1110,12 @@ get_final_proc_ref (gfc_se *se, gfc_expr *expr) gfc_add_final_component (final_wrapper); } - gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE); + if (!using_class_container) + { + gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE); - gfc_conv_expr (se, final_wrapper); + gfc_conv_expr (se, final_wrapper); + } if (POINTER_TYPE_P (TREE_TYPE (se->expr))) se->expr = build_fold_indirect_ref_loc (input_location, se->expr); @@ -1117,7 +1126,7 @@ get_final_proc_ref (gfc_se *se, gfc_expr *expr) passed as argument in EXPR. */ static void -get_elem_size (gfc_se *se, gfc_expr *expr) +get_elem_size (gfc_se *se, gfc_expr *expr, tree class_container) { gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS); @@ -1127,6 +1136,8 @@ get_elem_size (gfc_se *se, gfc_expr *expr) se->expr = TYPE_SIZE_UNIT (se->expr); se->expr = fold_convert (gfc_array_index_type, se->expr); } + else if (class_container) + se->expr = gfc_class_vtab_size_get (class_container); else { gfc_expr *class_size = gfc_copy_expr (expr); @@ -1143,7 +1154,7 @@ get_elem_size (gfc_se *se, gfc_expr *expr) expression passed as argument in VAR. */ static void -get_var_descr (gfc_se *se, gfc_expr *var) +get_var_descr (gfc_se *se, gfc_expr *var, tree class_container) { gfc_se tmp_se; @@ -1165,6 +1176,8 @@ get_var_descr (gfc_se *se, gfc_expr *var) // gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE); } } + else if (class_container) + tmp_se.expr = gfc_class_data_get (class_container); else { gfc_expr *array_expr; @@ -1212,20 +1225,25 @@ get_var_descr (gfc_se *se, gfc_expr *var) static void -get_vptr (gfc_se *se, gfc_expr *expr) +get_vptr (gfc_se *se, gfc_expr *expr, tree class_container) { - gfc_expr *vptr_expr = gfc_copy_expr (expr); - gfc_add_vptr_component (vptr_expr); + if (class_container) + se->expr = gfc_class_vptr_get (class_container); + else + { + gfc_expr *vptr_expr = gfc_copy_expr (expr); + gfc_add_vptr_component (vptr_expr); - gfc_se tmp_se; - gfc_init_se (&tmp_se, NULL); - tmp_se.want_pointer = 1; - gfc_conv_expr (&tmp_se, vptr_expr); - gfc_free_expr (vptr_expr); + gfc_se tmp_se; + gfc_init_se (&tmp_se, NULL); + tmp_se.want_pointer = 1; + gfc_conv_expr (&tmp_se, vptr_expr); + gfc_free_expr (vptr_expr); - gfc_add_block_to_block (&se->pre, &tmp_se.pre); - gfc_add_block_to_block (&se->post, &tmp_se.post); - se->expr = tmp_se.expr; + gfc_add_block_to_block (&se->pre, &tmp_se.pre); + gfc_add_block_to_block (&se->post, &tmp_se.post); + se->expr = tmp_se.expr; + } } @@ -1329,7 +1347,8 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, true when a finalizer call has been inserted. */ bool -gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) +gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2, + tree class_container) { tree tmp; gfc_ref *ref; @@ -1384,17 +1403,17 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_se final_se; gfc_init_se (&final_se, NULL); - get_final_proc_ref (&final_se, expr); + get_final_proc_ref (&final_se, expr, class_container); gfc_add_block_to_block (block, &final_se.pre); gfc_se size_se; gfc_init_se (&size_se, NULL); - get_elem_size (&size_se, expr); + get_elem_size (&size_se, expr, class_container); gfc_add_block_to_block (&tmp_block, &size_se.pre); gfc_se desc_se; gfc_init_se (&desc_se, NULL); - get_var_descr (&desc_se, expr); + get_var_descr (&desc_se, expr, class_container); gfc_add_block_to_block (&tmp_block, &desc_se.pre); tmp = build_call_expr_loc (input_location, final_se.expr, 3, @@ -1426,7 +1445,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_se vptr_se; gfc_init_se (&vptr_se, NULL); - get_vptr (&vptr_se, expr); + get_vptr (&vptr_se, expr, class_container); cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, vptr_se.expr, diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 7b41e8912b4..be9ccbc3d29 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -457,7 +457,7 @@ tree gfc_get_class_from_gfc_expr (gfc_expr *); tree gfc_get_class_from_expr (tree); tree gfc_get_vptr_from_expr (tree); tree gfc_copy_class_to_class (tree, tree, tree, bool); -bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *); +bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *, tree = NULL_TREE); bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool); void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *, symbol_attribute, int); bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool); -- 2.40.1