From patchwork Fri Aug 16 10:22:22 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 1973193 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=orange.fr header.i=@orange.fr header.a=rsa-sha256 header.s=t20230301 header.b=t7Cpg2dg; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4WldQ95bBKz20Bh for ; Fri, 16 Aug 2024 20:24:17 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9D3EE385DDD6 for ; Fri, 16 Aug 2024 10:24:15 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from msa.smtpout.orange.fr (smtp-66.smtpout.orange.fr [80.12.242.66]) by sourceware.org (Postfix) with ESMTPS id DBEE5385DDC7; Fri, 16 Aug 2024 10:22:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org DBEE5385DDC7 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=orange.fr Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=orange.fr ARC-Filter: OpenARC Filter v1.0.0 sourceware.org DBEE5385DDC7 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=80.12.242.66 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1723803760; cv=none; b=c3Zc/uvigolREduiLBsqKN9wuIm3rCtvMg04xUELgd3U5th6rgbw8gPPQn5Bs6O8eiiNDb9oesNui0m8kIWdi9uahf1U2D6ZiJp+4159bMk1rAJEd1JO5cg46Sr9drTH379cxphBdkdVgwi53qDQlXOuULXjhNaz5eFio6yfeYY= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1723803760; c=relaxed/simple; bh=06gs1iR4lEIPb8VMwunCYMd08QGgDdkpRmd9ReRxCRU=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=fb1K/HXCO6RrBimnAfM4Wnf7FYn0hjdnRsF+S6kWkEKC6n5/+9mKRD9IcFWqst0PGyzjefXuVd9Uns794h7DdsnWlSCw2U8983FeTXhuGGeTExNrPXz07grxzfiBaZn7A1OhAPHR3CCvStMHR279NCDjFHYYU7GyO8UxhZzW7cc= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from cyrano.home ([86.215.161.51]) by smtp.orange.fr with ESMTPA id eu6FsXj565Qjaeu6Ls0CgM; Fri, 16 Aug 2024 12:22:33 +0200 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=orange.fr; s=t20230301; t=1723803753; bh=EtgYlQtFMrg8ap+p9TDI+LniBB/fmGzlxyqMJyvBquo=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=t7Cpg2dgt6haLqyBNTFC/fZqoI5kplGUkxulfXDumUFlTr3wi/Z9WEHGkShIX04sR ysncqX83YSd1NbuyuZAUYJrwSV0LfkGG3LxrLOqKa/xUQ0BXd5iHez2k4mgLMVhY25 wG55liw8stX88dEUnrnLiMabJ1+glyn9rUiHW3+tvdGQqwM8u2POLKBqcaMLtatkuw FyQ0CxIZNo9FEn3FRXpAJ1Jk/3YnAAD80m1gvP8rF6jJPzTg9RuLEe1/F7HrehCICf WFtrcxsTKcbzS4qr3FaEY3DRMsGFTv8PdobHi4ib2qbdRYOZsoSAUpDAntTWOQ+cKb ogW0xvozHCskQ== X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Fri, 16 Aug 2024 12:22:33 +0200 X-ME-IP: 86.215.161.51 From: Mikael Morin To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: [PATCH v2 05/10] fortran: Outline array bound check generation code Date: Fri, 16 Aug 2024 12:22:22 +0200 Message-ID: <20240816102227.189290-6-morin-mikael@orange.fr> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20240816102227.189290-1-morin-mikael@orange.fr> References: <20240816102227.189290-1-morin-mikael@orange.fr> MIME-Version: 1.0 X-Spam-Status: No, score=-11.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_PASS, SPF_PASS, 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 X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org From: Mikael Morin The next patch will need reindenting of the array bound check generation code. This outlines it to its own function beforehand, reducing the churn in the next patch. Regression-tested on x86_64-pc-linux-gnu. OK for master? -- >8 -- gcc/fortran/ChangeLog: * trans-array.cc (gfc_conv_ss_startstride): Move array bound check generation code... (add_check_section_in_array_bounds): ... here as a new function. --- gcc/fortran/trans-array.cc | 297 ++++++++++++++++++------------------- 1 file changed, 143 insertions(+), 154 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 46e2152d0f0..e578b676fcc 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -4816,6 +4816,146 @@ gfc_conv_section_startstride (stmtblock_t * block, gfc_ss * ss, int dim) } +/* Generate in INNER the bounds checking code along the dimension DIM for + the array associated with SS_INFO. */ + +static void +add_check_section_in_array_bounds (stmtblock_t *inner, gfc_ss_info *ss_info, + int dim) +{ + gfc_expr *expr = ss_info->expr; + locus *expr_loc = &expr->where; + const char *expr_name = expr->symtree->name; + + gfc_array_info *info = &ss_info->data.array; + + bool check_upper; + if (dim == info->ref->u.ar.dimen - 1 + && info->ref->u.ar.as->type == AS_ASSUMED_SIZE) + check_upper = false; + else + check_upper = true; + + /* Zero stride is not allowed. */ + tree tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, + info->stride[dim], gfc_index_zero_node); + char * msg = xasprintf ("Zero stride is not allowed, for dimension %d " + "of array '%s'", dim + 1, expr_name); + gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg); + free (msg); + + tree desc = info->descriptor; + + /* This is the run-time equivalent of resolve.cc's + check_dimension. The logical is more readable there + than it is here, with all the trees. */ + tree lbound = gfc_conv_array_lbound (desc, dim); + tree end = info->end[dim]; + tree ubound = check_upper ? gfc_conv_array_ubound (desc, dim) : NULL_TREE; + + /* non_zerosized is true when the selected range is not + empty. */ + tree stride_pos = fold_build2_loc (input_location, GT_EXPR, logical_type_node, + info->stride[dim], gfc_index_zero_node); + tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, + info->start[dim], end); + stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR, + logical_type_node, stride_pos, tmp); + + tree stride_neg = fold_build2_loc (input_location, LT_EXPR, logical_type_node, + info->stride[dim], gfc_index_zero_node); + tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, + info->start[dim], end); + stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR, + logical_type_node, stride_neg, tmp); + tree non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR, + logical_type_node, stride_pos, + stride_neg); + + /* Check the start of the range against the lower and upper + bounds of the array, if the range is not empty. + If upper bound is present, include both bounds in the + error message. */ + if (check_upper) + { + tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node, + info->start[dim], lbound); + tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, + non_zerosized, tmp); + tree tmp2 = fold_build2_loc (input_location, GT_EXPR, logical_type_node, + info->start[dim], ubound); + tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, + non_zerosized, tmp2); + msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' outside of " + "expected range (%%ld:%%ld)", dim + 1, expr_name); + gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg, + fold_convert (long_integer_type_node, info->start[dim]), + fold_convert (long_integer_type_node, lbound), + fold_convert (long_integer_type_node, ubound)); + gfc_trans_runtime_check (true, false, tmp2, inner, expr_loc, msg, + fold_convert (long_integer_type_node, info->start[dim]), + fold_convert (long_integer_type_node, lbound), + fold_convert (long_integer_type_node, ubound)); + free (msg); + } + else + { + tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node, + info->start[dim], lbound); + tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, + non_zerosized, tmp); + msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' below " + "lower bound of %%ld", dim + 1, expr_name); + gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg, + fold_convert (long_integer_type_node, info->start[dim]), + fold_convert (long_integer_type_node, lbound)); + free (msg); + } + + /* Compute the last element of the range, which is not + necessarily "end" (think 0:5:3, which doesn't contain 5) + and check it against both lower and upper bounds. */ + + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + end, info->start[dim]); + tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR, gfc_array_index_type, + tmp, info->stride[dim]); + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + end, tmp); + tree tmp2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, + tmp, lbound); + tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, + non_zerosized, tmp2); + if (check_upper) + { + tree tmp3 = fold_build2_loc (input_location, GT_EXPR, logical_type_node, + tmp, ubound); + tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, + non_zerosized, tmp3); + msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' outside of " + "expected range (%%ld:%%ld)", dim + 1, expr_name); + gfc_trans_runtime_check (true, false, tmp2, inner, expr_loc, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, ubound), + fold_convert (long_integer_type_node, lbound)); + gfc_trans_runtime_check (true, false, tmp3, inner, expr_loc, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, ubound), + fold_convert (long_integer_type_node, lbound)); + free (msg); + } + else + { + msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' below " + "lower bound of %%ld", dim + 1, expr_name); + gfc_trans_runtime_check (true, false, tmp2, inner, expr_loc, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, lbound)); + free (msg); + } +} + + /* Calculates the range start and stride for a SS chain. Also gets the descriptor and data pointer. The range of vector subscripts is the size of the vector. Array bounds are also checked. */ @@ -4826,7 +4966,6 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) int n; tree tmp; gfc_ss *ss; - tree desc; gfc_loopinfo * const outer_loop = outermost_loop (loop); @@ -4996,10 +5135,8 @@ done: if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { stmtblock_t block; - tree lbound, ubound; - tree end; tree size[GFC_MAX_DIMENSIONS]; - tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3; + tree tmp3; gfc_array_info *info; char *msg; int dim; @@ -5065,163 +5202,15 @@ done: dimensions are checked later. */ for (n = 0; n < loop->dimen; n++) { - bool check_upper; - dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE) continue; - if (dim == info->ref->u.ar.dimen - 1 - && info->ref->u.ar.as->type == AS_ASSUMED_SIZE) - check_upper = false; - else - check_upper = true; - - /* Zero stride is not allowed. */ - tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, - info->stride[dim], gfc_index_zero_node); - msg = xasprintf ("Zero stride is not allowed, for dimension %d " - "of array '%s'", dim + 1, expr_name); - gfc_trans_runtime_check (true, false, tmp, &inner, - expr_loc, msg); - free (msg); - - desc = info->descriptor; - - /* This is the run-time equivalent of resolve.cc's - check_dimension(). The logical is more readable there - than it is here, with all the trees. */ - lbound = gfc_conv_array_lbound (desc, dim); - end = info->end[dim]; - if (check_upper) - ubound = gfc_conv_array_ubound (desc, dim); - else - ubound = NULL; - - /* non_zerosized is true when the selected range is not - empty. */ - stride_pos = fold_build2_loc (input_location, GT_EXPR, - logical_type_node, info->stride[dim], - gfc_index_zero_node); - tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, - info->start[dim], end); - stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, stride_pos, tmp); - - stride_neg = fold_build2_loc (input_location, LT_EXPR, - logical_type_node, - info->stride[dim], gfc_index_zero_node); - tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, - info->start[dim], end); - stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, - stride_neg, tmp); - non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR, - logical_type_node, - stride_pos, stride_neg); - - /* Check the start of the range against the lower and upper - bounds of the array, if the range is not empty. - If upper bound is present, include both bounds in the - error message. */ - if (check_upper) - { - tmp = fold_build2_loc (input_location, LT_EXPR, - logical_type_node, - info->start[dim], lbound); - tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, - non_zerosized, tmp); - tmp2 = fold_build2_loc (input_location, GT_EXPR, - logical_type_node, - info->start[dim], ubound); - tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, - non_zerosized, tmp2); - msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " - "outside of expected range (%%ld:%%ld)", - dim + 1, expr_name); - gfc_trans_runtime_check (true, false, tmp, &inner, - expr_loc, msg, - fold_convert (long_integer_type_node, info->start[dim]), - fold_convert (long_integer_type_node, lbound), - fold_convert (long_integer_type_node, ubound)); - gfc_trans_runtime_check (true, false, tmp2, &inner, - expr_loc, msg, - fold_convert (long_integer_type_node, info->start[dim]), - fold_convert (long_integer_type_node, lbound), - fold_convert (long_integer_type_node, ubound)); - free (msg); - } - else - { - tmp = fold_build2_loc (input_location, LT_EXPR, - logical_type_node, - info->start[dim], lbound); - tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, non_zerosized, tmp); - msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " - "below lower bound of %%ld", - dim + 1, expr_name); - gfc_trans_runtime_check (true, false, tmp, &inner, - expr_loc, msg, - fold_convert (long_integer_type_node, info->start[dim]), - fold_convert (long_integer_type_node, lbound)); - free (msg); - } - - /* Compute the last element of the range, which is not - necessarily "end" (think 0:5:3, which doesn't contain 5) - and check it against both lower and upper bounds. */ - - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, end, - info->start[dim]); - tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR, - gfc_array_index_type, tmp, - info->stride[dim]); - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, end, tmp); - tmp2 = fold_build2_loc (input_location, LT_EXPR, - logical_type_node, tmp, lbound); - tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, non_zerosized, tmp2); - if (check_upper) - { - tmp3 = fold_build2_loc (input_location, GT_EXPR, - logical_type_node, tmp, ubound); - tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, non_zerosized, tmp3); - msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " - "outside of expected range (%%ld:%%ld)", - dim + 1, expr_name); - gfc_trans_runtime_check (true, false, tmp2, &inner, - expr_loc, msg, - fold_convert (long_integer_type_node, tmp), - fold_convert (long_integer_type_node, ubound), - fold_convert (long_integer_type_node, lbound)); - gfc_trans_runtime_check (true, false, tmp3, &inner, - expr_loc, msg, - fold_convert (long_integer_type_node, tmp), - fold_convert (long_integer_type_node, ubound), - fold_convert (long_integer_type_node, lbound)); - free (msg); - } - else - { - msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " - "below lower bound of %%ld", - dim + 1, expr_name); - gfc_trans_runtime_check (true, false, tmp2, &inner, - expr_loc, msg, - fold_convert (long_integer_type_node, tmp), - fold_convert (long_integer_type_node, lbound)); - free (msg); - } + add_check_section_in_array_bounds (&inner, ss_info, dim); /* Check the section sizes match. */ tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, end, + gfc_array_index_type, info->end[dim], info->start[dim]); tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, gfc_array_index_type, tmp,