On Tue, Nov 7, 2017 at 10:06 PM, Steve Kargl
<s...@troutmask.apl.washington.edu> wrote:
> On Tue, Nov 07, 2017 at 08:26:15PM +0200, Janne Blomqvist wrote:
>> Earlier GFortran used to redefine boolean_type_node, which in the rest
>> of the compiler means the C/C++ _Bool/bool type, to the Fortran
>> default logical type. When this redefinition was removed, a few
>> issues surfaced. Namely,
>>
>> 1) PR 82869, where we created a boolean tmp variable, and passed it to
>> the runtime library as a Fortran logical variable of a different size.
>>
>> 2) Fortran specifies that logical operations should be done with the
>> default logical kind, not in any other kind.
>>
>> 3) Using 8-bit variables have some issues, such as
>> - on x86, partial register stalls and length prefix changes.
>> - s390 has a compare with immediate and jump instruction which
>> works with 32-bit but not 8-bit quantities.
>>
>> This patch addresses (2) by introducing a type
>> default_logical_type_node which is used when evaluating Fortran
>> logical expressions. (3) is addressed by introducing
>> logical_type_node, a tree representing a logical(kind=4) type which
>> can be used for compiler-generated temporary
>> variables. logical_type_node is always 4 bytes. As a side effect, (1)
>> is also fixed, though there might be some latent bug lurking there
>> still.
>>
>> For x86-64, using the Polyhedron benchmark suite, no performance or
>> code size difference worth mentioning was observed.
>>
>> Regtested on x86_64-pc-linux-gnu. Ok for trunk?
>
> I scanned the patch and it looks ok to me (most a
> mechanical find/replace operation). One thing those,
>
>> diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
>> index 78477a9..602d369 100644
>> --- a/gcc/fortran/trans-types.c
>> +++ b/gcc/fortran/trans-types.c
>> @@ -62,6 +62,12 @@ tree ppvoid_type_node;
>> tree pchar_type_node;
>> tree pfunc_type_node;
>>
>> +tree default_logical_type_node;
>> +tree default_logical_true_node;
>> +tree default_logical_false_node;
>> +tree logical_type_node;
>> +tree logical_true_node;
>> +tree logical_false_node;
>> tree gfc_charlen_type_node;
>>
>> tree gfc_float128_type_node = NULL_TREE;
>> @@ -1003,6 +1009,15 @@ gfc_init_types (void)
>> wi::mask (n, UNSIGNED,
>> TYPE_PRECISION (size_type_node)));
>>
>> +
>> + default_logical_type_node = gfc_get_logical_type
>> (gfc_default_logical_kind);
>> + default_logical_true_node = build_int_cst (default_logical_type_node, 1);
>> + default_logical_false_node = build_int_cst (default_logical_type_node, 0);
>> +
>> + logical_type_node = gfc_get_logical_type (4);
>
> Can you add a comment to note that the 4 is purposely chosen?
> A year or so from now, someone might change this to gfc_default_logical_kind
> without understand/recalling why 4 is used.
The patch contains a comment explaining that in trans-types.h.
However, a bit of further experimenting with my patch revealed that
one can cause these latent bugs I feared to appear by playing with
-fdefault-integer-8 / -finteger-4-integer-8 with the example from
bugzilla (so we end up passing a pointer to a logical(kind=4) variable
but we tell libgfortran it's kind=8). I did fix the most obvious ones
in the attached patch (on top of the previous one), but I'm not
convinced it's exhaustive.
So I wonder, do we actually care enough about -fdefault-integer-8 /
-finteger-4-integer-8 to do this kind of micro-optimization (i.e. use
4 byte logical temporary variables if we can even when we use
-fdefault-integer-8 / -finteger-4-integer-8), or should we play it
safe and just use default_logical_type_node everywhere?
--
Janne Blomqvist
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index ed4496c..95faa32 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -5378,7 +5378,8 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
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);
- tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
+ tmp = fold_build2_loc (input_location, NE_EXPR, default_logical_type_node,
+ tmp,
build_int_cst (type, 0));
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, tmp);
@@ -5406,7 +5407,7 @@ gfc_conv_intrinsic_bitcomp (gfc_se * se, gfc_expr * expr,
enum tree_code op)
args[0] = fold_convert (TREE_TYPE (args[1]), args[0]);
/* Now, we compare them. */
- se->expr = fold_build2_loc (input_location, op, logical_type_node,
+ se->expr = fold_build2_loc (input_location, op, default_logical_type_node,
args[0], args[1]);
}
@@ -7464,7 +7465,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
tmp = gfc_conv_descriptor_data_get (arg1se.expr);
}
- tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
+ tmp = fold_build2_loc (input_location, NE_EXPR,
+ default_logical_type_node, tmp,
fold_convert (TREE_TYPE (tmp), null_pointer_node));
}
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
@@ -7532,7 +7534,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
}
gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post);
- tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp2,
+ tmp = fold_build2_loc (input_location, NE_EXPR,
+ default_logical_type_node, tmp2,
fold_convert (TREE_TYPE (tmp2),
null_pointer_node));
se->expr = tmp;
}
@@ -7545,7 +7548,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
nonzero_charlen = NULL_TREE;
if (arg1->expr->ts.type == BT_CHARACTER)
nonzero_charlen = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node,
+ default_logical_type_node,
arg1->expr->ts.u.cl->backend_decl,
integer_zero_node);
if (scalar)
@@ -7570,12 +7573,14 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_add_block_to_block (&se->post, &arg1se.post);
gfc_add_block_to_block (&se->pre, &arg2se.pre);
gfc_add_block_to_block (&se->post, &arg2se.post);
- tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ tmp = fold_build2_loc (input_location, EQ_EXPR,
+ default_logical_type_node,
arg1se.expr, arg2se.expr);
- tmp2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+ tmp2 = fold_build2_loc (input_location, NE_EXPR,
+ default_logical_type_node,
arg1se.expr, null_pointer_node);
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node, tmp, tmp2);
+ default_logical_type_node, tmp, tmp2);
}
else
{
@@ -7593,7 +7598,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
tmp = gfc_rank_cst[arg1->expr->rank - 1];
tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp);
nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, tmp,
+ default_logical_type_node, tmp,
build_int_cst (TREE_TYPE (tmp),
0));
/* A pointer to an array, call library function _gfor_associated. */
@@ -7607,9 +7612,9 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
se->expr = build_call_expr_loc (input_location,
gfor_fndecl_associated, 2,
arg1se.expr, arg2se.expr);
- se->expr = convert (logical_type_node, se->expr);
+ se->expr = convert (default_logical_type_node, se->expr);
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node, se->expr,
+ default_logical_type_node, se->expr,
nonzero_arraylen);
}
@@ -7617,7 +7622,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
be associated. */
if (nonzero_charlen != NULL_TREE)
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node,
+ default_logical_type_node,
se->expr, nonzero_charlen);
}
@@ -7645,14 +7650,16 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
if (UNLIMITED_POLY (a))
{
tmp = gfc_class_vptr_get (a->symtree->n.sym->backend_decl);
- conda = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+ conda = fold_build2_loc (input_location, NE_EXPR,
+ default_logical_type_node,
tmp, build_int_cst (TREE_TYPE (tmp), 0));
}
if (UNLIMITED_POLY (b))
{
tmp = gfc_class_vptr_get (b->symtree->n.sym->backend_decl);
- condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+ condb = fold_build2_loc (input_location, NE_EXPR,
+ default_logical_type_node,
tmp, build_int_cst (TREE_TYPE (tmp), 0));
}
@@ -7678,16 +7685,16 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
gfc_conv_expr (&se2, b);
tmp = fold_build2_loc (input_location, EQ_EXPR,
- logical_type_node, se1.expr,
+ default_logical_type_node, se1.expr,
fold_convert (TREE_TYPE (se1.expr), se2.expr));
if (conda)
tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
- logical_type_node, conda, tmp);
+ default_logical_type_node, conda, tmp);
if (condb)
tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
- logical_type_node, condb, tmp);
+ default_logical_type_node, condb, tmp);
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
}
@@ -8052,7 +8059,7 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr)
if (arg->next->expr == NULL)
/* Only given one arg so generate a null and do a
not-equal comparison against the first arg. */
- se->expr = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+ se->expr = fold_build2_loc (input_location, NE_EXPR,
default_logical_type_node,
arg1se.expr,
fold_convert (TREE_TYPE (arg1se.expr),
null_pointer_node));
@@ -8068,17 +8075,17 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr)
gfc_add_block_to_block (&se->post, &arg2se.post);
/* Generate test to compare that the two args are equal. */
- eq_expr = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ eq_expr = fold_build2_loc (input_location, EQ_EXPR,
default_logical_type_node,
arg1se.expr, arg2se.expr);
/* Generate test to ensure that the first arg is not null. */
not_null_expr = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node,
+ default_logical_type_node,
arg1se.expr, null_pointer_node);
/* Finally, the generated test must check that both arg1 is not
NULL and that it is equal to the second arg. */
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node,
+ default_logical_type_node,
not_null_expr, eq_expr);
}
}
@@ -8308,11 +8315,12 @@ conv_intrinsic_ieee_is_normal (gfc_se * se, gfc_expr *
expr)
isnormal = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_ISNORMAL),
1, arg);
- iszero = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg,
+ iszero = fold_build2_loc (input_location, EQ_EXPR,
+ default_logical_type_node, arg,
build_real_from_int_cst (TREE_TYPE (arg),
integer_zero_node));
se->expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- logical_type_node, isnormal, iszero);
+ default_logical_type_node, isnormal, iszero);
se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
}
@@ -8337,11 +8345,12 @@ conv_intrinsic_ieee_is_negative (gfc_se * se, gfc_expr
* expr)
signbit = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_SIGNBIT),
1, arg);
- signbit = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+ signbit = fold_build2_loc (input_location, NE_EXPR,
+ default_logical_type_node,
signbit, integer_zero_node);
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node, signbit,
+ default_logical_type_node, signbit,
fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE(isnan), isnan));
