From patchwork Sun Jun 23 21:36:40 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1120933 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-503537-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="G+dPFz+/"; dkim=fail reason="signature verification failed" (1024-bit key; secure) header.d=gmx.net header.i=@gmx.net header.b="Sf+hig+2"; 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 45X5Nj1l2Cz9s4Y for ; Mon, 24 Jun 2019 07:37:07 +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 :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=BpVqjtWoNyFZpNk1anSGsF43krsbzHpXv0ozanTlLFDNcA UGTVPnkL7VQLLPqqGgGO3kJQqfNfbYvA+tk5hJY1QFncCzo7WJJFXXLtV6nA2+es RGs8MhdSiayRN3No5owBbEQfK/GY/V6cqb5rbQO/URbZdNiLcXnQDy2Gp6BQQ= 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 :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=KkIQ5B8MyZTzUa1TUrUuc9YV1CU=; b=G+dPFz+/+iS998bXl4mJ TNdSpDiFQqFdjl/wYA2f3aVyEnTm6cAk4liurjYJWXHipvl7q7RNjnfUESm47l8/ XdlP9JZs/FNL55fY3GWkZMYV7XayVBU0llo3kSDNMfJt05NUtL1Uomn2wqvLe+1O K5vqMEQzse/AY7QOY0tyabU= Received: (qmail 53550 invoked by alias); 23 Jun 2019 21:37:00 -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 53536 invoked by uid 89); 23 Jun 2019 21:37:00 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-12.4 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=essential, @var, type_precision, thru X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 23 Jun 2019 21:36:57 +0000 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1561325809; bh=KtO5lRGo8TDbnVMgVlpDgvg5mt0Hj5u/tKjwROAdYJQ=; h=X-UI-Sender-Class:Date:From:To:Subject; b=Sf+hig+2NvmoWtV63y6QdtaZmHz64GK09aWMxfD+EIpMaUGKDl0B4BkZ4NN9jtS0+ +aNvFL4c9tU0eg1X57XKMrX/zt2BeOnM0kqnLJXOYWgP6KZVU2OAkz2J0C0WnY+2gu ETgekc5nqXd+Is21eySpBqwrUmJNPRFsVzrC+F6Q= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from proton.at.home ([79.251.0.136]) by mail.gmx.com (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1N33Ed-1iaxNU1Opx-013PvH; Sun, 23 Jun 2019 23:36:49 +0200 Message-ID: <5D0FF0E8.3090108@gmx.de> Date: Sun, 23 Jun 2019 23:36:40 +0200 From: Harald Anlauf User-Agent: Mozilla/5.0 (X11; Linux i686; rv:17.0) Gecko/20130329 Thunderbird/17.0.5 MIME-Version: 1.0 To: gfortran , gcc-patches Subject: [Patch, fortran] PR90903 - Implement runtime checks for bit manipulation intrinsics Dear all, the attached patch provides run-time checks for the bit manipulation intrinsic functions (IBSET/IBCLR/BTEST/SHIFT[RLA]/ISHFT/ISHFTC). I am using only one testcase whose purpose is mainly to verify that there are no false positives, which I consider essential, and one "failing" test at the end. What is still missing are run-time checks for the subroutine MVBITS. I am not sure yet how to handle that case (frontend or library?), and I am open to suggestions. For this purpose I intend to leave the PR open until a good solution is found. Regtested on x86_64-pc-linux-gnu. OK for trunk? Harald 2019-06-23 Harald Anlauf PR fortran/90903 * libgfortran.h: Add mask for -fcheck=bits option. * options.c (gfc_handle_runtime_check_option): Add option "bits" to run-time checks selectable via -fcheck. * trans-intrinsic.c (gfc_conv_intrinsic_btest) (gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ibits) (gfc_conv_intrinsic_shift, gfc_conv_intrinsic_ishft) (gfc_conv_intrinsic_ishftc): Implement run-time checks for the POS, LEN, SHIFT, and SIZE arguments. * gfortran.texi: Document run-time checks for bit manipulation intrinsics. * invoke.texi: Document new -fcheck=bits option. 2019-06-23 Harald Anlauf PR fortran/90903 * gfortran.dg/check_bits_1.f90: New testcase. Index: gcc/testsuite/gfortran.dg/check_bits_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/check_bits_1.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/check_bits_1.f90 (working copy) @@ -0,0 +1,49 @@ +! { dg-do run } +! { dg-options "-fcheck=bits -fdump-tree-original" } +! { dg-shouldfail "Fortran runtime error: SIZE argument (0) out of range 1:32 in intrinsic ISHFTC" } +! { dg-output "At line 44 .*" } +! +! Verify that the runtime checks for the bit manipulation intrinsic functions +! do not generate false-positives +program check + implicit none + integer :: i, k, pos, len, shift, size, nb + nb = bit_size (i) + i = 0 + do pos = 0, nb-1 + k = ibset (i, pos) + i = ibclr (k, pos) + if (btest (i, pos)) stop 1 + end do + do pos = 0, nb + do len = 0, nb-pos + i = ibits (i, pos, len) + end do + end do + do shift = 0, nb + k = ishft (i, shift) + i = ishft (k, -shift) + end do + do shift = 0, nb + k = shiftl (i, shift) ! Fortran 2008 + i = shiftr (k, shift) + i = shifta (i, shift) + k = lshift (i, shift) ! GNU extensions + i = rshift (k, shift) + end do + do shift = 0, nb + k = ishftc (i, shift) + i = ishftc (k, -shift) + do size = max (1,shift), nb + k = ishftc (i, shift, size) + i = ishftc (k, -shift, size) + end do + end do + size = 0 + ! The following line should fail with a runtime error: + k = ishftc (i, 0, size) + ! Should never get here with -fcheck=bits + stop 2 +end program check + +! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 21 "original" } } Index: gcc/fortran/gfortran.texi =================================================================== --- gcc/fortran/gfortran.texi (revision 272560) +++ gcc/fortran/gfortran.texi (working copy) @@ -3790,7 +3790,8 @@ Default: enabled. @item @var{option}[6] @tab Enables run-time checking. Possible values are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), GFC_RTCHECK_ARRAY_TEMPS (2), -GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), GFC_RTCHECK_POINTER (32). +GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), GFC_RTCHECK_POINTER (32), +GFC_RTCHECK_BITS (64). Default: disabled. @item @var{option}[7] @tab Unused. @item @var{option}[8] @tab Show a warning when invoking @code{STOP} and Index: gcc/fortran/invoke.texi =================================================================== --- gcc/fortran/invoke.texi (revision 272560) +++ gcc/fortran/invoke.texi (working copy) @@ -183,7 +183,7 @@ @gccoptlist{-faggressive-function-elimination -fblas-matmul-limit=@var{n} @gol -fbounds-check -ftail-call-workaround -ftail-call-workaround=@var{n} @gol -fcheck-array-temporaries @gol --fcheck=@var{} @gol +-fcheck=@var{} @gol -fcoarray=@var{} -fexternal-blas -ff2c -ffrontend-loop-interchange @gol -ffrontend-optimize @gol @@ -1558,6 +1558,7 @@ @item -fcheck=@var{} @opindex @code{fcheck} @cindex array, bounds checking +@cindex bit intrinsics checking @cindex bounds checking @cindex pointer checking @cindex memory checking @@ -1582,6 +1583,10 @@ Note: The warning is only printed once per location. +@item @samp{bits} +Enable generation of run-time checks for invalid arguments to the bit +manipulation intrinsics. + @item @samp{bounds} Enable generation of run-time checks for array subscripts and against the declared minimum and maximum values. It also Index: gcc/fortran/libgfortran.h =================================================================== --- gcc/fortran/libgfortran.h (revision 272560) +++ gcc/fortran/libgfortran.h (working copy) @@ -73,9 +73,11 @@ #define GFC_RTCHECK_DO (1<<3) #define GFC_RTCHECK_POINTER (1<<4) #define GFC_RTCHECK_MEM (1<<5) +#define GFC_RTCHECK_BITS (1<<6) #define GFC_RTCHECK_ALL (GFC_RTCHECK_BOUNDS | GFC_RTCHECK_ARRAY_TEMPS \ | GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \ - | GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM) + | GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM \ + | GFC_RTCHECK_BITS) /* Special unit numbers used to convey certain conditions. Numbers -4 thru -9 available. NEWUNIT values start at -10. */ Index: gcc/fortran/options.c =================================================================== --- gcc/fortran/options.c (revision 272560) +++ gcc/fortran/options.c (working copy) @@ -580,12 +580,12 @@ int result, pos = 0, n; static const char * const optname[] = { "all", "bounds", "array-temps", "recursion", "do", "pointer", - "mem", NULL }; + "mem", "bits", NULL }; static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS, GFC_RTCHECK_ARRAY_TEMPS, GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO, GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM, - 0 }; + GFC_RTCHECK_BITS, 0 }; while (*arg) { Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (revision 272560) +++ gcc/fortran/trans-intrinsic.c (working copy) @@ -6166,6 +6166,24 @@ gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree below = fold_build2_loc (input_location, LT_EXPR, + logical_type_node, args[1], + build_int_cst (TREE_TYPE (args[1]), 0)); + tree nbits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type)); + tree above = fold_build2_loc (input_location, GE_EXPR, + logical_type_node, args[1], nbits); + tree scond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, below, above); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "POS argument (%ld) out of range 0:%ld " + "in intrinsic BTEST", + fold_convert (long_integer_type_node, args[1]), + fold_convert (long_integer_type_node, nbits)); + } + tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]); tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[0], tmp); @@ -6236,6 +6254,32 @@ gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree below = fold_build2_loc (input_location, LT_EXPR, + logical_type_node, args[1], + build_int_cst (TREE_TYPE (args[1]), 0)); + tree nbits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type)); + tree above = fold_build2_loc (input_location, GE_EXPR, + logical_type_node, args[1], nbits); + tree scond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, below, above); + size_t len_name = strlen (expr->value.function.isym->name); + char *name = XALLOCAVEC (char, len_name + 1); + for (size_t i = 0; i < len_name; i++) + name[i] = TOUPPER (expr->value.function.isym->name[i]); + name[len_name] = '\0'; + tree iname = gfc_build_addr_expr (pchar_type_node, + gfc_build_cstring_const (name)); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "POS argument (%ld) out of range 0:%ld " + "in intrinsic %s", + fold_convert (long_integer_type_node, args[1]), + fold_convert (long_integer_type_node, nbits), + iname); + } + tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]); if (set) @@ -6261,6 +6305,42 @@ gfc_conv_intrinsic_function_args (se, expr, args, 3); type = TREE_TYPE (args[0]); + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree tmp1 = fold_convert (long_integer_type_node, args[1]); + tree tmp2 = fold_convert (long_integer_type_node, args[2]); + tree nbits = build_int_cst (long_integer_type_node, + TYPE_PRECISION (type)); + tree below = fold_build2_loc (input_location, LT_EXPR, + logical_type_node, args[1], + build_int_cst (TREE_TYPE (args[1]), 0)); + tree above = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, tmp1, nbits); + tree scond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, below, above); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "POS argument (%ld) out of range 0:%ld " + "in intrinsic IBITS", tmp1, nbits); + below = fold_build2_loc (input_location, LT_EXPR, + logical_type_node, args[2], + build_int_cst (TREE_TYPE (args[2]), 0)); + above = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, tmp2, nbits); + scond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, below, above); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "LEN argument (%ld) out of range 0:%ld " + "in intrinsic IBITS", tmp2, nbits); + above = fold_build2_loc (input_location, PLUS_EXPR, + long_integer_type_node, tmp1, tmp2); + scond = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, above, nbits); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "POS(%ld)+LEN(%ld)>BIT_SIZE(%ld) " + "in intrinsic IBITS", tmp1, tmp2, nbits); + } + mask = build_int_cst (type, -1); mask = fold_build2_loc (input_location, LSHIFT_EXPR, type, mask, args[2]); mask = fold_build1_loc (input_location, BIT_NOT_EXPR, type, mask); @@ -6382,6 +6462,32 @@ gcc requires a shift width < BIT_SIZE(I), so we have to catch this special case. */ num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type)); + + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree below = fold_build2_loc (input_location, LT_EXPR, + logical_type_node, args[1], + build_int_cst (TREE_TYPE (args[1]), 0)); + tree above = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, args[1], num_bits); + tree scond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, below, above); + size_t len_name = strlen (expr->value.function.isym->name); + char *name = XALLOCAVEC (char, len_name + 1); + for (size_t i = 0; i < len_name; i++) + name[i] = TOUPPER (expr->value.function.isym->name[i]); + name[len_name] = '\0'; + tree iname = gfc_build_addr_expr (pchar_type_node, + gfc_build_cstring_const (name)); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "SHIFT argument (%ld) out of range 0:%ld " + "in intrinsic %s", + fold_convert (long_integer_type_node, args[1]), + fold_convert (long_integer_type_node, num_bits), + iname); + } + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, args[1], num_bits); @@ -6436,6 +6542,20 @@ gcc requires a shift width < BIT_SIZE(I), so we have to catch this special case. */ num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type)); + + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree outside = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, width, num_bits); + gfc_trans_runtime_check (true, false, outside, &se->pre, &expr->where, + "SHIFT argument (%ld) out of range -%ld:%ld " + "in intrinsic ISHFT", + fold_convert (long_integer_type_node, args[1]), + fold_convert (long_integer_type_node, num_bits), + fold_convert (long_integer_type_node, num_bits)); + } + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, width, num_bits); se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond, @@ -6454,6 +6574,7 @@ tree lrot; tree rrot; tree zero; + tree nbits; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr); @@ -6461,12 +6582,14 @@ gfc_conv_intrinsic_function_args (se, expr, args, num_args); + type = TREE_TYPE (args[0]); + nbits = build_int_cst (long_integer_type_node, TYPE_PRECISION (type)); + if (num_args == 3) { /* Use a library function for the 3 parameter version. */ tree int4type = gfc_get_int_type (4); - type = TREE_TYPE (args[0]); /* We convert the first argument to at least 4 bytes, and convert back afterwards. This removes the need for library functions for all argument sizes, and function will be @@ -6480,6 +6603,32 @@ args[1] = convert (int4type, args[1]); args[2] = convert (int4type, args[2]); + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree size = fold_convert (long_integer_type_node, args[2]); + tree below = fold_build2_loc (input_location, LE_EXPR, + logical_type_node, size, + build_int_cst (TREE_TYPE (args[1]), 0)); + tree above = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, size, nbits); + tree scond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, below, above); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "SIZE argument (%ld) out of range 1:%ld " + "in intrinsic ISHFTC", size, nbits); + tree width = fold_convert (long_integer_type_node, args[1]); + width = fold_build1_loc (input_location, ABS_EXPR, + long_integer_type_node, width); + scond = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, width, size); + gfc_trans_runtime_check (true, false, scond, &se->pre, &expr->where, + "SHIFT argument (%ld) out of range -%ld:%ld " + "in intrinsic ISHFTC", + fold_convert (long_integer_type_node, args[1]), + size, size); + } + switch (expr->ts.kind) { case 1: @@ -6505,12 +6654,26 @@ return; } - type = TREE_TYPE (args[0]); /* Evaluate arguments only once. */ args[0] = gfc_evaluate_now (args[0], &se->pre); args[1] = gfc_evaluate_now (args[1], &se->pre); + /* Optionally generate code for runtime argument check. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BITS) + { + tree width = fold_convert (long_integer_type_node, args[1]); + width = fold_build1_loc (input_location, ABS_EXPR, + long_integer_type_node, width); + tree outside = fold_build2_loc (input_location, GT_EXPR, + logical_type_node, width, nbits); + gfc_trans_runtime_check (true, false, outside, &se->pre, &expr->where, + "SHIFT argument (%ld) out of range -%ld:%ld " + "in intrinsic ISHFTC", + fold_convert (long_integer_type_node, args[1]), + nbits, nbits); + } + /* Rotate left if positive. */ lrot = fold_build2_loc (input_location, LROTATE_EXPR, type, args[0], args[1]);