procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/90903 (Implement runtime checks for bit manipulation intrinsics)

Browse source 
2019-07-16  Harald Anlauf  <anlauf@gmx.de>

	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.

	PR fortran/90903
	* gfortran.dg/check_bits_1.f90: New testcase.

From-SVN: r273535
This commit is contained in:
Harald Anlauf 2019-07-16 19:58:15 +00:00 • committed by Harald Anlauf
parent 460bf043c8
commit df1afcca58
8 changed files with 247 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/fortran/ChangeLog
View file

@ -1,3 +1,18 @@
2019-07-16 Harald Anlauf <anlauf@gmx.de>
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-07-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/87233

3
gcc/fortran/gfortran.texi
View file

@ -3790,7 +3790,8 @@ initialization using @code{_gfortran_set_args}.
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

7
gcc/fortran/invoke.texi
View file

@ -183,7 +183,7 @@ and warnings}.
@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{<all|array-temps|bounds|do|mem|pointer|recursion>} @gol
-fcheck=@var{<all|array-temps|bits|bounds|do|mem|pointer|recursion>} @gol
-fcoarray=@var{<none|single|lib>} -fexternal-blas -ff2c
-ffrontend-loop-interchange @gol
-ffrontend-optimize @gol
@ -1558,6 +1558,7 @@ library needs to be linked.
@item -fcheck=@var{<keyword>}
@opindex @code{fcheck}
@cindex array, bounds checking
@cindex bit intrinsics checking
@cindex bounds checking
@cindex pointer checking
@cindex memory checking
@ -1582,6 +1583,10 @@ sometimes useful in optimization, in order to avoid such temporaries.
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

4
gcc/fortran/libgfortran.h
View file

@ -73,9 +73,11 @@ along with GCC; see the file COPYING3. If not see
#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. */

4
gcc/fortran/options.c
View file

@ -580,12 +580,12 @@ gfc_handle_runtime_check_option (const char *arg)
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)
{

167
gcc/fortran/trans-intrinsic.c
View file

@ -6166,6 +6166,24 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
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_singlebitop (gfc_se * se, gfc_expr * expr, int set)
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_ibits (gfc_se * se, gfc_expr * expr)
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 @@ gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift,
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 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
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 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
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_ishftc (gfc_se * se, gfc_expr * expr)
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 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
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 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
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]);

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2019-07-16 Harald Anlauf <anlauf@gmx.de>
PR fortran/90903
* gfortran.dg/check_bits_1.f90: New testcase.
2019-07-16 Jeff Law <law@redhat.com>
PR rtl-optimization/91173

49
gcc/testsuite/gfortran.dg/check_bits_1.f90 Normal file
View file

@ -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" } }